Commit db318f46 by Arnaud Charlet

[multiple changes]

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb: Add SCO generation for S of protected types and
	single protected object declarations.

2013-01-02  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb, osint.ads: Minor reformatting.

From-SVN: r194779
parent 37c1f923
2013-01-02 Thomas Quinot <quinot@adacore.com>
* par_sco.adb: Add SCO generation for S of protected types and
single protected object declarations.
2013-01-02 Robert Dewar <dewar@adacore.com>
* sem_eval.adb, osint.ads: Minor reformatting.
2013-01-02 Hristian Kirtchev <kirtchev@adacore.com> 2013-01-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Check the legality of pragma Assume. * sem_prag.adb (Analyze_Pragma): Check the legality of pragma Assume.
......
...@@ -73,7 +73,7 @@ package Osint is ...@@ -73,7 +73,7 @@ package Osint is
-- found. Note that for the special case of gnat.adc, only the compilation -- found. Note that for the special case of gnat.adc, only the compilation
-- environment directory is searched, i.e. the directory where the ali and -- environment directory is searched, i.e. the directory where the ali and
-- object files are written. Another special case is Debug_Generated_Code -- object files are written. Another special case is Debug_Generated_Code
-- set and the file name ends on ".dg", in which case we look for the -- set and the file name ends in ".dg", in which case we look for the
-- generated file only in the current directory, since that is where it is -- generated file only in the current directory, since that is where it is
-- always built. -- always built.
......
...@@ -161,6 +161,7 @@ package body Par_SCO is ...@@ -161,6 +161,7 @@ package body Par_SCO is
procedure Traverse_Package_Body (N : Node_Id); procedure Traverse_Package_Body (N : Node_Id);
procedure Traverse_Package_Declaration (N : Node_Id); procedure Traverse_Package_Declaration (N : Node_Id);
procedure Traverse_Protected_Body (N : Node_Id); procedure Traverse_Protected_Body (N : Node_Id);
procedure Traverse_Protected_Definition (N : Node_Id);
procedure Traverse_Subprogram_Or_Task_Body procedure Traverse_Subprogram_Or_Task_Body
(N : Node_Id; (N : Node_Id;
D : Dominant_Info := No_Dominant); D : Dominant_Info := No_Dominant);
...@@ -1201,12 +1202,13 @@ package body Par_SCO is ...@@ -1201,12 +1202,13 @@ package body Par_SCO is
procedure Set_Statement_Entry; procedure Set_Statement_Entry;
-- Output CS entries for all statements saved in table SC, and end the -- Output CS entries for all statements saved in table SC, and end the
-- current CS sequence. -- current CS sequence. Then output entries for all decisions nested in
-- these statements, which have been deferred so far.
procedure Process_Decisions_Defer (N : Node_Id; T : Character); procedure Process_Decisions_Defer (N : Node_Id; T : Character);
pragma Inline (Process_Decisions_Defer); pragma Inline (Process_Decisions_Defer);
-- This routine is logically the same as Process_Decisions, except that -- This routine is logically the same as Process_Decisions, except that
-- the arguments are saved in the SD table, for later processing when -- the arguments are saved in the SD table for later processing when
-- Set_Statement_Entry is called, which goes through the saved entries -- Set_Statement_Entry is called, which goes through the saved entries
-- making the corresponding calls to Process_Decision. -- making the corresponding calls to Process_Decision.
...@@ -1353,9 +1355,19 @@ package body Par_SCO is ...@@ -1353,9 +1355,19 @@ package body Par_SCO is
when N_Selective_Accept | when N_Selective_Accept |
N_Timed_Entry_Call | N_Timed_Entry_Call |
N_Conditional_Entry_Call | N_Conditional_Entry_Call |
N_Asynchronous_Select => N_Asynchronous_Select |
N_Single_Protected_Declaration =>
T := F; T := F;
when N_Protected_Type_Declaration =>
if Has_Aspects (N) then
To_Node := Last (Aspect_Specifications (N));
elsif Present (Discriminant_Specifications (N)) then
To_Node := Last (Discriminant_Specifications (N));
else
To_Node := Defining_Identifier (N);
end if;
when others => when others =>
null; null;
...@@ -1930,7 +1942,7 @@ package body Par_SCO is ...@@ -1930,7 +1942,7 @@ package body Par_SCO is
-- Object declaration. Ignored if Prev_Ids is set, since the -- Object declaration. Ignored if Prev_Ids is set, since the
-- parser generates multiple instances of the whole declaration -- parser generates multiple instances of the whole declaration
-- if there is more than one identifier declared, and we only -- if there is more than one identifier declared, and we only
-- want one entry in the SCO's, so we take the first, for which -- want one entry in the SCOs, so we take the first, for which
-- Prev_Ids is False. -- Prev_Ids is False.
when N_Object_Declaration => when N_Object_Declaration =>
...@@ -1945,6 +1957,19 @@ package body Par_SCO is ...@@ -1945,6 +1957,19 @@ package body Par_SCO is
-- All other cases, which extend the current statement sequence -- All other cases, which extend the current statement sequence
-- but do not terminate it, even if they have nested decisions. -- but do not terminate it, even if they have nested decisions.
when N_Protected_Type_Declaration =>
Extend_Statement_Sequence (N, 't');
Process_Decisions_Defer (Discriminant_Specifications (N), 'X');
Set_Statement_Entry;
Traverse_Protected_Definition (Protected_Definition (N));
when N_Single_Protected_Declaration =>
Extend_Statement_Sequence (N, 'o');
Set_Statement_Entry;
Traverse_Protected_Definition (Protected_Definition (N));
when others => when others =>
-- Determine required type character code, or ASCII.NUL if -- Determine required type character code, or ASCII.NUL if
...@@ -2093,6 +2118,28 @@ package body Par_SCO is ...@@ -2093,6 +2118,28 @@ package body Par_SCO is
Traverse_Declarations_Or_Statements (Declarations (N)); Traverse_Declarations_Or_Statements (Declarations (N));
end Traverse_Protected_Body; end Traverse_Protected_Body;
-----------------------------------
-- Traverse_Protected_Definition --
-----------------------------------
procedure Traverse_Protected_Definition (N : Node_Id) is
Dom_Info : Dominant_Info := ('S', Parent (N));
Vis_Decl : constant List_Id := Visible_Declarations (N);
begin
Traverse_Declarations_Or_Statements
(L => Vis_Decl,
D => Dom_Info);
if not Is_Empty_List (Vis_Decl) then
Dom_Info.N := Last (Vis_Decl);
end if;
Traverse_Declarations_Or_Statements
(L => Private_Declarations (N),
D => Dom_Info);
end Traverse_Protected_Definition;
-------------------------------------- --------------------------------------
-- Traverse_Subprogram_Or_Task_Body -- -- Traverse_Subprogram_Or_Task_Body --
-------------------------------------- --------------------------------------
......
...@@ -752,8 +752,7 @@ package body Sem_Eval is ...@@ -752,8 +752,7 @@ package body Sem_Eval is
-- conditions when this is inappropriate. -- conditions when this is inappropriate.
if not (Full_Analysis if not (Full_Analysis
or else or else (Is_Static_Expression (L)
(Is_Static_Expression (L)
and then and then
Is_Static_Expression (R))) Is_Static_Expression (R)))
then then
......
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