From 833eaa8a3dc786183340f972c6188cc188510d00 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Aug 2011 16:12:57 +0200 Subject: [PATCH] [multiple changes] 2011-08-29 Robert Dewar * exp_ch5.adb, sem_ch3.adb, a-cihama.adb, a-cihama.ads, exp_ch7.adb, sem_ch5.adb, a-ciorse.adb, a-ciorse.ads, sem_ch12.adb, a-cidlli.adb, a-cidlli.ads, sem_util.adb, sem_res.adb, gnat1drv.adb, a-except.adb, a-except.ads, a-except-2005.ads, sem_ch4.adb, exp_disp.adb, exp_aggr.adb, sem_ch13.adb, par-ch3.adb: Minor reformatting. 2011-08-29 Tristan Gingold * s-auxdec-vms-alpha.adb: Add comments, remove some HT before labels. 2011-08-29 Vadim Godunko * s-parint.ads: Minor comment clarification. 2011-08-29 Vincent Celier * prj.adb (Initialize): Make sure that new reserved words after Ada 95 may be used as identifiers. 2011-08-29 Ed Schonberg * a-coinho.ads: Minor reformating. From-SVN: r178239 --- gcc/ada/ChangeLog | 25 +++++++++ gcc/ada/a-cidlli.adb | 31 ++++++----- gcc/ada/a-cidlli.ads | 24 +++++---- gcc/ada/a-cihama.adb | 30 ++++++----- gcc/ada/a-cihama.ads | 10 ++-- gcc/ada/a-ciorse.adb | 68 ++++++++++++++---------- gcc/ada/a-ciorse.ads | 28 +++++----- gcc/ada/a-coinho.ads | 2 +- gcc/ada/a-except-2005.ads | 2 +- gcc/ada/a-except.adb | 1 - gcc/ada/a-except.ads | 2 +- gcc/ada/exp_aggr.adb | 3 +- gcc/ada/exp_ch5.adb | 51 +++++++++--------- gcc/ada/exp_ch7.adb | 4 +- gcc/ada/exp_disp.adb | 56 +++++++++----------- gcc/ada/gnat1drv.adb | 2 +- gcc/ada/par-ch3.adb | 6 ++- gcc/ada/prj.adb | 6 +++ gcc/ada/s-auxdec-vms-alpha.adb | 96 +++++++++++++++++----------------- gcc/ada/s-parint.ads | 7 +-- gcc/ada/sem_ch12.adb | 2 +- gcc/ada/sem_ch13.adb | 4 +- gcc/ada/sem_ch3.adb | 4 +- gcc/ada/sem_ch4.adb | 9 ++-- gcc/ada/sem_ch5.adb | 52 +++++++++--------- gcc/ada/sem_res.adb | 2 +- gcc/ada/sem_util.adb | 95 +++++++++++++++++---------------- 27 files changed, 340 insertions(+), 282 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1c72508894a..f98d49f27ab 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2011-08-29 Robert Dewar + + * exp_ch5.adb, sem_ch3.adb, a-cihama.adb, a-cihama.ads, exp_ch7.adb, + sem_ch5.adb, a-ciorse.adb, a-ciorse.ads, sem_ch12.adb, a-cidlli.adb, + a-cidlli.ads, sem_util.adb, sem_res.adb, gnat1drv.adb, a-except.adb, + a-except.ads, a-except-2005.ads, sem_ch4.adb, exp_disp.adb, + exp_aggr.adb, sem_ch13.adb, par-ch3.adb: Minor reformatting. + +2011-08-29 Tristan Gingold + + * s-auxdec-vms-alpha.adb: Add comments, remove some HT before labels. + +2011-08-29 Vadim Godunko + + * s-parint.ads: Minor comment clarification. + +2011-08-29 Vincent Celier + + * prj.adb (Initialize): Make sure that new reserved words after Ada 95 + may be used as identifiers. + +2011-08-29 Ed Schonberg + + * a-coinho.ads: Minor reformating. + 2011-08-29 Ed Schonberg * exp_ch5.adb (Expand_Iterator_Loop): Handle properly a loop over a diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index 780efad4f41..5ebd2a9d2b2 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -39,14 +39,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is List_Iterator_Interfaces.Reversible_Iterator with record Container : List_Access; Node : Node_Access; - end record; + end record; - overriding function First (Object : Iterator) return Cursor; - overriding function Last (Object : Iterator) return Cursor; - overriding function Next (Object : Iterator; Position : Cursor) - return Cursor; - overriding function Previous (Object : Iterator; Position : Cursor) - return Cursor; + overriding function First (Object : Iterator) return Cursor; + + overriding function Last (Object : Iterator) return Cursor; + + overriding function Next + (Object : Iterator; + Position : Cursor) return Cursor; + + overriding function Previous + (Object : Iterator; + Position : Cursor) return Cursor; ----------------------- -- Local Subprograms -- @@ -838,16 +843,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is B := B - 1; end Iterate; - function Iterate (Container : List) - return List_Iterator_Interfaces.Reversible_Iterator'class + function Iterate + (Container : List) + return List_Iterator_Interfaces.Reversible_Iterator'class is It : constant Iterator := (Container'Unchecked_Access, Container.First); begin return It; end Iterate; - function Iterate (Container : List; Start : Cursor) - return List_Iterator_Interfaces.Reversible_Iterator'class + function Iterate + (Container : List; + Start : Cursor) + return List_Iterator_Interfaces.Reversible_Iterator'class is It : constant Iterator := (Container'Unchecked_Access, Start.Node); begin @@ -1008,7 +1016,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin if Position.Node = Position.Container.First then return No_Element; - else return (Object.Container, Position.Node.Prev); end if; diff --git a/gcc/ada/a-cidlli.ads b/gcc/ada/a-cidlli.ads index a6fd7106321..8a23fc75442 100644 --- a/gcc/ada/a-cidlli.ads +++ b/gcc/ada/a-cidlli.ads @@ -32,7 +32,8 @@ ------------------------------------------------------------------------------ with Ada.Iterator_Interfaces; -with Ada.Streams; use Ada.Streams; +with Ada.Streams; use Ada.Streams; + private with Ada.Finalization; generic @@ -45,8 +46,7 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Preelaborate; pragma Remote_Types; - type List is tagged private - with + type List is tagged private with Constant_Indexing => Constant_Reference, Variable_Indexing => Reference, Default_Iterator => Iterate, @@ -60,6 +60,7 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is Empty_List : constant List; No_Element : constant Cursor; + function Has_Element (Position : Cursor) return Boolean; package List_Iterator_Interfaces is new @@ -189,10 +190,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : List; Process : not null access procedure (Position : Cursor)); - function Iterate (Container : List) + function Iterate + (Container : List) return List_Iterator_Interfaces.Reversible_Iterator'class; - function Iterate (Container : List; Start : Cursor) + function Iterate + (Container : List; + Start : Cursor) return List_Iterator_Interfaces.Reversible_Iterator'class; type Constant_Reference_Type @@ -230,12 +234,14 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is for Reference_Type'Read use Read; function Constant_Reference - (Container : List; Position : Cursor) -- SHOULD BE ALIASED - return Constant_Reference_Type; + (Container : List; + Position : Cursor) -- SHOULD BE ALIASED ??? + return Constant_Reference_Type; function Reference - (Container : List; Position : Cursor) -- SHOULD BE ALIASED - return Reference_Type; + (Container : List; + Position : Cursor) -- SHOULD BE ALIASED ??? + return Reference_Type; generic with function "<" (Left, Right : Element_Type) return Boolean is <>; diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index 783fdf421b1..d4f2c1d92dc 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -45,13 +45,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is type Iterator is new Map_Iterator_Interfaces.Forward_Iterator with record - Container : Map_Access; - Node : Node_Access; - end record; + Container : Map_Access; + Node : Node_Access; + end record; overriding function First (Object : Iterator) return Cursor; - overriding function Next (Object : Iterator; Position : Cursor) - return Cursor; + + overriding function Next + (Object : Iterator; + Position : Cursor) return Cursor; ----------------------- -- Local Subprograms -- @@ -414,9 +416,9 @@ package body Ada.Containers.Indefinite_Hashed_Maps is begin if N = null then return No_Element; + else + return Cursor'(Object.Container.all'Unchecked_Access, N); end if; - - return Cursor'(Object.Container.all'Unchecked_Access, N); end First; ---------- @@ -426,6 +428,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is procedure Free (X : in out Node_Access) is procedure Deallocate is new Ada.Unchecked_Deallocation (Node_Type, Node_Access); + begin if X = null then return; @@ -743,7 +746,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is begin if Position.Node = null then return No_Element; - else return (Object.Container, Next (Position).Node); end if; @@ -874,15 +876,19 @@ package body Ada.Containers.Indefinite_Hashed_Maps is -- Reference -- --------------- - function Constant_Reference (Container : Map; Key : Key_Type) - return Constant_Reference_Type is + function Constant_Reference + (Container : Map; + Key : Key_Type) return Constant_Reference_Type + is begin return (Element => Container.Find (Key).Node.Element.all'Unrestricted_Access); end Constant_Reference; - function Reference (Container : Map; Key : Key_Type) - return Reference_Type is + function Reference + (Container : Map; + Key : Key_Type) return Reference_Type + is begin return (Element => Container.Find (Key).Node.Element.all'Unrestricted_Access); diff --git a/gcc/ada/a-cihama.ads b/gcc/ada/a-cihama.ads index 2e089677112..1b16d8f4589 100644 --- a/gcc/ada/a-cihama.ads +++ b/gcc/ada/a-cihama.ads @@ -48,8 +48,7 @@ package Ada.Containers.Indefinite_Hashed_Maps is pragma Preelaborate; pragma Remote_Types; - type Map is tagged private - with + type Map is tagged private with Constant_Indexing => Constant_Reference, Variable_Indexing => Reference, Default_Iterator => Iterate, @@ -60,7 +59,7 @@ package Ada.Containers.Indefinite_Hashed_Maps is type Cursor is private; pragma Preelaborable_Initialization (Cursor); - Empty_Map : constant Map; + Empty_Map : constant Map; -- Map objects declared without an initialization expression are -- initialized to the value Empty_Map. @@ -286,8 +285,9 @@ package Ada.Containers.Indefinite_Hashed_Maps is for Reference_Type'Read use Read; function Constant_Reference - (Container : Map; Key : Key_Type) -- SHOULD BE ALIASED - return Constant_Reference_Type; + (Container : Map; + Key : Key_Type) -- SHOULD BE ALIASED ??? + return Constant_Reference_Type; function Reference (Container : Map; Key : Key_Type) return Reference_Type; diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb index 7a782189708..673cd510a3c 100644 --- a/gcc/ada/a-ciorse.adb +++ b/gcc/ada/a-ciorse.adb @@ -42,16 +42,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is type Iterator is new Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record - Container : access constant Set; - Node : Node_Access; - end record; + Container : access constant Set; + Node : Node_Access; + end record; overriding function First (Object : Iterator) return Cursor; - overriding function Last (Object : Iterator) return Cursor; - overriding function Next (Object : Iterator; Position : Cursor) - return Cursor; - overriding function Previous (Object : Iterator; Position : Cursor) - return Cursor; + + overriding function Last (Object : Iterator) return Cursor; + + overriding function Next + (Object : Iterator; + Position : Cursor) return Cursor; + + overriding function Previous + (Object : Iterator; + Position : Cursor) return Cursor; ----------------------- -- Local Subprograms -- @@ -582,7 +587,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function First (Object : Iterator) return Cursor is begin return Cursor'( - Object.Container.all'Unrestricted_Access, Object.Container.Tree.First); + Object.Container.all'Unrestricted_Access, Object.Container.Tree.First); end First; ------------------- @@ -593,9 +598,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is begin if Container.Tree.First = null then raise Constraint_Error with "set is empty"; + else + return Container.Tree.First.Element.all; end if; - - return Container.Tree.First.Element.all; end First_Element; ----------- @@ -605,13 +610,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is function Floor (Container : Set; Item : Element_Type) return Cursor is Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item); - begin if Node = null then return No_Element; + else + return Cursor'(Container'Unrestricted_Access, Node); end if; - - return Cursor'(Container'Unrestricted_Access, Node); end Floor; ---------- @@ -1209,8 +1213,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is B := B - 1; end Iterate; - function Iterate (Container : Set) - return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class + function Iterate + (Container : Set) + return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class is It : constant Iterator := (Container'Unchecked_Access, Container.Tree.First); @@ -1218,8 +1223,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is return It; end Iterate; - function Iterate (Container : Set; Start : Cursor) - return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class + function Iterate + (Container : Set; + Start : Cursor) + return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class is It : constant Iterator := (Container'Unchecked_Access, Start.Node); begin @@ -1234,19 +1241,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is begin if Container.Tree.Last = null then return No_Element; + else + return Cursor'(Container'Unrestricted_Access, Container.Tree.Last); end if; - - return Cursor'(Container'Unrestricted_Access, Container.Tree.Last); end Last; function Last (Object : Iterator) return Cursor is begin if Object.Container.Tree.Last = null then return No_Element; + else + return Cursor'( + Object.Container.all'Unrestricted_Access, + Object.Container.Tree.Last); end if; - - return Cursor'( - Object.Container.all'Unrestricted_Access, Object.Container.Tree.Last); end Last; ------------------ @@ -1257,9 +1265,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is begin if Container.Tree.Last = null then raise Constraint_Error with "set is empty"; + else + return Container.Tree.Last.Element.all; end if; - - return Container.Tree.Last.Element.all; end Last_Element; ---------- @@ -1327,8 +1335,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end; end Next; - function Next (Object : Iterator; Position : Cursor) - return Cursor + function Next + (Object : Iterator; + Position : Cursor) return Cursor is pragma Unreferenced (Object); begin @@ -1388,8 +1397,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end; end Previous; - function Previous (Object : Iterator; Position : Cursor) - return Cursor + function Previous + (Object : Iterator; + Position : Cursor) return Cursor is pragma Unreferenced (Object); begin diff --git a/gcc/ada/a-ciorse.ads b/gcc/ada/a-ciorse.ads index 3700c15e6b3..78b5d764b06 100644 --- a/gcc/ada/a-ciorse.ads +++ b/gcc/ada/a-ciorse.ads @@ -48,12 +48,11 @@ package Ada.Containers.Indefinite_Ordered_Sets is function Equivalent_Elements (Left, Right : Element_Type) return Boolean; - type Set is tagged private - with - Constant_Indexing => Constant_Reference, - Variable_Indexing => Reference, - Default_Iterator => Iterate, - Iterator_Element => Element_Type; + type Set is tagged private with + Constant_Indexing => Constant_Reference, + Variable_Indexing => Reference, + Default_Iterator => Iterate, + Iterator_Element => Element_Type; pragma Preelaborable_Initialization (Set); @@ -63,15 +62,15 @@ package Ada.Containers.Indefinite_Ordered_Sets is Empty_Set : constant Set; No_Element : constant Cursor; + function Has_Element (Position : Cursor) return Boolean; package Ordered_Set_Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, Has_Element); type Constant_Reference_Type - (Element : not null access constant Element_Type) is - private - with + (Element : not null access constant Element_Type) is + private with Implicit_Dereference => Element; procedure Read @@ -87,8 +86,8 @@ package Ada.Containers.Indefinite_Ordered_Sets is for Constant_Reference_Type'Write use Write; function Constant_Reference - (Container : Set; Position : Cursor) - return Constant_Reference_Type; + (Container : Set; + Position : Cursor) return Constant_Reference_Type; type Reference_Type (Element : not null access Element_Type) is private with @@ -241,10 +240,13 @@ package Ada.Containers.Indefinite_Ordered_Sets is (Container : Set; Process : not null access procedure (Position : Cursor)); - function Iterate (Container : Set) + function Iterate + (Container : Set) return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class; - function Iterate (Container : Set; Start : Cursor) + function Iterate + (Container : Set; + Start : Cursor) return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class; generic diff --git a/gcc/ada/a-coinho.ads b/gcc/ada/a-coinho.ads index d5d0cf40478..4646b6722b8 100644 --- a/gcc/ada/a-coinho.ads +++ b/gcc/ada/a-coinho.ads @@ -2,7 +2,7 @@ -- -- -- GNAT LIBRARY COMPONENTS -- -- -- --- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S -- +-- A D A . C O N T A I N E R S . I N D E F I N I T E _ H O L D E R S -- -- -- -- S p e c -- -- -- diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads index 8457c031d04..a7dbfd62430 100644 --- a/gcc/ada/a-except-2005.ads +++ b/gcc/ada/a-except-2005.ads @@ -251,7 +251,7 @@ private -- is already deferred. function Triggered_By_Abort return Boolean; - -- Determine whether the current exception (if exists) is an instance of + -- Determine whether the current exception (if it exists) is an instance of -- Standard'Abort_Signal. ----------------------- diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 415267c7733..333dca54a28 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -1276,7 +1276,6 @@ package body Ada.Exceptions is function Triggered_By_Abort return Boolean is Ex : constant Exception_Occurrence_Access := Get_Current_Excep.all; - begin return Ex /= null and then Exception_Identity (Ex.all) = Standard'Abort_Signal'Identity; diff --git a/gcc/ada/a-except.ads b/gcc/ada/a-except.ads index 183bb0bf07c..d7c14bab4e3 100644 --- a/gcc/ada/a-except.ads +++ b/gcc/ada/a-except.ads @@ -222,7 +222,7 @@ private -- abort is already deferred. function Triggered_By_Abort return Boolean; - -- Determine whether the current exception (if exists) is an instance of + -- Determine whether the current exception (if it exists) is an instance of -- Standard'Abort_Signal. ----------------------- diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index fe9cef08289..037a8dcc6ea 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5215,9 +5215,10 @@ package body Exp_Aggr is ------------------------- function Top_Level_Aggregate (N : Node_Id) return Node_Id is - Aggr : Node_Id := N; + Aggr : Node_Id; begin + Aggr := N; while Present (Parent (Aggr)) and then Nkind_In (Parent (Aggr), N_Component_Association, N_Aggregate) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 4da232e5f9d..366140e9580 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2858,7 +2858,7 @@ package body Exp_Ch5 is New_Reference_To (Iterator, Loc))))); -- for Index in Array loop - -- + -- This case utilizes the already given iterator name else @@ -2869,7 +2869,7 @@ package body Exp_Ch5 is -- for Iterator in [reverse] Container'Range loop -- Element : Component_Type renames Container (Iterator); -- -- for the "of" form - -- + -- -- end loop; @@ -2952,10 +2952,12 @@ package body Exp_Ch5 is if Of_Present (I_Spec) then declare - Default_Iter : constant Entity_Id := - Entity ( - Find_Aspect - (Etype (Container), Aspect_Default_Iterator)); + Default_Iter : constant Entity_Id := + Entity + (Find_Aspect + (Etype (Container), + Aspect_Default_Iterator)); + Container_Arg : Node_Id; Ent : Entity_Id; @@ -2975,7 +2977,7 @@ package body Exp_Ch5 is -- inherited from the scope of the parent. if Base_Type (Etype (Container)) = - Base_Type (Etype (First_Formal (Default_Iter))) + Base_Type (Etype (First_Formal (Default_Iter))) then Container_Arg := New_Copy_Tree (Container); @@ -2985,8 +2987,8 @@ package body Exp_Ch5 is Container_Arg := Make_Type_Conversion (Loc, Subtype_Mark => - New_Occurrence_Of ( - Etype (First_Formal (Default_Iter)), Loc), + New_Occurrence_Of + (Etype (First_Formal (Default_Iter)), Loc), Expression => New_Copy_Tree (Container)); end if; @@ -3015,11 +3017,11 @@ package body Exp_Ch5 is Decl := Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Id, - Subtype_Mark => + Subtype_Mark => New_Reference_To (Element_Type, Loc), - Name => + Name => Make_Indexed_Component (Loc, - Prefix => Make_Selected_Component (Loc, + Prefix => Make_Selected_Component (Loc, Prefix => New_Reference_To (Pack, Loc), Selector_Name => Make_Identifier (Loc, Chars => Name_Element)), @@ -3042,7 +3044,7 @@ package body Exp_Ch5 is Stats := New_List ( Make_Block_Statement (Loc, - Declarations => New_List (Decl), + Declarations => New_List (Decl), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stats))); @@ -3078,10 +3080,12 @@ package body Exp_Ch5 is -- For both iterator forms, add a call to the step operation to -- advance the cursor. Generate: - -- - -- Cursor := Iterator.Next (Cursor); + + -- Cursor := Iterator.Next (Cursor); + -- or else - -- Cursor := Next (Cursor); + + -- Cursor := Next (Cursor); declare Rhs : Node_Id; @@ -3089,9 +3093,9 @@ package body Exp_Ch5 is begin Rhs := Make_Function_Call (Loc, - Name => + Name => Make_Selected_Component (Loc, - Prefix => New_Reference_To (Iterator, Loc), + Prefix => New_Reference_To (Iterator, Loc), Selector_Name => Make_Identifier (Loc, Name_Step)), Parameter_Associations => New_List ( New_Reference_To (Cursor, Loc))); @@ -3113,7 +3117,7 @@ package body Exp_Ch5 is Make_Iteration_Scheme (Loc, Condition => Make_Function_Call (Loc, - Name => + Name => Make_Selected_Component (Loc, Prefix => New_Occurrence_Of (Pack, Loc), Selector_Name => @@ -3127,7 +3131,7 @@ package body Exp_Ch5 is -- Create the declarations for Iterator and cursor and insert then -- before the source loop. Generate: - -- + -- I : Iterator_Type := Iterate (Container); -- C : Pack.Cursor_Type := Container.[First | Last]; @@ -3146,12 +3150,11 @@ package body Exp_Ch5 is Decl2 := Make_Object_Declaration (Loc, Defining_Identifier => Cursor, - Object_Definition => + Object_Definition => New_Occurrence_Of (Etype (Cursor), Loc), - - Expression => + Expression => Make_Selected_Component (Loc, - Prefix => New_Reference_To (Iterator, Loc), + Prefix => New_Reference_To (Iterator, Loc), Selector_Name => Make_Identifier (Loc, Name_Init))); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 34dfdd021e0..24b3e16eb70 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3062,7 +3062,7 @@ package body Exp_Ch7 is if RTE_Available (RE_Raise_From_Controlled_Operation) then Stmt := Make_Procedure_Call_Statement (Loc, - Name => + Name => New_Reference_To (RTE (RE_Raise_From_Controlled_Operation), Loc), Parameter_Associations => @@ -3087,7 +3087,7 @@ package body Exp_Ch7 is return Make_If_Statement (Loc, - Condition => + Condition => Make_And_Then (Loc, Left_Opnd => New_Reference_To (Raised_Id, Loc), Right_Opnd => diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 603ea2b461d..b77bb0b89ac 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -2117,14 +2117,12 @@ package body Exp_Disp is if Is_Interface (Typ) then return Make_Subprogram_Body (Loc, - Specification => - Make_Disp_Asynchronous_Select_Spec (Typ), - Declarations => - New_List, + Specification => Make_Disp_Asynchronous_Select_Spec (Typ), + Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, New_List (Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => New_Reference_To (Standard_False, Loc))))); end if; @@ -2270,7 +2268,7 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => New_Reference_To (Standard_False, Loc))); else @@ -2313,16 +2311,15 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => New_Reference_To (Standard_False, Loc))); end if; return Make_Subprogram_Body (Loc, - Specification => + Specification => Make_Disp_Asynchronous_Select_Spec (Typ), - Declarations => - Decls, + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Stmts)); end Make_Disp_Asynchronous_Select_Body; @@ -2490,7 +2487,7 @@ package body Exp_Disp is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, New_List (Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => New_Reference_To (Standard_False, Loc))))); end if; @@ -2696,20 +2693,19 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => New_Reference_To (Standard_False, Loc))); Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uC), + Name => Make_Identifier (Loc, Name_uC), Expression => New_Reference_To (RTE (RE_POK_Function), Loc))); end if; return Make_Subprogram_Body (Loc, - Specification => + Specification => Make_Disp_Conditional_Select_Spec (Typ), - Declarations => - Decls, + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Stmts)); end Make_Disp_Conditional_Select_Body; @@ -3346,9 +3342,10 @@ package body Exp_Disp is New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - New_List (Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), - Expression => New_Reference_To (Standard_False, Loc))))); + New_List ( + Make_Assignment_Statement (Loc, + Name => Make_Identifier (Loc, Name_uF), + Expression => New_Reference_To (Standard_False, Loc))))); end if; if Is_Concurrent_Record_Type (Typ) then @@ -3362,10 +3359,8 @@ package body Exp_Disp is Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uI), - Object_Definition => - New_Reference_To (Standard_Integer, Loc))); + Defining_Identifier => Make_Defining_Identifier (Loc, Name_uI), + Object_Definition => New_Reference_To (Standard_Integer, Loc))); -- Generate: -- C := Get_Prim_Op_Kind (tag! (VP), S); @@ -3394,7 +3389,7 @@ package body Exp_Disp is else Tag_Node := Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Typ, Loc), + Prefix => New_Reference_To (Typ, Loc), Attribute_Name => Name_Tag); end if; @@ -3403,8 +3398,7 @@ package body Exp_Disp is Name => Make_Identifier (Loc, Name_uI), Expression => Make_Function_Call (Loc, - Name => - New_Reference_To (RTE (RE_Get_Entry_Index), Loc), + Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc), Parameter_Associations => New_List ( Tag_Node, @@ -3531,20 +3525,18 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => New_Reference_To (Standard_False, Loc))); Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => Make_Identifier (Loc, Name_uC), + Name => Make_Identifier (Loc, Name_uC), Expression => New_Reference_To (RTE (RE_POK_Function), Loc))); end if; return Make_Subprogram_Body (Loc, - Specification => - Make_Disp_Timed_Select_Spec (Typ), - Declarations => - Decls, + Specification => Make_Disp_Timed_Select_Spec (Typ), + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Stmts)); end Make_Disp_Timed_Select_Body; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 8ec020437ef..cf85e4ee909 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -479,7 +479,7 @@ procedure Gnat1drv is -- We would prefer to suppress the expansion of tagged types and -- dispatching calls, so that one day GNATprove can handle them -- directly. Unfortunately, this is causing problems on H513-015, so - -- keep this expansion for the time being. + -- keep this expansion for the time being. ??? Tagged_Type_Expansion := True; end if; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index aba013d85ae..897b8c96b4e 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -2672,7 +2672,8 @@ package body Ch3 is Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); end if; - -- AI95-406 makes "aliased" legal (and useless) in this context. + -- AI95-406 makes "aliased" legal (and useless) in this context so + -- followintg code which used to be needed is commented out. -- if Aliased_Present then -- Error_Msg_SP ("ALIASED not allowed here"); @@ -3449,7 +3450,8 @@ package body Ch3 is Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); end if; - -- AI95-406 makes "aliased" legal (and useless) here. + -- AI95-406 makes "aliased" legal (and useless) here, so the + -- following code which used to be required is commented out. -- if Aliased_Present then -- Error_Msg_SP ("ALIASED not allowed here"); diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 626b8eee0d7..796e601cada 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Debug; +with Opt; with Osint; use Osint; with Output; use Output; with Prj.Attr; @@ -698,6 +699,11 @@ package body Prj is Prj.Attr.Initialize; + -- Make sure that new reserved words after Ada 95 may be used as + -- identifiers. + + Opt.Ada_Version := Opt.Ada_95; + Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External)); diff --git a/gcc/ada/s-auxdec-vms-alpha.adb b/gcc/ada/s-auxdec-vms-alpha.adb index 86c4629893f..4116e32b355 100644 --- a/gcc/ada/s-auxdec-vms-alpha.adb +++ b/gcc/ada/s-auxdec-vms-alpha.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/Or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -218,26 +218,26 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "lda $16, %3" & LF & HT & + "lda $16, %3" & LF & HT & -- Address of Bit "mb" & LF & HT & - "sll $16, 3, $18 " & LF & HT & - "bis $31, 1, %1" & LF & HT & - "and $18, 63, $19" & LF & HT & - "bic $18, 63, $18" & LF & HT & - "sra $18, 3, $18" & LF & HT & - "bis $31, %4, $17" & LF & HT & - "sll %1, $19, $19" & LF & HT & + "sll $16, 3, $18 " & LF & HT & -- Byte address to bit address + "bis $31, 1, %1" & LF & HT & -- Set temp to 1 for the sll + "and $18, 63, $19" & LF & HT & -- Quadword bit offset + "bic $18, 63, $18" & LF & HT & -- Quadword bit address + "sra $18, 3, $18" & LF & HT & -- Quadword address + "bis $31, %4, $17" & LF & HT & -- Retry_Count -> $17 + "sll %1, $19, $19" & LF & -- $19 = 1 << bit_offset "1:" & LF & HT & - "ldq_l %2, 0($18)" & LF & HT & - "and %2, $19, %1" & LF & HT & - "bis %2, $19, %2" & LF & HT & - "stq_c %2, 0($18)" & LF & HT & - "beq %2, 2f" & LF & HT & - "cmovne %1, 1, %1" & LF & HT & - "br 3f" & LF & HT & + "ldq_l %2, 0($18)" & LF & HT & -- Load & lock + "and %2, $19, %1" & LF & HT & -- Previous value -> %1 + "bis %2, $19, %2" & LF & HT & -- Set Bit + "stq_c %2, 0($18)" & LF & HT & -- Store conditional + "beq %2, 2f" & LF & HT & -- Goto 2: if failed + "cmovne %1, 1, %1" & LF & HT & -- Set Old_Bit + "br 3f" & LF & "2:" & LF & HT & - "subq $17, 1, $17" & LF & HT & - "bgt $17, 1b" & LF & HT & + "subq $17, 1, $17" & LF & HT & -- Retry_Count - 1 + "bgt $17, 1b" & LF & -- Retry ? "3:" & LF & HT & "mb" & LF & HT & "trapb", @@ -331,7 +331,7 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "mb" & LF & HT & + "mb" & LF & "1:" & LF & HT & "ldl_l $1, %0" & LF & HT & "addl $1, %2, $0" & LF & HT & @@ -358,21 +358,21 @@ package body System.Aux_DEC is System.Machine_Code.Asm ( "mb" & LF & HT & - "bis $31, %5, $17" & LF & HT & + "bis $31, %5, $17" & LF & "1:" & LF & HT & "ldl_l $1, %0" & LF & HT & "addl $1, %4, $0" & LF & HT & "stl_c $0, %3" & LF & HT & - "beq $0, 2f" & LF & HT & + "beq $0, 2f" & LF & "3:" & LF & HT & "mb" & LF & HT & "stq $0, %2" & LF & HT & "stl $1, %1" & LF & HT & - "br 4f" & LF & HT & + "br 4f" & LF & "2:" & LF & HT & "subq $17, 1, $17" & LF & HT & "bgt $17, 1b" & LF & HT & - "br 3b" & LF & HT & + "br 3b" & LF & "4:", Outputs => (Aligned_Integer'Asm_Output ("=m", To), Integer'Asm_Output ("=m", Old_Value), @@ -393,7 +393,7 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "mb" & LF & HT & + "mb" & LF & "1:" & LF & HT & "ldq_l $1, %0" & LF & HT & "addq $1, %2, $0" & LF & HT & @@ -420,21 +420,21 @@ package body System.Aux_DEC is System.Machine_Code.Asm ( "mb" & LF & HT & - "bis $31, %5, $17" & LF & HT & + "bis $31, %5, $17" & LF & "1:" & LF & HT & "ldq_l $1, %0" & LF & HT & "addq $1, %4, $0" & LF & HT & "stq_c $0, %3" & LF & HT & - "beq $0, 2f" & LF & HT & + "beq $0, 2f" & LF & "3:" & LF & HT & "mb" & LF & HT & "stq $0, %2" & LF & HT & "stq $1, %1" & LF & HT & - "br 4f" & LF & HT & + "br 4f" & LF & "2:" & LF & HT & "subq $17, 1, $17" & LF & HT & "bgt $17, 1b" & LF & HT & - "br 3b" & LF & HT & + "br 3b" & LF & "4:", Outputs => (Aligned_Long_Integer'Asm_Output ("=m", To), Long_Integer'Asm_Output ("=m", Old_Value), @@ -459,7 +459,7 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "mb" & LF & HT & + "mb" & LF & "1:" & LF & HT & "ldl_l $1, %0" & LF & HT & "and $1, %2, $0" & LF & HT & @@ -486,21 +486,21 @@ package body System.Aux_DEC is System.Machine_Code.Asm ( "mb" & LF & HT & - "bis $31, %5, $17" & LF & HT & + "bis $31, %5, $17" & LF & "1:" & LF & HT & "ldl_l $1, %0" & LF & HT & "and $1, %4, $0" & LF & HT & "stl_c $0, %3" & LF & HT & - "beq $0, 2f" & LF & HT & + "beq $0, 2f" & LF & "3:" & LF & HT & "mb" & LF & HT & "stq $0, %2" & LF & HT & "stl $1, %1" & LF & HT & - "br 4f" & LF & HT & + "br 4f" & LF & "2:" & LF & HT & "subq $17, 1, $17" & LF & HT & "bgt $17, 1b" & LF & HT & - "br 3b" & LF & HT & + "br 3b" & LF & "4:", Outputs => (Aligned_Integer'Asm_Output ("=m", To), Integer'Asm_Output ("=m", Old_Value), @@ -521,7 +521,7 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "mb" & LF & HT & + "mb" & LF & "1:" & LF & HT & "ldq_l $1, %0" & LF & HT & "and $1, %2, $0" & LF & HT & @@ -548,21 +548,21 @@ package body System.Aux_DEC is System.Machine_Code.Asm ( "mb" & LF & HT & - "bis $31, %5, $17" & LF & HT & + "bis $31, %5, $17" & LF & "1:" & LF & HT & "ldq_l $1, %0" & LF & HT & "and $1, %4, $0" & LF & HT & "stq_c $0, %3" & LF & HT & - "beq $0, 2f" & LF & HT & + "beq $0, 2f" & LF & "3:" & LF & HT & "mb" & LF & HT & "stq $0, %2" & LF & HT & "stq $1, %1" & LF & HT & - "br 4f" & LF & HT & + "br 4f" & LF & "2:" & LF & HT & "subq $17, 1, $17" & LF & HT & "bgt $17, 1b" & LF & HT & - "br 3b" & LF & HT & + "br 3b" & LF & "4:", Outputs => (Aligned_Long_Integer'Asm_Output ("=m", To), Long_Integer'Asm_Output ("=m", Old_Value), @@ -587,7 +587,7 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "mb" & LF & HT & + "mb" & LF & "1:" & LF & HT & "ldl_l $1, %0" & LF & HT & "bis $1, %2, $0" & LF & HT & @@ -614,21 +614,21 @@ package body System.Aux_DEC is System.Machine_Code.Asm ( "mb" & LF & HT & - "bis $31, %5, $17" & LF & HT & + "bis $31, %5, $17" & LF & "1:" & LF & HT & "ldl_l $1, %0" & LF & HT & "bis $1, %4, $0" & LF & HT & "stl_c $0, %3" & LF & HT & - "beq $0, 2f" & LF & HT & + "beq $0, 2f" & LF & "3:" & LF & HT & "mb" & LF & HT & "stq $0, %2" & LF & HT & "stl $1, %1" & LF & HT & - "br 4f" & LF & HT & + "br 4f" & LF & "2:" & LF & HT & "subq $17, 1, $17" & LF & HT & "bgt $17, 1b" & LF & HT & - "br 3b" & LF & HT & + "br 3b" & LF & "4:", Outputs => (Aligned_Integer'Asm_Output ("=m", To), Integer'Asm_Output ("=m", Old_Value), @@ -649,7 +649,7 @@ package body System.Aux_DEC is begin System.Machine_Code.Asm ( - "mb" & LF & HT & + "mb" & LF & "1:" & LF & HT & "ldq_l $1, %0" & LF & HT & "bis $1, %2, $0" & LF & HT & @@ -676,21 +676,21 @@ package body System.Aux_DEC is System.Machine_Code.Asm ( "mb" & LF & HT & - "bis $31, %5, $17" & LF & HT & + "bis $31, %5, $17" & LF & "1:" & LF & HT & "ldq_l $1, %0" & LF & HT & "bis $1, %4, $0" & LF & HT & "stq_c $0, %3" & LF & HT & - "beq $0, 2f" & LF & HT & + "beq $0, 2f" & LF & "3:" & LF & HT & "mb" & LF & HT & "stq $0, %2" & LF & HT & "stq $1, %1" & LF & HT & - "br 4f" & LF & HT & + "br 4f" & LF & "2:" & LF & HT & "subq $17, 1, $17" & LF & HT & "bgt $17, 1b" & LF & HT & - "br 3b" & LF & HT & + "br 3b" & LF & "4:", Outputs => (Aligned_Long_Integer'Asm_Output ("=m", To), Long_Integer'Asm_Output ("=m", Old_Value), diff --git a/gcc/ada/s-parint.ads b/gcc/ada/s-parint.ads index 3086d4210d8..457be066012 100644 --- a/gcc/ada/s-parint.ads +++ b/gcc/ada/s-parint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1995-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2011, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -47,8 +47,9 @@ package System.Partition_Interface is PCS_Version : constant := 1; -- Version of the PCS API (for Exp_Dist consistency check). - -- This version number is matched against Gnatvsn.PCS_Version_Number to - -- ensure that the versions of Exp_Dist and the PCS are consistent. + -- This version number is matched against corresponding element of + -- Exp_Dist.PCS_Version_Number to ensure that the versions of Exp_Dist and + -- the PCS are consistent. -- RCI receiving stubs contain a table of descriptors for -- all user subprograms exported by the unit. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 873e13baf61..fbc9aa906fe 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2574,7 +2574,7 @@ package body Sem_Ch12 is if Subp /= Any_Id then - -- Subprogram found, generate reference to it. + -- Subprogram found, generate reference to it Set_Entity (Def, Subp); Generate_Reference (Subp, Def); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 7b2d9e74f2d..a926280b2a0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5767,8 +5767,8 @@ package body Sem_Ch13 is A_Id = Aspect_Default_Iterator or else A_Id = Aspect_Iterator_Element then - -- Make type unfrozen before analysis, to prevent spurious - -- errors about late attributes. + -- Make type unfrozen before analysis, to prevent spurious errors + -- about late attributes. Set_Is_Frozen (Ent, False); Analyze (End_Decl_Expr); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c1cd42d2950..91abe52248a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15003,8 +15003,8 @@ package body Sem_Ch3 is Set_Has_Private_Declaration (Prev); Set_Has_Private_Declaration (Id); - -- Preserve aspect and iterator flags, that may have been - -- set on the partial view. + -- Preserve aspect and iterator flags that may have been set on + -- the partial view. Set_Has_Delayed_Aspects (Prev, Has_Delayed_Aspects (Id)); Set_Has_Implicit_Dereference (Prev, Has_Implicit_Dereference (Id)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4b2b9eab260..6b045989970 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3345,6 +3345,9 @@ package body Sem_Ch4 is Iterator : Node_Id; begin + -- Analyze construct with expansion disabled, because it will be + -- rewritten as a loop during expansion. + Expander_Mode_Save_And_Set (False); Check_SPARK_Restriction ("quantified expression is not allowed", N); @@ -3367,9 +3370,9 @@ package body Sem_Ch4 is Set_Parent (Iterator, N); Analyze_Iteration_Scheme (Iterator); - -- The loop specification may have been converted into an - -- iterator specification during its analysis. Update the - -- quantified node accordingly. + -- The loop specification may have been converted into an iterator + -- specification during its analysis. Update the quantified node + -- accordingly. if Present (Iterator_Specification (Iterator)) then Set_Iterator_Specification diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5ac99e87790..7de014fefe9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2006,22 +2006,20 @@ package body Sem_Ch5 is Set_Parent (D_Copy, Parent (DS)); Pre_Analyze_Range (D_Copy); - -- Ada2012 : if the domain of iteration is a function call, + -- Ada2012: If the domain of iteration is a function call, -- it is the new iterator form. -- We have also implemented the shorter form : for X in S - -- for Alfa use. In this case the attributes Old and Result - -- must be treated as entity names over which iterators are - -- legal. + -- for Alfa use. In this case, 'Old and 'Result must be + -- treated as entity names over which iterators are legal. if Nkind (D_Copy) = N_Function_Call or else (ALFA_Mode - and then (Nkind (D_Copy) = N_Attribute_Reference - and then - (Attribute_Name (D_Copy) = Name_Result + and then (Nkind (D_Copy) = N_Attribute_Reference + and then + (Attribute_Name (D_Copy) = Name_Result or else Attribute_Name (D_Copy) = Name_Old))) - or else (Is_Entity_Name (D_Copy) and then not Is_Type (Entity (D_Copy))) @@ -2044,8 +2042,8 @@ package body Sem_Ch5 is Set_Loop_Parameter_Specification (N, Empty); Analyze_Iterator_Specification (I_Spec); - -- In a generic context, analyze the original - -- domain of iteration, for name capture. + -- In a generic context, analyze the original domain + -- of iteration, for name capture. if not Expander_Active then Analyze (DS); @@ -2267,22 +2265,21 @@ package body Sem_Ch5 is Object_Definition => New_Occurrence_Of (Typ, Loc), Expression => Relocate_Node (Iter_Name)); - Insert_Actions - (Parent (Parent (N)), New_List (Decl)); + Insert_Actions (Parent (Parent (N)), New_List (Decl)); Rewrite (Name (N), New_Occurrence_Of (Id, Loc)); Set_Etype (Id, Typ); Set_Etype (Name (N), Typ); end; - else - - -- Container is an entity or an array with uncontrolled components, - -- or else it is a container iterator given by a function call, - -- typically called Iterate in the case of predefined containers, - -- even though Iterate is not a reserved name. What matter is that - -- the return type of the function is an iterator type. + -- Container is an entity or an array with uncontrolled components, or + -- else it is a container iterator given by a function call, typically + -- called Iterate in the case of predefined containers, even though + -- Iterate is not a reserved name. What matter is that the return type + -- of the function is an iterator type. + else Analyze (Iter_Name); + if Nkind (Iter_Name) = N_Function_Call then declare C : constant Node_Id := Name (Iter_Name); @@ -2312,10 +2309,9 @@ package body Sem_Ch5 is end if; end; - else - - -- domain of iteration is not overloaded. + -- Domain of iteration is not overloaded + else Resolve (Iter_Name, Etype (Iter_Name)); end if; end if; @@ -2331,7 +2327,7 @@ package body Sem_Ch5 is Set_Etype (Def_Id, Etype (First_Index (Typ))); end if; - -- Check for type error in iterator. + -- Check for type error in iterator elsif Typ = Any_Type then return; @@ -2343,16 +2339,16 @@ package body Sem_Ch5 is if Of_Present (N) then - -- The type of the loop variable is the Iterator_Element - -- aspect of the container type. + -- The type of the loop variable is the Iterator_Element aspect of + -- the container type. Set_Etype (Def_Id, Entity (Find_Aspect (Typ, Aspect_Iterator_Element))); else - -- The result type of Iterate function is the classwide type - -- of the interface parent. We need the specific Cursor type - -- defined in the container package. + -- The result type of Iterate function is the classwide type of + -- the interface parent. We need the specific Cursor type defined + -- in the container package. Ent := First_Entity (Scope (Typ)); while Present (Ent) loop diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 15c96c6ba2a..0b04142f9a9 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4381,7 +4381,7 @@ package body Sem_Res is end if; end if; - -- Report a simple error: if the designated object is a local task, + -- Report a simple error: if the designated object is a local task, -- its body has not been seen yet, and its activation will fail an -- elaboration check. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e855da24ef4..7589b659f8c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7178,16 +7178,15 @@ package body Sem_Util is if Is_Class_Wide_Type (Typ) and then (Chars (Etype (Typ)) = Name_Forward_Iterator - or else Chars (Etype (Typ)) = Name_Reversible_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 + elsif not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then return False; else @@ -7211,50 +7210,6 @@ package body Sem_Util is 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 -- ------------ @@ -7898,6 +7853,50 @@ 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 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_Selector_Name -- ---------------------- -- 2.30.2