diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-29 14:02:26 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-29 14:02:26 +0000 |
commit | a053db0dacfa6b670bc8f8e3f9dff1f24159db77 (patch) | |
tree | 760d18eba47b5549c567cc7fc511563c5d41bf97 /gcc/ada/sem_util.adb | |
parent | 59f3e67584aedf0c02cf570274ba53d92e93cbf6 (diff) | |
download | gcc-a053db0dacfa6b670bc8f8e3f9dff1f24159db77.tar.gz |
2011-08-29 Pascal Obry <obry@adacore.com>
* exp_disp.adb: Minor comment fix.
(Make_Disp_Asynchronous_Select_Body): Properly initialize out parameters
to avoid warnings when compiling with -Wall.
(Make_Disp_Conditional_Select_Body): Likewise.
(Make_Disp_Timed_Select_Body): Likewise.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Analyze_Formal_Subprogram_Declaration): If default is
an entity name, generate reference for it.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Iterator_Loop): Uniform handling of "X of S"
iterator form.
* sem_util.adb (Is_Iterator, Is_Reversible_Iterator): Yield True for
the class-wide type.
* sem_ch5.adb: Move some rewriting to the expander, where it belongs.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Check_Constrained_Object): Do not create an actual
subtype for an object whose type is an unconstrained union.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* par-ch3.adb (P_Array_Type_Definiation, P_Component_Items): "aliased"
is allowed in a component definition, by AI95-406.
2011-08-29 Matthew Heaney <heaney@adacore.com>
* a-chtgbo.adb (Generic_Iteration): Use correct overloading of Next.
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
* a-except-2005.adb: Alphabetize all routines.
(Triggered_By_Abort): New routine.
* a-except-2005.ads (Triggered_By_Abort): New routine.
* a-except.adb Alphabetize all routines.
(Triggered_By_Abort): New routine.
* a-except.ads (Triggered_By_Abort): New routine.
* exp_ch7.adb: Update all comments involving the detection of aborts in
finalization code.
(Build_Object_Declarations): Do not generate code to detect the
presence of an abort at the start of finalization code, use a runtime
routine istead.
* rtsfind.ads: Add RE_Triggered_By_Abort to tables RE_Id and
RE_Unit_Table.
* sem_res.adb (Resolve_Allocator): Emit a warning when attempting to
allocate a task on a subpool.
* s-stposu.adb: Add library-level flag Finalize_Address_Table_In_Use.
The flag disables all actions related to the maintenance of
Finalize_Address_Table when subpools are not in use.
(Allocate_Any_Controlled): Signal the machinery that subpools are in
use.
(Deallocate_Any_Controlled): Do not call Delete_Finalize_Address which
performs costly task locking when subpools are not in use.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178236 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sem_util.adb')
-rw-r--r-- | gcc/ada/sem_util.adb | 93 |
1 files changed, 58 insertions, 35 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2b40b63baf3..e855da24ef4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7175,7 +7175,19 @@ package body Sem_Util is Iface : Entity_Id; begin - if not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then + if Is_Class_Wide_Type (Typ) + and then + (Chars (Etype (Typ)) = Name_Forward_Iterator + or else Chars (Etype (Typ)) = Name_Reversible_Iterator) + and then + Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Etype (Typ)))) + then + return True; + + elsif not Is_Tagged_Type (Typ) + or else not Is_Derived_Type (Typ) + then return False; else @@ -7198,6 +7210,51 @@ package body Sem_Util is return False; end if; end Is_Iterator; + + ---------------------------- + -- Is_Reversible_Iterator -- + ---------------------------- + + function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is + Ifaces_List : Elist_Id; + Iface_Elmt : Elmt_Id; + Iface : Entity_Id; + + begin + if Is_Class_Wide_Type (Typ) + and then Chars (Etype (Typ)) = Name_Reversible_Iterator + and then + Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Etype (Typ)))) + then + return True; + + elsif not Is_Tagged_Type (Typ) + or else not Is_Derived_Type (Typ) + then + return False; + else + + Collect_Interfaces (Typ, Ifaces_List); + + Iface_Elmt := First_Elmt (Ifaces_List); + while Present (Iface_Elmt) loop + Iface := Node (Iface_Elmt); + if Chars (Iface) = Name_Reversible_Iterator + and then + Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Iface))) + then + return True; + end if; + + Next_Elmt (Iface_Elmt); + end loop; + + end if; + return False; + end Is_Reversible_Iterator; + ------------ -- Is_LHS -- ------------ @@ -7841,40 +7898,6 @@ package body Sem_Util is return False; end Is_Renamed_Entry; - ---------------------------- - -- Is_Reversible_Iterator -- - ---------------------------- - - function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is - Ifaces_List : Elist_Id; - Iface_Elmt : Elmt_Id; - Iface : Entity_Id; - - begin - if not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then - return False; - - else - Collect_Interfaces (Typ, Ifaces_List); - - Iface_Elmt := First_Elmt (Ifaces_List); - while Present (Iface_Elmt) loop - Iface := Node (Iface_Elmt); - if Chars (Iface) = Name_Reversible_Iterator - and then - Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Iface))) - then - return True; - end if; - - Next_Elmt (Iface_Elmt); - end loop; - end if; - - return False; - end Is_Reversible_Iterator; - ---------------------- -- Is_Selector_Name -- ---------------------- |