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>
* sem_prag.adb (Analyze_Pragma): Check the legality of pragma Assume.
......
......@@ -73,7 +73,7 @@ package Osint is
-- 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
-- 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
-- always built.
......
......@@ -161,6 +161,7 @@ package body Par_SCO is
procedure Traverse_Package_Body (N : Node_Id);
procedure Traverse_Package_Declaration (N : Node_Id);
procedure Traverse_Protected_Body (N : Node_Id);
procedure Traverse_Protected_Definition (N : Node_Id);
procedure Traverse_Subprogram_Or_Task_Body
(N : Node_Id;
D : Dominant_Info := No_Dominant);
......@@ -1201,12 +1202,13 @@ package body Par_SCO is
procedure Set_Statement_Entry;
-- 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);
pragma Inline (Process_Decisions_Defer);
-- 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
-- making the corresponding calls to Process_Decision.
......@@ -1350,12 +1352,22 @@ package body Par_SCO is
when N_Loop_Statement =>
To_Node := Iteration_Scheme (N);
when N_Selective_Accept |
N_Timed_Entry_Call |
N_Conditional_Entry_Call |
N_Asynchronous_Select =>
when N_Selective_Accept |
N_Timed_Entry_Call |
N_Conditional_Entry_Call |
N_Asynchronous_Select |
N_Single_Protected_Declaration =>
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 =>
null;
......@@ -1930,7 +1942,7 @@ package body Par_SCO is
-- Object declaration. Ignored if Prev_Ids is set, since the
-- parser generates multiple instances of the whole declaration
-- 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.
when N_Object_Declaration =>
......@@ -1945,6 +1957,19 @@ package body Par_SCO is
-- All other cases, which extend the current statement sequence
-- 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 =>
-- Determine required type character code, or ASCII.NUL if
......@@ -2093,6 +2118,28 @@ package body Par_SCO is
Traverse_Declarations_Or_Statements (Declarations (N));
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 --
--------------------------------------
......
......@@ -752,10 +752,9 @@ package body Sem_Eval is
-- conditions when this is inappropriate.
if not (Full_Analysis
or else
(Is_Static_Expression (L)
and then
Is_Static_Expression (R)))
or else (Is_Static_Expression (L)
and then
Is_Static_Expression (R)))
then
return Unknown;
end if;
......@@ -3259,7 +3258,7 @@ package body Sem_Eval is
Left_Int := Expr_Value (Left);
if (Kind = N_And_Then and then Is_False (Left_Int))
or else
or else
(Kind = N_Or_Else and then Is_True (Left_Int))
then
Fold_Uint (N, Left_Int, Rstat);
......
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