Commit 246ff1ae by Arnaud Charlet

[multiple changes]

2012-12-05  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, sem_prag.adb, put_scos.adb, get_scos.adb: Minor
	reformatting.

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb: Code clean up.

From-SVN: r194217
parent f957d41e
2012-12-05 Robert Dewar <dewar@adacore.com>
* par_sco.adb, sem_prag.adb, put_scos.adb, get_scos.adb: Minor
reformatting.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb: Code clean up.
2012-12-05 Arnaud Charlet <charlet@adacore.com> 2012-12-05 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Make-lang.in: Update dependencies.
......
...@@ -398,6 +398,7 @@ begin ...@@ -398,6 +398,7 @@ begin
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc; Name_Buffer (Name_Len) := Getc;
end loop; end loop;
Nam := Name_Find; Nam := Name_Find;
else else
......
...@@ -829,6 +829,7 @@ package body Par_SCO is ...@@ -829,6 +829,7 @@ package body Par_SCO is
SCO_Index := SCO_Index + 1; SCO_Index := SCO_Index + 1;
end loop; end loop;
end if; end if;
SCO_Index := SCO_Index + 1; SCO_Index := SCO_Index + 1;
end loop; end loop;
......
...@@ -23,9 +23,9 @@ ...@@ -23,9 +23,9 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with SCOs; use SCOs; with SCOs; use SCOs;
procedure Put_SCOs is procedure Put_SCOs is
Current_SCO_Unit : SCO_Unit_Index := 0; Current_SCO_Unit : SCO_Unit_Index := 0;
...@@ -250,8 +250,7 @@ begin ...@@ -250,8 +250,7 @@ begin
loop loop
declare declare
T : SCO_Table_Entry T : SCO_Table_Entry renames SCO_Table.Table (Start);
renames SCO_Table.Table (Start);
begin begin
Write_Info_Char (' '); Write_Info_Char (' ');
......
...@@ -1192,7 +1192,8 @@ package body Sem_Ch3 is ...@@ -1192,7 +1192,8 @@ package body Sem_Ch3 is
-- In ASIS mode, the access_to_subprogram may be analyzed twice, -- In ASIS mode, the access_to_subprogram may be analyzed twice,
-- when it is part of an unconstrained type and subtype expansion -- when it is part of an unconstrained type and subtype expansion
-- is disabled. To avoid back-end problems with shared profiles, -- is disabled. To avoid back-end problems with shared profiles,
-- use previous subprogram type as the designated type. -- use previous subprogram type as the designated type, and then
-- remove scope added above.
if ASIS_Mode if ASIS_Mode
and then Present (Scope (Defining_Identifier (F))) and then Present (Scope (Defining_Identifier (F)))
...@@ -1201,6 +1202,7 @@ package body Sem_Ch3 is ...@@ -1201,6 +1202,7 @@ package body Sem_Ch3 is
Init_Size_Align (T_Name); Init_Size_Align (T_Name);
Set_Directly_Designated_Type (T_Name, Set_Directly_Designated_Type (T_Name,
Scope (Defining_Identifier (F))); Scope (Defining_Identifier (F)));
End_Scope;
return; return;
end if; end if;
...@@ -4993,10 +4995,20 @@ package body Sem_Ch3 is ...@@ -4993,10 +4995,20 @@ package body Sem_Ch3 is
Scope_Stack.Table (Scope_Stack.Last); Scope_Stack.Table (Scope_Stack.Last);
Anon : constant Entity_Id := Make_Temporary (Loc, 'S'); Anon : constant Entity_Id := Make_Temporary (Loc, 'S');
Acc : Node_Id;
Acc : Node_Id;
-- Access definition in declaration
Comp : Node_Id; Comp : Node_Id;
-- Object definition or formal definition with an access definition
Decl : Node_Id; Decl : Node_Id;
P : Node_Id; -- Declaration of anonymous access to subprogram type
Spec : Node_Id;
-- Original specification in access to subprogram
P : Node_Id;
begin begin
Set_Is_Internal (Anon); Set_Is_Internal (Anon);
...@@ -5032,10 +5044,12 @@ package body Sem_Ch3 is ...@@ -5032,10 +5044,12 @@ package body Sem_Ch3 is
raise Program_Error; raise Program_Error;
end case; end case;
Decl := Make_Full_Type_Declaration (Loc, Spec := Access_To_Subprogram_Definition (Acc);
Defining_Identifier => Anon,
Type_Definition => Decl :=
Copy_Separate_Tree (Access_To_Subprogram_Definition (Acc))); Make_Full_Type_Declaration (Loc,
Defining_Identifier => Anon,
Type_Definition => Relocate_Node (Spec));
Mark_Rewrite_Insertion (Decl); Mark_Rewrite_Insertion (Decl);
......
...@@ -1960,7 +1960,7 @@ package body Sem_Prag is ...@@ -1960,7 +1960,7 @@ package body Sem_Prag is
if Nkind (Stmt) = N_Block_Statement then if Nkind (Stmt) = N_Block_Statement then
if (No (Declarations (Stmt)) if (No (Declarations (Stmt))
or else List_Containing (Prev) /= Declarations (Stmt)) or else List_Containing (Prev) /= Declarations (Stmt))
and then and then
List_Containing (Prev) /= List_Containing (Prev) /=
Statements (Handled_Statement_Sequence (Stmt)) Statements (Handled_Statement_Sequence (Stmt))
...@@ -7013,6 +7013,9 @@ package body Sem_Prag is ...@@ -7013,6 +7013,9 @@ package body Sem_Prag is
-- pragma Assume (boolean_EXPRESSION); -- pragma Assume (boolean_EXPRESSION);
-- This should share pragma Assert code ???
-- Run-time check is missing completely ???
when Pragma_Assume => Assume : declare when Pragma_Assume => Assume : declare
begin begin
GNAT_Pragma; GNAT_Pragma;
......
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