mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2012-10-02 Vincent Pucci <pucci@adacore.com> * 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 <schonberg@adacore.com> * 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 <celier@adacore.com> * 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 <celier@adacore.com> * 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
This commit is contained in:
parent
2a7b8e181b
commit
07ef182e37
|
|
@ -1,3 +1,35 @@
|
||||||
|
2012-10-02 Vincent Pucci <pucci@adacore.com>
|
||||||
|
|
||||||
|
* 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 <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* 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 <celier@adacore.com>
|
||||||
|
|
||||||
|
* 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 <celier@adacore.com>
|
||||||
|
|
||||||
|
* 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 <duff@adacore.com>
|
2012-10-02 Bob Duff <duff@adacore.com>
|
||||||
|
|
||||||
* checks.adb (Apply_Predicate_Check): Disable check in -gnatc mode.
|
* checks.adb (Apply_Predicate_Check): Disable check in -gnatc mode.
|
||||||
|
|
|
||||||
|
|
@ -3039,10 +3039,18 @@ package body Exp_Ch5 is
|
||||||
Cursor := Make_Temporary (Loc, 'I');
|
Cursor := Make_Temporary (Loc, 'I');
|
||||||
|
|
||||||
-- For an container element iterator, the iterator type
|
-- 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);
|
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
|
-- Rewrite domain of iteration as a call to the default
|
||||||
-- iterator for the container type. If the container is
|
-- iterator for the container type. If the container is
|
||||||
|
|
|
||||||
|
|
@ -3639,9 +3639,13 @@ package body Exp_Ch7 is
|
||||||
-- If the node to wrap is an iteration_scheme, the expression is
|
-- If the node to wrap is an iteration_scheme, the expression is
|
||||||
-- one of the bounds, and the expansion will make an explicit
|
-- one of the bounds, and the expansion will make an explicit
|
||||||
-- declaration for it (see Analyze_Iteration_Scheme, sem_ch5.adb),
|
-- 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;
|
null;
|
||||||
|
|
||||||
-- In formal verification mode, if the node to wrap is a pragma check,
|
-- In formal verification mode, if the node to wrap is a pragma check,
|
||||||
|
|
|
||||||
|
|
@ -2352,9 +2352,14 @@ begin
|
||||||
if Variable /= Nil_Variable_Value
|
if Variable /= Nil_Variable_Value
|
||||||
and then Length_Of_Name (Variable.Value) /= 0
|
and then Length_Of_Name (Variable.Value) /= 0
|
||||||
then
|
then
|
||||||
Add_To_Carg_Switches
|
declare
|
||||||
(new String'
|
Path : constant String :=
|
||||||
("-gnatec=" & Get_Name_String (Variable.Value)));
|
Absolute_Path
|
||||||
|
(Path_Name_Type (Variable.Value), Project);
|
||||||
|
begin
|
||||||
|
Add_To_Carg_Switches
|
||||||
|
(new String'("-gnatec=" & Path));
|
||||||
|
end;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
@ -2392,10 +2397,14 @@ begin
|
||||||
if Variable /= Nil_Variable_Value
|
if Variable /= Nil_Variable_Value
|
||||||
and then Length_Of_Name (Variable.Value) /= 0
|
and then Length_Of_Name (Variable.Value) /= 0
|
||||||
then
|
then
|
||||||
Add_To_Carg_Switches
|
declare
|
||||||
(new String'
|
Path : constant String :=
|
||||||
("-gnatec=" &
|
Absolute_Path
|
||||||
Get_Name_String (Variable.Value)));
|
(Path_Name_Type (Variable.Value), Project);
|
||||||
|
begin
|
||||||
|
Add_To_Carg_Switches
|
||||||
|
(new String'("-gnatec=" & Path));
|
||||||
|
end;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
||||||
|
|
@ -3790,44 +3790,6 @@ package body Make is
|
||||||
Result : Argument_List (1 .. 3);
|
Result : Argument_List (1 .. 3);
|
||||||
Last : Natural := 0;
|
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
|
begin
|
||||||
Prj.Env.Create_Config_Pragmas_File
|
Prj.Env.Create_Config_Pragmas_File
|
||||||
(For_Project, Project_Tree);
|
(For_Project, Project_Tree);
|
||||||
|
|
|
||||||
|
|
@ -139,6 +139,37 @@ package body Makeutl is
|
||||||
end if;
|
end if;
|
||||||
end Add_Linker_Option;
|
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 --
|
-- Base_Name_Index_For --
|
||||||
-------------------------
|
-------------------------
|
||||||
|
|
|
||||||
|
|
@ -87,6 +87,11 @@ package Makeutl is
|
||||||
Last : in out Natural);
|
Last : in out Natural);
|
||||||
-- Add a string to a list of strings
|
-- 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
|
function Create_Binder_Mapping_File
|
||||||
(Project_Tree : Project_Tree_Ref) return Path_Name_Type;
|
(Project_Tree : Project_Tree_Ref) return Path_Name_Type;
|
||||||
-- Create a binder mapping file and returns its path name
|
-- Create a binder mapping file and returns its path name
|
||||||
|
|
|
||||||
|
|
@ -216,6 +216,7 @@ package body Prj.Part is
|
||||||
procedure Post_Parse_Context_Clause
|
procedure Post_Parse_Context_Clause
|
||||||
(Context_Clause : With_Id;
|
(Context_Clause : With_Id;
|
||||||
In_Tree : Project_Node_Tree_Ref;
|
In_Tree : Project_Node_Tree_Ref;
|
||||||
|
In_Limited : Boolean;
|
||||||
Limited_Withs : Boolean;
|
Limited_Withs : Boolean;
|
||||||
Imported_Projects : in out Project_Node_Id;
|
Imported_Projects : in out Project_Node_Id;
|
||||||
Project_Directory : Path_Name_Type;
|
Project_Directory : Path_Name_Type;
|
||||||
|
|
@ -827,6 +828,7 @@ package body Prj.Part is
|
||||||
procedure Post_Parse_Context_Clause
|
procedure Post_Parse_Context_Clause
|
||||||
(Context_Clause : With_Id;
|
(Context_Clause : With_Id;
|
||||||
In_Tree : Project_Node_Tree_Ref;
|
In_Tree : Project_Node_Tree_Ref;
|
||||||
|
In_Limited : Boolean;
|
||||||
Limited_Withs : Boolean;
|
Limited_Withs : Boolean;
|
||||||
Imported_Projects : in out Project_Node_Id;
|
Imported_Projects : in out Project_Node_Id;
|
||||||
Project_Directory : Path_Name_Type;
|
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
|
-- If we have one, get the project id of the limited
|
||||||
-- imported project file, and do not parse it.
|
-- 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
|
declare
|
||||||
Canonical_Path_Name : Path_Name_Type;
|
Canonical_Path_Name : Path_Name_Type;
|
||||||
|
|
||||||
|
|
@ -975,7 +979,7 @@ package body Prj.Part is
|
||||||
Path_Name_Id => Imported_Path_Name_Id,
|
Path_Name_Id => Imported_Path_Name_Id,
|
||||||
Extended => False,
|
Extended => False,
|
||||||
From_Extended => From_Extended,
|
From_Extended => From_Extended,
|
||||||
In_Limited => Limited_Withs,
|
In_Limited => In_Limited or else Limited_Withs,
|
||||||
Packages_To_Check => Packages_To_Check,
|
Packages_To_Check => Packages_To_Check,
|
||||||
Depth => Depth,
|
Depth => Depth,
|
||||||
Current_Dir => Current_Dir,
|
Current_Dir => Current_Dir,
|
||||||
|
|
@ -1577,6 +1581,7 @@ package body Prj.Part is
|
||||||
Post_Parse_Context_Clause
|
Post_Parse_Context_Clause
|
||||||
(In_Tree => In_Tree,
|
(In_Tree => In_Tree,
|
||||||
Context_Clause => First_With,
|
Context_Clause => First_With,
|
||||||
|
In_Limited => In_Limited,
|
||||||
Limited_Withs => False,
|
Limited_Withs => False,
|
||||||
Imported_Projects => Imported_Projects,
|
Imported_Projects => Imported_Projects,
|
||||||
Project_Directory => Project_Directory,
|
Project_Directory => Project_Directory,
|
||||||
|
|
@ -1936,6 +1941,7 @@ package body Prj.Part is
|
||||||
Post_Parse_Context_Clause
|
Post_Parse_Context_Clause
|
||||||
(In_Tree => In_Tree,
|
(In_Tree => In_Tree,
|
||||||
Context_Clause => First_With,
|
Context_Clause => First_With,
|
||||||
|
In_Limited => In_Limited,
|
||||||
Limited_Withs => True,
|
Limited_Withs => True,
|
||||||
Imported_Projects => Imported_Projects,
|
Imported_Projects => Imported_Projects,
|
||||||
Project_Directory => Project_Directory,
|
Project_Directory => Project_Directory,
|
||||||
|
|
|
||||||
|
|
@ -4053,6 +4053,7 @@ package body Sem_Attr is
|
||||||
P_Type := Base_Type (P_Type);
|
P_Type := Base_Type (P_Type);
|
||||||
Set_Etype (N, P_Type);
|
Set_Etype (N, P_Type);
|
||||||
Set_Etype (P, P_Type);
|
Set_Etype (P, P_Type);
|
||||||
|
Analyze_Dimension (N);
|
||||||
Expand (N);
|
Expand (N);
|
||||||
end if;
|
end if;
|
||||||
end Old;
|
end Old;
|
||||||
|
|
|
||||||
|
|
@ -1925,12 +1925,18 @@ package body Sem_Dim is
|
||||||
Set_Dimensions (N, Dims_Of_Etyp);
|
Set_Dimensions (N, Dims_Of_Etyp);
|
||||||
|
|
||||||
-- Identifier case. Propagate the dimensions from the entity for
|
-- 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
|
elsif Nkind (N) = N_Identifier then
|
||||||
and then Exists (Dimensions_Of (Entity (N)))
|
Analyze_Dimension_Identifier : declare
|
||||||
then
|
Id : constant Entity_Id := Entity (N);
|
||||||
Set_Dimensions (N, Dimensions_Of (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.
|
-- Attribute reference case. Propagate the dimensions from the prefix.
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue