Commit 07ef182e by Arnaud Charlet

[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
parent 2a7b8e18
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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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.
......
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