Commit 9d9f5f49 by Arnaud Charlet

[multiple changes]

2010-10-05  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch5.adb (Make_Field_Expr): Revert previous change (removed).

2010-10-05  Emmanuel Briot  <briot@adacore.com>

	* prj-dect.adb, prj-nmsc.adb, prj-attr.adb, snames.ads-tmpl
	(Aggregate projects): added support for parsing aggregate projects.
	In particular, check the presence and value of the new attributes
	related to aggregate projects, ie Project_Files, Project_Path
	and External.
	(Check_Attribute_Allowed, Check_Package_Allowed,
	Rename_Obsolescent_Attributes): new subprogram, extracting code
	from existing subprogram to keep their sizes smaller.
	(Check_Aggregate_Project, Check_Abstract_Project,
	Check_Missing_Sources): new subprograms
	(Check): remove comments that duplicated either the name of the
	following subprogram call, or the comment on that subprogram.
	* prj-part.adb (Check_Extending_All_Imports): New subprogram, extracted
	from Parse_Single_Project.
	(Check_Aggregate_Imports): new subprogram.

From-SVN: r164968
parent 98ee5fc4
2010-10-05 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch5.adb (Make_Field_Expr): Revert previous change (removed).
2010-10-05 Emmanuel Briot <briot@adacore.com>
* prj-dect.adb, prj-nmsc.adb, prj-attr.adb, snames.ads-tmpl
(Aggregate projects): added support for parsing aggregate projects.
In particular, check the presence and value of the new attributes
related to aggregate projects, ie Project_Files, Project_Path
and External.
(Check_Attribute_Allowed, Check_Package_Allowed,
Rename_Obsolescent_Attributes): new subprogram, extracting code
from existing subprogram to keep their sizes smaller.
(Check_Aggregate_Project, Check_Abstract_Project,
Check_Missing_Sources): new subprograms
(Check): remove comments that duplicated either the name of the
following subprogram call, or the comment on that subprogram.
* prj-part.adb (Check_Extending_All_Imports): New subprogram, extracted
from Parse_Single_Project.
(Check_Aggregate_Imports): new subprogram.
2010-10-05 Vincent Celier <celier@adacore.com> 2010-10-05 Vincent Celier <celier@adacore.com>
* make.adb (Check): When compiling with -gnatc, recompile if the ALI * make.adb (Check): When compiling with -gnatc, recompile if the ALI
......
...@@ -1223,13 +1223,6 @@ package body Exp_Ch5 is ...@@ -1223,13 +1223,6 @@ package body Exp_Ch5 is
-- declaration for Typ. We need to use the actual entity because the -- declaration for Typ. We need to use the actual entity because the
-- type may be private and resolution by identifier alone would fail. -- type may be private and resolution by identifier alone would fail.
function Make_Field_Expr
(Comp_Ent : Entity_Id;
U_U : Boolean) return Node_Id;
-- Common processing for one component for Make_Component_List_Assign
-- and Make_Field_Assign. Return the expression to be assigned for
-- component Comp_Ent.
function Make_Component_List_Assign function Make_Component_List_Assign
(CL : Node_Id; (CL : Node_Id;
U_U : Boolean := False) return List_Id; U_U : Boolean := False) return List_Id;
...@@ -1289,6 +1282,7 @@ package body Exp_Ch5 is ...@@ -1289,6 +1282,7 @@ package body Exp_Ch5 is
Alts : List_Id; Alts : List_Id;
DC : Node_Id; DC : Node_Id;
DCH : List_Id; DCH : List_Id;
Expr : Node_Id;
Result : List_Id; Result : List_Id;
V : Node_Id; V : Node_Id;
...@@ -1314,9 +1308,28 @@ package body Exp_Ch5 is ...@@ -1314,9 +1308,28 @@ package body Exp_Ch5 is
Next_Non_Pragma (V); Next_Non_Pragma (V);
end loop; end loop;
-- If we have an Unchecked_Union, use the value of the inferred
-- discriminant of the variant part expression as the switch
-- for the case statement. The case statement may later be
-- folded.
if U_U then
Expr :=
New_Copy (Get_Discriminant_Value (
Entity (Name (VP)),
Etype (Rhs),
Discriminant_Constraint (Etype (Rhs))));
else
Expr :=
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Rhs),
Selector_Name =>
Make_Identifier (Loc, Chars (Name (VP))));
end if;
Append_To (Result, Append_To (Result,
Make_Case_Statement (Loc, Make_Case_Statement (Loc,
Expression => Make_Field_Expr (Entity (Name (VP)), U_U), Expression => Expr,
Alternatives => Alts)); Alternatives => Alts));
end if; end if;
...@@ -1332,19 +1345,32 @@ package body Exp_Ch5 is ...@@ -1332,19 +1345,32 @@ package body Exp_Ch5 is
U_U : Boolean := False) return Node_Id U_U : Boolean := False) return Node_Id
is is
A : Node_Id; A : Node_Id;
Expr : Node_Id;
begin begin
-- In the case of an Unchecked_Union, use the discriminant -- In the case of an Unchecked_Union, use the discriminant
-- constraint value as on the right hand side of the assignment. -- constraint value as on the right hand side of the assignment.
if U_U then
Expr :=
New_Copy (Get_Discriminant_Value (C,
Etype (Rhs),
Discriminant_Constraint (Etype (Rhs))));
else
Expr :=
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Rhs),
Selector_Name => New_Occurrence_Of (C, Loc));
end if;
A := A :=
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Name =>
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Lhs), Prefix => Duplicate_Subexpr (Lhs),
Selector_Name => Selector_Name =>
New_Occurrence_Of (Find_Component (L_Typ, C), Loc)), New_Occurrence_Of (Find_Component (L_Typ, C), Loc)),
Expression => Make_Field_Expr (C, U_U)); Expression => Expr);
-- Set Assignment_OK, so discriminants can be assigned -- Set Assignment_OK, so discriminants can be assigned
...@@ -1369,8 +1395,9 @@ package body Exp_Ch5 is ...@@ -1369,8 +1395,9 @@ package body Exp_Ch5 is
Result : List_Id; Result : List_Id;
begin begin
Result := New_List;
Item := First (CI); Item := First (CI);
Result := New_List;
while Present (Item) loop while Present (Item) loop
-- Look for components, but exclude _tag field assignment if -- Look for components, but exclude _tag field assignment if
...@@ -1390,32 +1417,6 @@ package body Exp_Ch5 is ...@@ -1390,32 +1417,6 @@ package body Exp_Ch5 is
return Result; return Result;
end Make_Field_Assigns; end Make_Field_Assigns;
---------------------
-- Make_Field_Expr --
---------------------
function Make_Field_Expr
(Comp_Ent : Entity_Id;
U_U : Boolean) return Node_Id
is
begin
-- If we have an Unchecked_Union, use the value of the inferred
-- discriminant of the variant part expression.
if U_U then
return
New_Copy (Get_Discriminant_Value
(Comp_Ent,
Etype (Rhs),
Discriminant_Constraint (Etype (Rhs))));
else
return
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Rhs),
Selector_Name => New_Occurrence_Of (Comp_Ent, Loc));
end if;
end Make_Field_Expr;
-- Start of processing for Expand_Assign_Record -- Start of processing for Expand_Assign_Record
begin begin
......
...@@ -91,6 +91,12 @@ package body Prj.Attr is ...@@ -91,6 +91,12 @@ package body Prj.Attr is
"SVexcluded_source_list_file#" & "SVexcluded_source_list_file#" &
"LVinterfaces#" & "LVinterfaces#" &
-- Projects (in aggregate projects)
"LVproject_files#" &
"LVproject_path#" &
"SAexternal#" &
-- Libraries -- Libraries
"SVlibrary_dir#" & "SVlibrary_dir#" &
...@@ -147,18 +153,20 @@ package body Prj.Attr is ...@@ -147,18 +153,20 @@ package body Prj.Attr is
"Saruntime_source_dir#" & "Saruntime_source_dir#" &
-- package Naming -- package Naming
-- Some attributes are obsolescent, and renamed in the tree (see
-- Prj.Dect.Rename_Obsolescent_Attributes).
"Pnaming#" & "Pnaming#" &
"Saspecification_suffix#" & "Saspecification_suffix#" & -- Always renamed to "spec_suffix" in tree
"Saspec_suffix#" & "Saspec_suffix#" &
"Saimplementation_suffix#" & "Saimplementation_suffix#" & -- Always renamed to "body_suffix" in tree
"Sabody_suffix#" & "Sabody_suffix#" &
"SVseparate_suffix#" & "SVseparate_suffix#" &
"SVcasing#" & "SVcasing#" &
"SVdot_replacement#" & "SVdot_replacement#" &
"sAspecification#" & "sAspecification#" & -- Always renamed to "spec" in project tree
"sAspec#" & "sAspec#" &
"sAimplementation#" & "sAimplementation#" & -- Always renamed to "body" in project tree
"sAbody#" & "sAbody#" &
"Laspecification_exceptions#" & "Laspecification_exceptions#" &
"Laimplementation_exceptions#" & "Laimplementation_exceptions#" &
......
...@@ -1133,6 +1133,8 @@ package Snames is ...@@ -1133,6 +1133,8 @@ package Snames is
Name_Prefix : constant Name_Id := N + $; Name_Prefix : constant Name_Id := N + $;
Name_Project : constant Name_Id := N + $; Name_Project : constant Name_Id := N + $;
Name_Project_Dir : constant Name_Id := N + $; Name_Project_Dir : constant Name_Id := N + $;
Name_Project_Files : constant Name_Id := N + $;
Name_Project_Path : constant Name_Id := N + $;
Name_Response_File_Format : constant Name_Id := N + $; Name_Response_File_Format : constant Name_Id := N + $;
Name_Response_File_Switches : constant Name_Id := N + $; Name_Response_File_Switches : constant Name_Id := N + $;
Name_Roots : constant Name_Id := N + $; -- GPR Name_Roots : constant Name_Id := N + $; -- GPR
......
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