Commit 3ddd922e by Arnaud Charlet

[multiple changes]

2011-08-29  Yannick Moy  <moy@adacore.com>

	* exp_ch13.adb: Adjust previous change.

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, prj.adb, sem_util.adb, sem_res.adb, gnat1drv.adb,
	exp_ch4.adb, sem_ch8.adb: Minor code reorganization
	Minor reformatting.

From-SVN: r178226
parent 444acbdd
2011-08-29 Yannick Moy <moy@adacore.com>
* exp_ch13.adb: Adjust previous change.
2011-08-29 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, prj.adb, sem_util.adb, sem_res.adb, gnat1drv.adb,
exp_ch4.adb, sem_ch8.adb: Minor code reorganization
Minor reformatting.
2011-08-29 Emmanuel Briot <briot@adacore.com> 2011-08-29 Emmanuel Briot <briot@adacore.com>
* make.adb, prj.adb, prj.ads (Compute_All_Imported_Projects): Also * make.adb, prj.adb, prj.ads (Compute_All_Imported_Projects): Also
......
...@@ -307,13 +307,6 @@ package body Exp_Ch13 is ...@@ -307,13 +307,6 @@ package body Exp_Ch13 is
Delete : Boolean := False; Delete : Boolean := False;
begin begin
-- In formal verification mode, do not generate useless and confusing
-- expansion for freeze nodes.
if ALFA_Mode then
return;
end if;
-- If there are delayed aspect specifications, we insert them just -- If there are delayed aspect specifications, we insert them just
-- before the freeze node. They are already analyzed so we don't need -- before the freeze node. They are already analyzed so we don't need
-- to reanalyze them (they were analyzed before the type was frozen), -- to reanalyze them (they were analyzed before the type was frozen),
......
...@@ -7593,6 +7593,9 @@ package body Exp_Ch4 is ...@@ -7593,6 +7593,9 @@ package body Exp_Ch4 is
Test : Node_Id; Test : Node_Id;
begin begin
-- Do not expand quantified expressions in ALFA mode
-- why not???
if ALFA_Mode then if ALFA_Mode then
return; return;
end if; end if;
......
...@@ -351,7 +351,7 @@ procedure Gnat1drv is ...@@ -351,7 +351,7 @@ procedure Gnat1drv is
if Debug_Flag_Dot_XX then if Debug_Flag_Dot_XX then
Use_Expression_With_Actions := True; Use_Expression_With_Actions := True;
-- Debug flag -gnatd.Y decisively set usage off -- Debug flag -gnatd.Y decisively sets usage off
elsif Debug_Flag_Dot_YY then elsif Debug_Flag_Dot_YY then
Use_Expression_With_Actions := False; Use_Expression_With_Actions := False;
...@@ -445,6 +445,7 @@ procedure Gnat1drv is ...@@ -445,6 +445,7 @@ procedure Gnat1drv is
Debug_Flag_HH := True; Debug_Flag_HH := True;
-- Disable Expressions_With_Actions nodes -- Disable Expressions_With_Actions nodes
-- The gnat2why backend does not deal with Expressions_With_Actions -- The gnat2why backend does not deal with Expressions_With_Actions
-- in all places (in particular assertions). It is difficult to -- in all places (in particular assertions). It is difficult to
-- determine in the frontend which cases are allowed, so we disable -- determine in the frontend which cases are allowed, so we disable
......
...@@ -1288,7 +1288,8 @@ package body Prj is ...@@ -1288,7 +1288,8 @@ package body Prj is
Tree : Project_Tree_Ref) Tree : Project_Tree_Ref)
is is
procedure Analyze_Tree procedure Analyze_Tree
(Local_Root : Project_Id; Local_Tree : Project_Tree_Ref); (Local_Root : Project_Id;
Local_Tree : Project_Tree_Ref);
-- Process Project and all its aggregated project to analyze their own -- Process Project and all its aggregated project to analyze their own
-- imported projects. -- imported projects.
...@@ -1297,7 +1298,8 @@ package body Prj is ...@@ -1297,7 +1298,8 @@ package body Prj is
------------------ ------------------
procedure Analyze_Tree procedure Analyze_Tree
(Local_Root : Project_Id; Local_Tree : Project_Tree_Ref) (Local_Root : Project_Id;
Local_Tree : Project_Tree_Ref)
is is
pragma Unreferenced (Local_Root); pragma Unreferenced (Local_Root);
...@@ -1320,8 +1322,8 @@ package body Prj is ...@@ -1320,8 +1322,8 @@ package body Prj is
Dummy : in out Boolean) Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy, Tree); pragma Unreferenced (Dummy, Tree);
List : Project_List; List : Project_List;
Prj2 : Project_Id; Prj2 : Project_Id;
begin begin
-- A project is not importing itself -- A project is not importing itself
...@@ -1357,6 +1359,7 @@ package body Prj is ...@@ -1357,6 +1359,7 @@ package body Prj is
Dummy : Boolean := False; Dummy : Boolean := False;
List : Project_List; List : Project_List;
begin begin
List := Local_Tree.Projects; List := Local_Tree.Projects;
while List /= null loop while List /= null loop
...@@ -1372,6 +1375,8 @@ package body Prj is ...@@ -1372,6 +1375,8 @@ package body Prj is
procedure For_Aggregates is procedure For_Aggregates is
new For_Project_And_Aggregated (Analyze_Tree); new For_Project_And_Aggregated (Analyze_Tree);
-- Start of processing for Compute_All_Imported_Projects
begin begin
For_Aggregates (Root_Project, Tree); For_Aggregates (Root_Project, Tree);
end Compute_All_Imported_Projects; end Compute_All_Imported_Projects;
......
...@@ -5542,7 +5542,6 @@ package body Sem_Ch8 is ...@@ -5542,7 +5542,6 @@ package body Sem_Ch8 is
Scope_Depth (Old_S) Scope_Depth (Old_S)
then then
return Old_S; return Old_S;
else else
return It.Nam; return It.Nam;
end if; end if;
...@@ -5555,7 +5554,7 @@ package body Sem_Ch8 is ...@@ -5555,7 +5554,7 @@ package body Sem_Ch8 is
return Report_Overload; return Report_Overload;
end if; end if;
-- If not within an instance, ambiguity is real. -- If not within an instance, ambiguity is real
else else
return Report_Overload; return Report_Overload;
......
...@@ -13326,6 +13326,7 @@ package body Sem_Prag is ...@@ -13326,6 +13326,7 @@ package body Sem_Prag is
if Arg_Count = 4 then if Arg_Count = 4 then
Check_Identifier (Arg3, Name_Requires); Check_Identifier (Arg3, Name_Requires);
Check_Identifier (Arg4, Name_Ensures); Check_Identifier (Arg4, Name_Ensures);
elsif Arg_Count = 3 then elsif Arg_Count = 3 then
Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures); Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures);
end if; end if;
......
...@@ -8076,6 +8076,8 @@ package body Sem_Res is ...@@ -8076,6 +8076,8 @@ package body Sem_Res is
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
begin begin
-- Normal mode (not ALFA)
if not ALFA_Mode then if not ALFA_Mode then
-- The loop structure is already resolved during its analysis, only -- The loop structure is already resolved during its analysis, only
...@@ -8086,11 +8088,10 @@ package body Sem_Res is ...@@ -8086,11 +8088,10 @@ package body Sem_Res is
Expander_Mode_Save_And_Set (False); Expander_Mode_Save_And_Set (False);
Resolve (Condition (N), Typ); Resolve (Condition (N), Typ);
Expander_Mode_Restore; Expander_Mode_Restore;
else
-- In ALFA_Mode, no such magic needs to happen, we just resolve the -- In ALFA_Mode, no magic needed, we just resolve the underlying nodes
-- underlying nodes.
else
Resolve (Condition (N), Typ); Resolve (Condition (N), Typ);
end if; end if;
end Resolve_Quantified_Expression; end Resolve_Quantified_Expression;
......
...@@ -4274,7 +4274,7 @@ package body Sem_Util is ...@@ -4274,7 +4274,7 @@ package body Sem_Util is
function Get_Ensures_From_Test_Case_Pragma (N : Node_Id) return Node_Id is function Get_Ensures_From_Test_Case_Pragma (N : Node_Id) return Node_Id is
Args : constant List_Id := Pragma_Argument_Associations (N); Args : constant List_Id := Pragma_Argument_Associations (N);
Res : Node_Id := Empty; Res : Node_Id;
begin begin
if List_Length (Args) = 4 then if List_Length (Args) = 4 then
...@@ -4282,9 +4282,13 @@ package body Sem_Util is ...@@ -4282,9 +4282,13 @@ package body Sem_Util is
elsif List_Length (Args) = 3 then elsif List_Length (Args) = 3 then
Res := Pick (Args, 3); Res := Pick (Args, 3);
if Chars (Res) /= Name_Ensures then if Chars (Res) /= Name_Ensures then
Res := Empty; Res := Empty;
end if; end if;
else
Res := Empty;
end if; end if;
return Res; return Res;
...@@ -4436,14 +4440,18 @@ package body Sem_Util is ...@@ -4436,14 +4440,18 @@ package body Sem_Util is
function Get_Requires_From_Test_Case_Pragma (N : Node_Id) return Node_Id is function Get_Requires_From_Test_Case_Pragma (N : Node_Id) return Node_Id is
Args : constant List_Id := Pragma_Argument_Associations (N); Args : constant List_Id := Pragma_Argument_Associations (N);
Res : Node_Id := Empty; Res : Node_Id;
begin begin
if List_Length (Args) >= 3 then if List_Length (Args) >= 3 then
Res := Pick (Args, 3); Res := Pick (Args, 3);
if Chars (Res) /= Name_Requires then if Chars (Res) /= Name_Requires then
Res := Empty; Res := Empty;
end if; end if;
else
Res := Empty;
end if; end if;
return Res; return Res;
......
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