From 6475ce8aa9f4e76f896fcba5d7ab6eb8d0a3041d Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 12 May 2015 13:44:19 +0000 Subject: [PATCH] 2015-05-12 Hristian Kirtchev * einfo.ads: Update the documentation of flags Has_Inherited_Default_Init_Cond and Has_Default_Init_Cond. 2015-05-12 Robert Dewar * impunit.adb: Add entry for a-dhfina.ads * a-dhfina.ads: New file. 2015-05-12 Ed Schonberg * exp_ch5.adb (Expand_Iterator_Loop_Over_Array): if the array type has convention Fortran, a multidimensional iterator varies the first dimension fastest. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223068 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 21 ++++++++++++++++++--- gcc/ada/a-dhfina.ads | 46 ++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/einfo.ads | 22 +++++++++++----------- gcc/ada/exp_ch5.adb | 40 ++++++++++++++++++++++++++++++++++------ gcc/ada/impunit.adb | 1 + 5 files changed, 110 insertions(+), 20 deletions(-) create mode 100644 gcc/ada/a-dhfina.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e1a377fe3ae..a9666ffddd4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,10 +1,25 @@ 2015-05-12 Hristian Kirtchev - * einfo.adb Node32 is now used as Encapsulating_State. + * einfo.ads: Update the documentation of flags + Has_Inherited_Default_Init_Cond and Has_Default_Init_Cond. + +2015-05-12 Robert Dewar + + * impunit.adb: Add entry for a-dhfina.ads + * a-dhfina.ads: New file. + +2015-05-12 Ed Schonberg + + * exp_ch5.adb (Expand_Iterator_Loop_Over_Array): if the array + type has convention Fortran, a multidimensional iterator varies + the first dimension fastest. + +2015-05-12 Hristian Kirtchev + + * einfo.adb: Node32 is now used as Encapsulating_State. Node37 is now used as Associated_Entity. (Associated_Entity): New routine. - (Encapsulating_State): Update the assertion guard - to include constants. + (Encapsulating_State): Update the assertion guard to include constants. (Set_Associated_Entity): New routine. (Set_Encapsulating_State): Update the assertion guard to include constants. diff --git a/gcc/ada/a-dhfina.ads b/gcc/ada/a-dhfina.ads new file mode 100644 index 00000000000..e34c664d451 --- /dev/null +++ b/gcc/ada/a-dhfina.ads @@ -0,0 +1,46 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- ADA.DIRECTORIES.HIERARCHICAL_FILE_NAMES -- +-- -- +-- S p e c -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +package Ada.Directories.Hierarchical_File_Names is + pragma Unimplemented_Unit; + + function Is_Simple_Name (Name : String) return Boolean; + + function Is_Root_Directory_Name (Name : String) return Boolean; + + function Is_Parent_Directory_Name (Name : String) return Boolean; + + function Is_Current_Directory_Name (Name : String) return Boolean; + + function Is_Full_Name (Name : String) return Boolean; + + function Is_Relative_Name (Name : String) return Boolean; + + function Simple_Name (Name : String) return String + renames Ada.Directories.Simple_Name; + + function Containing_Directory (Name : String) return String + renames Ada.Directories.Containing_Directory; + + function Initial_Directory (Name : String) return String; + + function Relative_Name (Name : String) return String; + + function Compose + (Directory : String := ""; + Relative_Name : String; + Extension : String := "") return String; + +end Ada.Directories.Hierarchical_File_Names; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index b9b5c42d846..7a068f2e2a0 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1520,10 +1520,10 @@ package Einfo is -- value is set, but it may be overridden by an aspect declaration on -- type type derivation. --- Has_Default_Init_Cond (Flag3) --- Defined in type and subtype entities. Set if pragma Default_Initial_ --- Condition applies to the type or subtype. This flag must be mutually --- exclusive with Has_Inherited_Default_Init_Cond. +-- Has_Default_Init_Cond (Flag3) [base type only] +-- Defined in all type entities. Set if pragma Default_Initial_Condition +-- applies to a private type and by extension to its full view. This flag +-- is mutually exclusive with flag Has_Inherited_Default_Init_Cond. -- Has_Delayed_Aspects (Flag200) -- Defined in all entities. Set if the Rep_Item chain for the entity has @@ -1538,7 +1538,7 @@ package Einfo is -- separate section ("Delayed Freezing and Elaboration") for details. -- Has_Delayed_Rep_Aspects (Flag261) --- Defined in all type and subtypes. This flag is set if there is at +-- Defined in all types and subtypes. This flag is set if there is at -- least one aspect for a representation characteristic that has to be -- delayed and is one of the characteristics that may be inherited by -- types derived from this type if not overridden. If this flag is set, @@ -1661,10 +1661,10 @@ package Einfo is -- type which has inheritable invariants, and in this case the flag will -- also be set in the private type. --- Has_Inherited_Default_Init_Cond (Flag133) --- Defined in type and subtype entities. Set if a derived type inherits --- pragma Default_Initial_Condition from its parent type. This flag must --- be mutually exclusive with Has_Default_Init_Cond. +-- Has_Inherited_Default_Init_Cond (Flag133) [base type only] +-- Defined in all type entities. Set when a derived type inherits pragma +-- Default_Initial_Condition from its parent type. This flag is mutually +-- exclusive with flag Has_Default_Init_Cond. -- Has_Initial_Value (Flag219) -- Defined in entities for variables and out parameters. Set if there @@ -5386,13 +5386,13 @@ package Einfo is -- Has_Constrained_Partial_View (Flag187) -- Has_Controlled_Component (Flag43) (base type only) -- Has_Default_Aspect (Flag39) (base type only) - -- Has_Default_Init_Cond (Flag3) + -- Has_Default_Init_Cond (Flag3) (base type only) -- Has_Delayed_Rep_Aspects (Flag261) -- Has_Discriminants (Flag5) -- Has_Dynamic_Predicate_Aspect (Flag258) -- Has_Independent_Components (Flag34) (base type only) -- Has_Inheritable_Invariants (Flag248) - -- Has_Inherited_Default_Init_Cond (Flag133) + -- Has_Inherited_Default_Init_Cond (Flag133) (base type only) -- Has_Invariants (Flag232) -- Has_Non_Standard_Rep (Flag75) (base type only) -- Has_Object_Size_Clause (Flag172) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c45dcb98e81..d88016f8921 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3668,6 +3668,7 @@ package body Exp_Ch5 is Loc : constant Source_Ptr := Sloc (N); Stats : constant List_Id := Statements (N); Core_Loop : Node_Id; + Dim1 : Int; Ind_Comp : Node_Id; Iterator : Entity_Id; @@ -3684,6 +3685,8 @@ package body Exp_Ch5 is -- Generate: -- Element : Component_Type renames Array (Iterator); + -- Iterator is the index value, or a list of index values + -- in the case of a multidimensional array. Ind_Comp := Make_Indexed_Component (Loc, @@ -3720,6 +3723,16 @@ package body Exp_Ch5 is -- -- end loop; + -- If this is an iteration over a multidimensional array, the + -- innermost loop is over the last dimension in Ada, and over + -- the first dimension in Fortran. + + if Convention (Array_Typ) = Convention_Fortran then + Dim1 := 1; + else + Dim1 := Array_Dim; + end if; + Core_Loop := Make_Loop_Statement (Loc, Iteration_Scheme => @@ -3732,15 +3745,23 @@ package body Exp_Ch5 is Prefix => Relocate_Node (Array_Node), Attribute_Name => Name_Range, Expressions => New_List ( - Make_Integer_Literal (Loc, Array_Dim))), + Make_Integer_Literal (Loc, Dim1))), Reverse_Present => Reverse_Present (I_Spec))), Statements => Stats, End_Label => Empty); - -- Processing for multidimensional array + -- Processing for multidimensional array. The body of each loop is + -- a loop over a previous dimension, going in decreasing order in Ada + -- and in increasing order in Fortran. if Array_Dim > 1 then for Dim in 1 .. Array_Dim - 1 loop + if Convention (Array_Typ) = Convention_Fortran then + Dim1 := Dim + 1; + else + Dim1 := Array_Dim - Dim; + end if; + Iterator := Make_Temporary (Loc, 'C'); -- Generate the dimension loops starting from the innermost one @@ -3761,16 +3782,23 @@ package body Exp_Ch5 is Prefix => Relocate_Node (Array_Node), Attribute_Name => Name_Range, Expressions => New_List ( - Make_Integer_Literal (Loc, Array_Dim - Dim))), + Make_Integer_Literal (Loc, Dim1))), Reverse_Present => Reverse_Present (I_Spec))), Statements => New_List (Core_Loop), End_Label => Empty); -- Update the previously created object renaming declaration with - -- the new iterator. + -- the new iterator, by adding the index of the next loop to the + -- indexed component, in the order that corresponds to the + -- convention. - Prepend_To (Expressions (Ind_Comp), - New_Occurrence_Of (Iterator, Loc)); + if Convention (Array_Typ) = Convention_Fortran then + Append_To (Expressions (Ind_Comp), + New_Occurrence_Of (Iterator, Loc)); + else + Prepend_To (Expressions (Ind_Comp), + New_Occurrence_Of (Iterator, Loc)); + end if; end loop; end if; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index d59704f500a..bd32e818549 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -514,6 +514,7 @@ package body Impunit is -- harmless (and useful) to make then available in Ada 2005 mode. ("a-cogeso", T), -- Ada.Containers.Generic_Sort + ("a-dhfina", T), -- Ada.Directories.Hierarchical_File_Names ("a-secain", T), -- Ada.Strings.Equal_Case_Insensitive ("a-shcain", T), -- Ada.Strings.Hash_Case_Insensitive ("a-slcain", T), -- Ada.Strings.Less_Case_Insensitive -- 2.11.4.GIT