Commit 65fe0167 by Arnaud Charlet

[multiple changes]

2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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.

From-SVN: r223068
parent 45ce0f05
2015-05-12 Hristian Kirtchev <kirtchev@adacore.com> 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. Node37 is now used as Associated_Entity.
(Associated_Entity): New routine. (Associated_Entity): New routine.
(Encapsulating_State): Update the assertion guard (Encapsulating_State): Update the assertion guard to include constants.
to include constants.
(Set_Associated_Entity): New routine. (Set_Associated_Entity): New routine.
(Set_Encapsulating_State): Update the assertion guard to (Set_Encapsulating_State): Update the assertion guard to
include constants. include constants.
......
------------------------------------------------------------------------------
-- --
-- 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;
...@@ -1520,10 +1520,10 @@ package Einfo is ...@@ -1520,10 +1520,10 @@ package Einfo is
-- value is set, but it may be overridden by an aspect declaration on -- value is set, but it may be overridden by an aspect declaration on
-- type type derivation. -- type type derivation.
-- Has_Default_Init_Cond (Flag3) -- Has_Default_Init_Cond (Flag3) [base type only]
-- Defined in type and subtype entities. Set if pragma Default_Initial_ -- Defined in all type entities. Set if pragma Default_Initial_Condition
-- Condition applies to the type or subtype. This flag must be mutually -- applies to a private type and by extension to its full view. This flag
-- exclusive with Has_Inherited_Default_Init_Cond. -- is mutually exclusive with flag Has_Inherited_Default_Init_Cond.
-- Has_Delayed_Aspects (Flag200) -- Has_Delayed_Aspects (Flag200)
-- Defined in all entities. Set if the Rep_Item chain for the entity has -- Defined in all entities. Set if the Rep_Item chain for the entity has
...@@ -1538,7 +1538,7 @@ package Einfo is ...@@ -1538,7 +1538,7 @@ package Einfo is
-- separate section ("Delayed Freezing and Elaboration") for details. -- separate section ("Delayed Freezing and Elaboration") for details.
-- Has_Delayed_Rep_Aspects (Flag261) -- 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 -- least one aspect for a representation characteristic that has to be
-- delayed and is one of the characteristics that may be inherited by -- 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, -- types derived from this type if not overridden. If this flag is set,
...@@ -1661,10 +1661,10 @@ package Einfo is ...@@ -1661,10 +1661,10 @@ package Einfo is
-- type which has inheritable invariants, and in this case the flag will -- type which has inheritable invariants, and in this case the flag will
-- also be set in the private type. -- also be set in the private type.
-- Has_Inherited_Default_Init_Cond (Flag133) -- Has_Inherited_Default_Init_Cond (Flag133) [base type only]
-- Defined in type and subtype entities. Set if a derived type inherits -- Defined in all type entities. Set when a derived type inherits pragma
-- pragma Default_Initial_Condition from its parent type. This flag must -- Default_Initial_Condition from its parent type. This flag is mutually
-- be mutually exclusive with Has_Default_Init_Cond. -- exclusive with flag Has_Default_Init_Cond.
-- Has_Initial_Value (Flag219) -- Has_Initial_Value (Flag219)
-- Defined in entities for variables and out parameters. Set if there -- Defined in entities for variables and out parameters. Set if there
...@@ -5386,13 +5386,13 @@ package Einfo is ...@@ -5386,13 +5386,13 @@ package Einfo is
-- Has_Constrained_Partial_View (Flag187) -- Has_Constrained_Partial_View (Flag187)
-- Has_Controlled_Component (Flag43) (base type only) -- Has_Controlled_Component (Flag43) (base type only)
-- Has_Default_Aspect (Flag39) (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_Delayed_Rep_Aspects (Flag261)
-- Has_Discriminants (Flag5) -- Has_Discriminants (Flag5)
-- Has_Dynamic_Predicate_Aspect (Flag258) -- Has_Dynamic_Predicate_Aspect (Flag258)
-- Has_Independent_Components (Flag34) (base type only) -- Has_Independent_Components (Flag34) (base type only)
-- Has_Inheritable_Invariants (Flag248) -- Has_Inheritable_Invariants (Flag248)
-- Has_Inherited_Default_Init_Cond (Flag133) -- Has_Inherited_Default_Init_Cond (Flag133) (base type only)
-- Has_Invariants (Flag232) -- Has_Invariants (Flag232)
-- Has_Non_Standard_Rep (Flag75) (base type only) -- Has_Non_Standard_Rep (Flag75) (base type only)
-- Has_Object_Size_Clause (Flag172) -- Has_Object_Size_Clause (Flag172)
......
...@@ -3668,6 +3668,7 @@ package body Exp_Ch5 is ...@@ -3668,6 +3668,7 @@ package body Exp_Ch5 is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Stats : constant List_Id := Statements (N); Stats : constant List_Id := Statements (N);
Core_Loop : Node_Id; Core_Loop : Node_Id;
Dim1 : Int;
Ind_Comp : Node_Id; Ind_Comp : Node_Id;
Iterator : Entity_Id; Iterator : Entity_Id;
...@@ -3684,6 +3685,8 @@ package body Exp_Ch5 is ...@@ -3684,6 +3685,8 @@ package body Exp_Ch5 is
-- Generate: -- Generate:
-- Element : Component_Type renames Array (Iterator); -- 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 := Ind_Comp :=
Make_Indexed_Component (Loc, Make_Indexed_Component (Loc,
...@@ -3720,6 +3723,16 @@ package body Exp_Ch5 is ...@@ -3720,6 +3723,16 @@ package body Exp_Ch5 is
-- <original loop statements> -- <original loop statements>
-- end loop; -- 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 := Core_Loop :=
Make_Loop_Statement (Loc, Make_Loop_Statement (Loc,
Iteration_Scheme => Iteration_Scheme =>
...@@ -3732,15 +3745,23 @@ package body Exp_Ch5 is ...@@ -3732,15 +3745,23 @@ package body Exp_Ch5 is
Prefix => Relocate_Node (Array_Node), Prefix => Relocate_Node (Array_Node),
Attribute_Name => Name_Range, Attribute_Name => Name_Range,
Expressions => New_List ( Expressions => New_List (
Make_Integer_Literal (Loc, Array_Dim))), Make_Integer_Literal (Loc, Dim1))),
Reverse_Present => Reverse_Present (I_Spec))), Reverse_Present => Reverse_Present (I_Spec))),
Statements => Stats, Statements => Stats,
End_Label => Empty); 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 if Array_Dim > 1 then
for Dim in 1 .. Array_Dim - 1 loop 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'); Iterator := Make_Temporary (Loc, 'C');
-- Generate the dimension loops starting from the innermost one -- Generate the dimension loops starting from the innermost one
...@@ -3761,16 +3782,23 @@ package body Exp_Ch5 is ...@@ -3761,16 +3782,23 @@ package body Exp_Ch5 is
Prefix => Relocate_Node (Array_Node), Prefix => Relocate_Node (Array_Node),
Attribute_Name => Name_Range, Attribute_Name => Name_Range,
Expressions => New_List ( Expressions => New_List (
Make_Integer_Literal (Loc, Array_Dim - Dim))), Make_Integer_Literal (Loc, Dim1))),
Reverse_Present => Reverse_Present (I_Spec))), Reverse_Present => Reverse_Present (I_Spec))),
Statements => New_List (Core_Loop), Statements => New_List (Core_Loop),
End_Label => Empty); End_Label => Empty);
-- Update the previously created object renaming declaration with -- 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), if Convention (Array_Typ) = Convention_Fortran then
New_Occurrence_Of (Iterator, Loc)); 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 loop;
end if; end if;
......
...@@ -514,6 +514,7 @@ package body Impunit is ...@@ -514,6 +514,7 @@ package body Impunit is
-- harmless (and useful) to make then available in Ada 2005 mode. -- harmless (and useful) to make then available in Ada 2005 mode.
("a-cogeso", T), -- Ada.Containers.Generic_Sort ("a-cogeso", T), -- Ada.Containers.Generic_Sort
("a-dhfina", T), -- Ada.Directories.Hierarchical_File_Names
("a-secain", T), -- Ada.Strings.Equal_Case_Insensitive ("a-secain", T), -- Ada.Strings.Equal_Case_Insensitive
("a-shcain", T), -- Ada.Strings.Hash_Case_Insensitive ("a-shcain", T), -- Ada.Strings.Hash_Case_Insensitive
("a-slcain", T), -- Ada.Strings.Less_Case_Insensitive ("a-slcain", T), -- Ada.Strings.Less_Case_Insensitive
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment