procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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
This commit is contained in:
Arnaud Charlet 2015-05-12 15:44:19 +02:00
parent 45ce0f05e0
commit 65fe0167eb
5 changed files with 110 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
gcc/ada/ChangeLog
View file

@ -1,10 +1,25 @@
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.

46
gcc/ada/a-dhfina.ads Normal file
View file

@ -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;

22
gcc/ada/einfo.ads
View file

@ -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)

40
gcc/ada/exp_ch5.adb
View file

@ -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
-- <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 =>
@ -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;

1
gcc/ada/impunit.adb
View file

@ -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