From 07ef182e37382f49a97e8da1ce3508acdf3e3493 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Oct 2012 10:19:14 +0200 Subject: [multiple changes] 2012-10-02 Vincent Pucci * sem_attr.adb (Analyze_Attribute): Check dimension for attribute Old before it gets expanded. * sem_dim.adb (Analyze_Dimension_Has_Etype): Correctly propagate dimensions for identifier. 2012-10-02 Ed Schonberg * exp_ch5.adb (Expand_Iterator_Loop): Handle properly the case where the iterator type is derived locally from an instantiation of Ada.Iterators_Interface. * exp_ch7.adb (Establish_Transient_Scope): Do not create a transient scope if within the expansion of an iterator loop, because a transient block already exists. 2012-10-02 Vincent Celier * gnatcmd.adb: Use absolute path for configuration pragmas files * make.adb (Configuration_Pragmas_Switch.Absolute_Path): Moved to Makeutl. * makeutl.ads, makeutl.adb (Absolute_Path): New function, moved from make.adb. 2012-10-02 Vincent Celier * prj-part.adb (Post_Parse_Context_Clause): Resurrect Boolean parameter In_Limited. Check for circularity also if In_Limited is True. (Parse_Single_Project): Call Post_Parse_Context_Clause with In_Limited parameter. From-SVN: r191961 --- gcc/ada/ChangeLog | 32 ++++++++++++++++++++++++++++++++ gcc/ada/exp_ch5.adb | 12 ++++++++++-- gcc/ada/exp_ch7.adb | 8 ++++++-- gcc/ada/gnatcmd.adb | 23 ++++++++++++++++------- gcc/ada/make.adb | 38 -------------------------------------- gcc/ada/makeutl.adb | 31 +++++++++++++++++++++++++++++++ gcc/ada/makeutl.ads | 5 +++++ gcc/ada/prj-part.adb | 10 ++++++++-- gcc/ada/sem_attr.adb | 1 + gcc/ada/sem_dim.adb | 16 +++++++++++----- 10 files changed, 120 insertions(+), 56 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 79f37c7..bd06961 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2012-10-02 Vincent Pucci + + * sem_attr.adb (Analyze_Attribute): Check dimension for attribute + Old before it gets expanded. + * sem_dim.adb (Analyze_Dimension_Has_Etype): Correctly propagate + dimensions for identifier. + +2012-10-02 Ed Schonberg + + * exp_ch5.adb (Expand_Iterator_Loop): Handle properly the case + where the iterator type is derived locally from an instantiation + of Ada.Iterators_Interface. + * exp_ch7.adb (Establish_Transient_Scope): Do not create a + transient scope if within the expansion of an iterator loop, + because a transient block already exists. + +2012-10-02 Vincent Celier + + * gnatcmd.adb: Use absolute path for configuration pragmas files + * make.adb (Configuration_Pragmas_Switch.Absolute_Path): Moved + to Makeutl. + * makeutl.ads, makeutl.adb (Absolute_Path): New function, moved from + make.adb. + +2012-10-02 Vincent Celier + + * prj-part.adb (Post_Parse_Context_Clause): Resurrect Boolean + parameter In_Limited. Check for circularity also if In_Limited + is True. + (Parse_Single_Project): Call Post_Parse_Context_Clause with + In_Limited parameter. + 2012-10-02 Bob Duff * checks.adb (Apply_Predicate_Check): Disable check in -gnatc mode. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index a1aaa37..e9ec75e 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3039,10 +3039,18 @@ package body Exp_Ch5 is Cursor := Make_Temporary (Loc, 'I'); -- For an container element iterator, the iterator type - -- is obtained from the corresponding aspect. + -- is obtained from the corresponding aspect, whose return + -- type is descended from the corresponding interface type + -- in some instance of Ada.Iterator_Interfaces. The actuals + -- of that instantiation are Cursor and Has_Element. Iter_Type := Etype (Default_Iter); - Pack := Scope (Iter_Type); + + -- 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. + + Pack := Scope (Root_Type (Etype (Iter_Type))); -- Rewrite domain of iteration as a call to the default -- iterator for the container type. If the container is diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 9c6955a..2a2b7dd 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3639,9 +3639,13 @@ package body Exp_Ch7 is -- If the node to wrap is an iteration_scheme, the expression is -- one of the bounds, and the expansion will make an explicit -- declaration for it (see Analyze_Iteration_Scheme, sem_ch5.adb), - -- so do not apply any transformations here. + -- so do not apply any transformations here. Same for an Ada 2012 + -- iterator specification, where a block is created for the expression + -- that build the container. - elsif Nkind (Wrap_Node) = N_Iteration_Scheme then + elsif Nkind (Wrap_Node) = N_Iteration_Scheme + or else Nkind (Wrap_Node) = N_Iterator_Specification + then null; -- In formal verification mode, if the node to wrap is a pragma check, diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 7e54753..1919f9a 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -2352,9 +2352,14 @@ begin if Variable /= Nil_Variable_Value and then Length_Of_Name (Variable.Value) /= 0 then - Add_To_Carg_Switches - (new String' - ("-gnatec=" & Get_Name_String (Variable.Value))); + declare + Path : constant String := + Absolute_Path + (Path_Name_Type (Variable.Value), Project); + begin + Add_To_Carg_Switches + (new String'("-gnatec=" & Path)); + end; end if; end; @@ -2392,10 +2397,14 @@ begin if Variable /= Nil_Variable_Value and then Length_Of_Name (Variable.Value) /= 0 then - Add_To_Carg_Switches - (new String' - ("-gnatec=" & - Get_Name_String (Variable.Value))); + declare + Path : constant String := + Absolute_Path + (Path_Name_Type (Variable.Value), Project); + begin + Add_To_Carg_Switches + (new String'("-gnatec=" & Path)); + end; end if; end; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 69a996d..2867425 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -3790,44 +3790,6 @@ package body Make is Result : Argument_List (1 .. 3); Last : Natural := 0; - function Absolute_Path - (Path : Path_Name_Type; - Project : Project_Id) return String; - -- Returns an absolute path for a configuration pragmas file - - ------------------- - -- Absolute_Path -- - ------------------- - - function Absolute_Path - (Path : Path_Name_Type; - Project : Project_Id) return String - is - begin - Get_Name_String (Path); - - declare - Path_Name : constant String := Name_Buffer (1 .. Name_Len); - - begin - if Is_Absolute_Path (Path_Name) then - return Path_Name; - - else - declare - Parent_Directory : constant String := - Get_Name_String - (Project.Directory.Display_Name); - - begin - return Parent_Directory & Path_Name; - end; - end if; - end; - end Absolute_Path; - - -- Start of processing for Configuration_Pragmas_Switch - begin Prj.Env.Create_Config_Pragmas_File (For_Project, Project_Tree); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index cdbe1aa..a2ea435 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -139,6 +139,37 @@ package body Makeutl is end if; end Add_Linker_Option; + ------------------- + -- Absolute_Path -- + ------------------- + + function Absolute_Path + (Path : Path_Name_Type; + Project : Project_Id) return String + is + begin + Get_Name_String (Path); + + declare + Path_Name : constant String := Name_Buffer (1 .. Name_Len); + + begin + if Is_Absolute_Path (Path_Name) then + return Path_Name; + + else + declare + Parent_Directory : constant String := + Get_Name_String + (Project.Directory.Display_Name); + + begin + return Parent_Directory & Path_Name; + end; + end if; + end; + end Absolute_Path; + ------------------------- -- Base_Name_Index_For -- ------------------------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 1b899c1..7848ed0 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -87,6 +87,11 @@ package Makeutl is Last : in out Natural); -- Add a string to a list of strings + function Absolute_Path + (Path : Path_Name_Type; + Project : Project_Id) return String; + -- Returns an absolute path for a configuration pragmas file + function Create_Binder_Mapping_File (Project_Tree : Project_Tree_Ref) return Path_Name_Type; -- Create a binder mapping file and returns its path name diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index d70480e..7ea2dc9 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -216,6 +216,7 @@ package body Prj.Part is procedure Post_Parse_Context_Clause (Context_Clause : With_Id; In_Tree : Project_Node_Tree_Ref; + In_Limited : Boolean; Limited_Withs : Boolean; Imported_Projects : in out Project_Node_Id; Project_Directory : Path_Name_Type; @@ -827,6 +828,7 @@ package body Prj.Part is procedure Post_Parse_Context_Clause (Context_Clause : With_Id; In_Tree : Project_Node_Tree_Ref; + In_Limited : Boolean; Limited_Withs : Boolean; Imported_Projects : in out Project_Node_Id; Project_Directory : Path_Name_Type; @@ -941,7 +943,9 @@ package body Prj.Part is -- If we have one, get the project id of the limited -- imported project file, and do not parse it. - if Limited_Withs and then Project_Stack.Last > 1 then + if (In_Limited or else Limited_Withs) and then + Project_Stack.Last > 1 + then declare Canonical_Path_Name : Path_Name_Type; @@ -975,7 +979,7 @@ package body Prj.Part is Path_Name_Id => Imported_Path_Name_Id, Extended => False, From_Extended => From_Extended, - In_Limited => Limited_Withs, + In_Limited => In_Limited or else Limited_Withs, Packages_To_Check => Packages_To_Check, Depth => Depth, Current_Dir => Current_Dir, @@ -1577,6 +1581,7 @@ package body Prj.Part is Post_Parse_Context_Clause (In_Tree => In_Tree, Context_Clause => First_With, + In_Limited => In_Limited, Limited_Withs => False, Imported_Projects => Imported_Projects, Project_Directory => Project_Directory, @@ -1936,6 +1941,7 @@ package body Prj.Part is Post_Parse_Context_Clause (In_Tree => In_Tree, Context_Clause => First_With, + In_Limited => In_Limited, Limited_Withs => True, Imported_Projects => Imported_Projects, Project_Directory => Project_Directory, diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f2cb86c..5b1585a 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4053,6 +4053,7 @@ package body Sem_Attr is P_Type := Base_Type (P_Type); Set_Etype (N, P_Type); Set_Etype (P, P_Type); + Analyze_Dimension (N); Expand (N); end if; end Old; diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index ca7f3b2..163c93b 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -1925,12 +1925,18 @@ package body Sem_Dim is Set_Dimensions (N, Dims_Of_Etyp); -- Identifier case. Propagate the dimensions from the entity for - -- identifier whose entity is a non-dimensionless consant. + -- identifier whose entity is a non-dimensionless constant. - elsif Nkind (N) = N_Identifier - and then Exists (Dimensions_Of (Entity (N))) - then - Set_Dimensions (N, Dimensions_Of (Entity (N))); + elsif Nkind (N) = N_Identifier then + Analyze_Dimension_Identifier : declare + Id : constant Entity_Id := Entity (N); + begin + if Ekind (Id) = E_Constant + and then Exists (Dimensions_Of (Id)) + then + Set_Dimensions (N, Dimensions_Of (Id)); + end if; + end Analyze_Dimension_Identifier; -- Attribute reference case. Propagate the dimensions from the prefix. -- cgit v1.1