2015-05-12 Hristian Kirtchev <kirtchev@adacore.com>
- * 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 <dewar@adacore.com>
+
+ * impunit.adb: Add entry for a-dhfina.ads
+ * a-dhfina.ads: New file.
+
+2015-05-12 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
+
+ * 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.
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- 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
-- 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,
-- 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
-- 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)
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;
-- 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,
-- <original loop statements>
-- 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 =>
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
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;
-- 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
projects / gcc.git / commitdiff