From 2cc7967fbeef31d46df49a9aaa92af1cddb9fca6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 21 Apr 2016 10:19:35 +0200 Subject: [PATCH] [multiple changes] 2016-04-21 Hristian Kirtchev * sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor reformatting. 2016-04-21 Ed Schonberg * sem_util.adb (Denotes_Iterator): Use root type to determine whether the ultimate ancestor is the predefined iterator interface pakage. * exp_ch5.adb (Expand_Iterator_Over_Container): simplify code and avoid reuse of Pack local variable. 2016-04-21 Olivier Hainque * system-vxworks-arm.ads, system-vxworks-sparcv9.ads, system-vxworks-ppc.ads, system-vxworks-m68k.ads, system-vxworks-mips.ads, system-vxworks-x86.ads: Define Executable_Extension to ".out". From-SVN: r235304 --- gcc/ada/ChangeLog | 20 ++++ gcc/ada/exp_ch5.adb | 148 +++++++++++++++++------------ gcc/ada/exp_unst.adb | 5 +- gcc/ada/exp_util.adb | 6 +- gcc/ada/sem_ch13.adb | 25 +++-- gcc/ada/sem_ch3.adb | 3 +- gcc/ada/sem_util.adb | 7 +- gcc/ada/system-vxworks-arm.ads | 4 +- gcc/ada/system-vxworks-m68k.ads | 2 + gcc/ada/system-vxworks-mips.ads | 2 + gcc/ada/system-vxworks-ppc.ads | 2 + gcc/ada/system-vxworks-sparcv9.ads | 2 + gcc/ada/system-vxworks-x86.ads | 2 + 13 files changed, 148 insertions(+), 80 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 917345be9a6c..8ba447ef9d5d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2016-04-21 Hristian Kirtchev + + * sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor + reformatting. + +2016-04-21 Ed Schonberg + + * sem_util.adb (Denotes_Iterator): Use root type to determine + whether the ultimate ancestor is the predefined iterator + interface pakage. + * exp_ch5.adb (Expand_Iterator_Over_Container): simplify code + and avoid reuse of Pack local variable. + +2016-04-21 Olivier Hainque + + * system-vxworks-arm.ads, system-vxworks-sparcv9.ads, + system-vxworks-ppc.ads, system-vxworks-m68k.ads, + system-vxworks-mips.ads, system-vxworks-x86.ads: Define + Executable_Extension to ".out". + 2016-04-21 Javier Miranda * frontend.adb: Update call to Unnest_Subprograms. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 139f5ca3ae24..2f7e5d1dad99 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -3605,25 +3605,31 @@ package body Exp_Ch5 is Container : Node_Id; Container_Typ : Entity_Id) is - Id : constant Entity_Id := Defining_Identifier (I_Spec); - Loc : constant Source_Ptr := Sloc (N); - - I_Kind : constant Entity_Kind := Ekind (Id); - Cursor : Entity_Id; - Iterator : Entity_Id; - New_Loop : Node_Id; - Stats : constant List_Id := Statements (N); + Id : constant Entity_Id := Defining_Identifier (I_Spec); + Elem_Typ : constant Entity_Id := Etype (Id); + Id_Kind : constant Entity_Kind := Ekind (Id); + Loc : constant Source_Ptr := Sloc (N); + Stats : constant List_Id := Statements (N); - Element_Type : constant Entity_Id := Etype (Id); - Iter_Type : Entity_Id; - Pack : Entity_Id; - Decl : Node_Id; - Name_Init : Name_Id; - Name_Step : Name_Id; + Cursor : Entity_Id; + Decl : Node_Id; + Iter_Type : Entity_Id; + Iterator : Entity_Id; + Name_Init : Name_Id; + Name_Step : Name_Id; + New_Loop : Node_Id; - Fast_Element_Access_Op, Fast_Step_Op : Entity_Id := Empty; + Fast_Element_Access_Op : Entity_Id := Empty; + Fast_Step_Op : Entity_Id := Empty; -- Only for optimized version of "for ... of" + Iter_Pack : Entity_Id; + -- The package in which the iterator interface is instantiated. This is + -- typically an instance within the container package. + + Pack : Entity_Id; + -- The package in which the container type is declared + begin -- Determine the advancement and initialization steps for the cursor. -- Analysis of the expanded loop will verify that the container has a @@ -3658,8 +3664,6 @@ package body Exp_Ch5 is Pack := Scope (Container_Typ); end if; - Iter_Type := Etype (Name (I_Spec)); - if Of_Present (I_Spec) then Handle_Of : declare Container_Arg : Node_Id; @@ -3734,6 +3738,8 @@ package body Exp_Ch5 is end if; end Get_Default_Iterator; + -- Local variables + Default_Iter : Entity_Id; Ent : Entity_Id; @@ -3760,6 +3766,12 @@ package body Exp_Ch5 is Iter_Type := Etype (Default_Iter); + -- The iterator type, which is a class-wide type, may itself be + -- derived locally, so the desired instantiation is the scope of + -- the root type of the iterator type. + + Iter_Pack := Scope (Root_Type (Etype (Iter_Type))); + -- Find declarations needed for "for ... of" optimization Ent := First_Entity (Pack); @@ -3798,28 +3810,35 @@ package body Exp_Ch5 is New_List (New_Copy_Tree (Container_Arg))))); end if; - -- The iterator type, which is a class-wide type, may itself be - -- derived locally, so the desired instantiation is the scope of - -- the root type of the iterator type. Currently, Pack is the - -- container instance; this overwrites it with the iterator - -- package. + -- Rewrite domain of iteration as a call to the default iterator + -- for the container type. The formal may be an access parameter + -- in which case we must build a reference to the container. - Pack := Scope (Root_Type (Etype (Iter_Type))); + declare + Arg : Node_Id; + begin + if Is_Access_Type (Etype (First_Entity (Default_Iter))) then + Arg := + Make_Attribute_Reference (Loc, + Prefix => Container_Arg, + Attribute_Name => Name_Unrestricted_Access); + else + Arg := Container_Arg; + end if; - -- Rewrite domain of iteration as a call to the default iterator - -- for the container type. + Rewrite (Name (I_Spec), + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (Default_Iter, Loc), + Parameter_Associations => New_List (Arg))); + end; - Rewrite (Name (I_Spec), - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Default_Iter, Loc), - Parameter_Associations => New_List (Container_Arg))); Analyze_And_Resolve (Name (I_Spec)); -- Find cursor type in proper iterator package, which is an -- instantiation of Iterator_Interfaces. - Ent := First_Entity (Pack); + Ent := First_Entity (Iter_Pack); while Present (Ent) loop if Chars (Ent) = Name_Cursor then Set_Etype (Cursor, Etype (Ent)); @@ -3834,7 +3853,7 @@ package body Exp_Ch5 is Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Id, Subtype_Mark => - New_Occurrence_Of (Element_Type, Loc), + New_Occurrence_Of (Elem_Typ, Loc), Name => Make_Explicit_Dereference (Loc, Prefix => @@ -3849,7 +3868,7 @@ package body Exp_Ch5 is Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Id, Subtype_Mark => - New_Occurrence_Of (Element_Type, Loc), + New_Occurrence_Of (Elem_Typ, Loc), Name => Make_Indexed_Component (Loc, Prefix => Relocate_Node (Container_Arg), @@ -3857,8 +3876,8 @@ package body Exp_Ch5 is New_List (New_Occurrence_Of (Cursor, Loc)))); end if; - -- The defining identifier in the iterator is user-visible - -- and must be visible in the debugger. + -- The defining identifier in the iterator is user-visible and + -- must be visible in the debugger. Set_Debug_Info_Needed (Id); @@ -3878,18 +3897,25 @@ package body Exp_Ch5 is Prepend_To (Stats, Decl); end Handle_Of; - -- X in Iterate (S) : type of iterator is type of explicitly - -- given Iterate function, and the loop variable is the cursor. - -- It will be assigned in the loop and must be a variable. + -- X in Iterate (S) : type of iterator is type of explicitly given + -- Iterate function, and the loop variable is the cursor. It will be + -- assigned in the loop and must be a variable. else + Iter_Type := Etype (Name (I_Spec)); + + -- The iterator type, which is a class-wide type, may itself be + -- derived locally, so the desired instantiation is the scope of + -- the root type of the iterator type, as in the "of" case. + + Iter_Pack := Scope (Root_Type (Etype (Iter_Type))); Cursor := Id; end if; Iterator := Make_Temporary (Loc, 'I'); - -- For both iterator forms, add a call to the step operation to - -- advance the cursor. Generate: + -- For both iterator forms, add a call to the step operation to advance + -- the cursor. Generate: -- Cursor := Iterator.Next (Cursor); @@ -3899,8 +3925,9 @@ package body Exp_Ch5 is if Present (Fast_Element_Access_Op) and then Present (Fast_Step_Op) then declare - Step_Call : Node_Id; Curs_Name : constant Node_Id := New_Occurrence_Of (Cursor, Loc); + Step_Call : Node_Id; + begin Step_Call := Make_Procedure_Call_Statement (Loc, @@ -3948,16 +3975,16 @@ package body Exp_Ch5 is Condition => Make_Function_Call (Loc, Name => - New_Occurrence_Of ( - Next_Entity (First_Entity (Pack)), Loc), - Parameter_Associations => - New_List (New_Occurrence_Of (Cursor, Loc)))), + New_Occurrence_Of + (Next_Entity (First_Entity (Iter_Pack)), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Cursor, Loc)))), Statements => Stats, End_Label => Empty); - -- If present, preserve identifier of loop, which can be used in - -- an exit statement in the body. + -- If present, preserve identifier of loop, which can be used in an exit + -- statement in the body. if Present (Identifier (N)) then Set_Identifier (New_Loop, Relocate_Node (Identifier (N))); @@ -3971,22 +3998,23 @@ package body Exp_Ch5 is Insert_Action (N, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Iterator, - Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc), - Name => Relocate_Node (Name (I_Spec)))); + Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc), + Name => Relocate_Node (Name (I_Spec)))); -- Create declaration for cursor declare Cursor_Decl : constant Node_Id := - Make_Object_Declaration (Loc, - Defining_Identifier => Cursor, - Object_Definition => - New_Occurrence_Of (Etype (Cursor), Loc), - Expression => - Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Iterator, Loc), - Selector_Name => - Make_Identifier (Loc, Name_Init))); + Make_Object_Declaration (Loc, + Defining_Identifier => Cursor, + Object_Definition => + New_Occurrence_Of (Etype (Cursor), Loc), + Expression => + Make_Selected_Component (Loc, + Prefix => + New_Occurrence_Of (Iterator, Loc), + Selector_Name => + Make_Identifier (Loc, Name_Init))); begin -- The cursor is only modified in expanded code, so it appears @@ -3999,7 +4027,7 @@ package body Exp_Ch5 is Set_Assignment_OK (Cursor_Decl); Insert_Action (N, Cursor_Decl); - Set_Ekind (Cursor, I_Kind); + Set_Ekind (Cursor, Id_Kind); end; -- If the range of iteration is given by a function call that returns diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index d5eb07d4383e..d1475e7d1ead 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -1721,7 +1721,6 @@ package body Exp_Unst is ------------------------ procedure Unnest_Subprograms (N : Node_Id) is - function Search_Subprograms (N : Node_Id) return Traverse_Result; -- Tree visitor that search for outer level procedures with nested -- subprograms and invokes Unnest_Subprogram() @@ -1732,9 +1731,7 @@ package body Exp_Unst is function Search_Subprograms (N : Node_Id) return Traverse_Result is begin - if Nkind_In (N, N_Subprogram_Body, - N_Subprogram_Body_Stub) - then + if Nkind_In (N, N_Subprogram_Body, N_Subprogram_Body_Stub) then declare Spec_Id : constant Entity_Id := Unique_Defining_Entity (N); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b78907632243..52f5157e40cc 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1728,11 +1728,12 @@ package body Exp_Util is ---------------------------------------- function Containing_Package_With_Ext_Axioms - (E : Entity_Id) return Entity_Id is + (E : Entity_Id) return Entity_Id + is begin -- E is the package or generic package which is externally axiomatized - if Ekind_In (E, E_Package, E_Generic_Package) + if Ekind_In (E, E_Generic_Package, E_Package) and then Has_Annotate_Pragma_For_External_Axiomatization (E) then return E; @@ -1758,6 +1759,7 @@ package body Exp_Util is declare Par : constant Node_Id := Parent (E); Decl : Node_Id; + begin if Nkind (Par) = N_Defining_Program_Unit_Name then Decl := Parent (Par); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 57e4c8dcb81a..777964e2d3d0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8438,11 +8438,11 @@ package body Sem_Ch13 is -- Entity for argument of separate Predicate procedure when exceptions -- are present in expression. - FDecl : Node_Id; - -- The function declaration. + FDecl : Node_Id; + -- The function declaration - SId : Entity_Id; - -- Its entity. + SId : Entity_Id; + -- Its entity Raise_Expression_Present : Boolean := False; -- Set True if Expr has at least one Raise_Expression @@ -8725,6 +8725,7 @@ package body Sem_Ch13 is Add_Call (Atyp); end if; end; + -- Add Predicates for the current type Add_Predicates; @@ -8842,7 +8843,7 @@ package body Sem_Ch13 is Insert_Before_And_Analyze (N, FDecl); end if; - Insert_After_And_Analyze (N, FBody); + Insert_After_And_Analyze (N, FBody); -- Static predicate functions are always side-effect free, and -- in most cases dynamic predicate functions are as well. Mark @@ -9065,7 +9066,8 @@ package body Sem_Ch13 is Loc : constant Source_Ptr := Sloc (Typ); Object_Entity : constant Entity_Id := - Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('I')); + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('I')); -- The formal parameter of the function @@ -12613,9 +12615,10 @@ package body Sem_Ch13 is then Find_Selected_Component (Parent (N)); end if; + return Skip; - elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then + elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then Find_Direct_Name (N); Set_Entity (N, Empty); end if; @@ -12625,6 +12628,8 @@ package body Sem_Ch13 is procedure Resolve_Aspect_Expression is new Traverse_Proc (Resolve_Name); + -- Start of processing for Resolve_Aspect_Expressions + begin ASN := First_Rep_Item (E); while Present (ASN) loop @@ -12637,7 +12642,7 @@ package body Sem_Ch13 is -- subprograms, or that may mention current instances of -- types. These will require special handling (???TBD). - when Aspect_Predicate | + when Aspect_Predicate | Aspect_Predicate_Failure | Aspect_Invariant => null; @@ -12645,13 +12650,13 @@ package body Sem_Ch13 is when Aspect_Static_Predicate | Aspect_Dynamic_Predicate => - -- build predicate function specification and preanalyze + -- Build predicate function specification and preanalyze -- expression after type replacement. if No (Predicate_Function (E)) then declare FDecl : constant Node_Id := - Build_Predicate_Function_Declaration (E); + Build_Predicate_Function_Declaration (E); pragma Unreferenced (FDecl); begin Resolve_Aspect_Expression (Expr); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 71af299777db..615a7d25e75b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11826,8 +11826,9 @@ package body Sem_Ch3 is if Has_Predicates (Priv) then Set_Has_Predicates (Full); + if Present (Predicate_Function (Priv)) - and then No (Predicate_Function (Full)) + and then No (Predicate_Function (Full)) then Set_Predicate_Function (Full, Predicate_Function (Priv)); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ac4e8c2a39a2..0702cc71970a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -12650,11 +12650,14 @@ package body Sem_Util is function Denotes_Iterator (Iter_Typ : Entity_Id) return Boolean is begin + -- Check that the name matches, and that the ultimate ancestor is in + -- a predefined unit, i.e the one that declares iterator interfaces. + return Nam_In (Chars (Iter_Typ), Name_Forward_Iterator, Name_Reversible_Iterator) and then Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Iter_Typ))); + (Unit_File_Name (Get_Source_Unit (Root_Type (Iter_Typ)))); end Denotes_Iterator; -- Local variables diff --git a/gcc/ada/system-vxworks-arm.ads b/gcc/ada/system-vxworks-arm.ads index c3b429f9cbd2..16cd2b0d5a21 100644 --- a/gcc/ada/system-vxworks-arm.ads +++ b/gcc/ada/system-vxworks-arm.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (VxWorks Version ARM) -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -161,4 +161,6 @@ private Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; + Executable_Extension : constant String := ".out"; + end System; diff --git a/gcc/ada/system-vxworks-m68k.ads b/gcc/ada/system-vxworks-m68k.ads index ca59e7a9d9ba..1fab781a7da1 100644 --- a/gcc/ada/system-vxworks-m68k.ads +++ b/gcc/ada/system-vxworks-m68k.ads @@ -157,4 +157,6 @@ private Frontend_Exceptions : constant Boolean := True; ZCX_By_Default : constant Boolean := False; + Executable_Extension : constant String := ".out"; + end System; diff --git a/gcc/ada/system-vxworks-mips.ads b/gcc/ada/system-vxworks-mips.ads index d4860f42daf4..5cba6cd932b9 100644 --- a/gcc/ada/system-vxworks-mips.ads +++ b/gcc/ada/system-vxworks-mips.ads @@ -157,4 +157,6 @@ private Frontend_Exceptions : constant Boolean := True; ZCX_By_Default : constant Boolean := False; + Executable_Extension : constant String := ".out"; + end System; diff --git a/gcc/ada/system-vxworks-ppc.ads b/gcc/ada/system-vxworks-ppc.ads index bb27ee4b9933..ea2eff982325 100644 --- a/gcc/ada/system-vxworks-ppc.ads +++ b/gcc/ada/system-vxworks-ppc.ads @@ -164,4 +164,6 @@ private Frontend_Exceptions : constant Boolean := True; ZCX_By_Default : constant Boolean := False; + Executable_Extension : constant String := ".out"; + end System; diff --git a/gcc/ada/system-vxworks-sparcv9.ads b/gcc/ada/system-vxworks-sparcv9.ads index f3caca4fea93..a7c0b5a0a47a 100644 --- a/gcc/ada/system-vxworks-sparcv9.ads +++ b/gcc/ada/system-vxworks-sparcv9.ads @@ -159,4 +159,6 @@ private Frontend_Exceptions : constant Boolean := True; ZCX_By_Default : constant Boolean := False; + Executable_Extension : constant String := ".out"; + end System; diff --git a/gcc/ada/system-vxworks-x86.ads b/gcc/ada/system-vxworks-x86.ads index a7508aadfa36..22f42f3c6da0 100644 --- a/gcc/ada/system-vxworks-x86.ads +++ b/gcc/ada/system-vxworks-x86.ads @@ -161,4 +161,6 @@ private Frontend_Exceptions : constant Boolean := True; ZCX_By_Default : constant Boolean := False; + Executable_Extension : constant String := ".out"; + end System; -- 2.47.2