This change refines the source coverage obligation information emitted
for SELECT statements to allow structural coverage analysis of code
that use tasking.
The following compilation must produce the indicated SCOs.
procedure Sel is
task Opmaster is
entry Compute_And (A, B : Boolean; Result : out Boolean);
end Opmaster;
task Op2 is
entry Foo;
end Op2;
task body Op2 is
begin
accept Foo do null; end Foo;
end Op2;
task body Opmaster is
X, Y : Boolean;
begin
----------------------
-- Selective accept --
----------------------
-- With delay
select
accept Compute_And (A, B : Boolean; Result : out Boolean) do -- # huh ?
Result := A and then B; -- # do_and
end;
null;
or when X => -- alternative with guard
accept Compute_And (A, B : Boolean; Result : out Boolean) do -- # huh ?
Result := A and then B; -- # do_and
end;
null;
or
delay 1.0;
null;
end select;
-- With terminate
select
accept Compute_And (A, B : Boolean; Result : out Boolean) do -- # huh ?
Result := A and then B; -- # do_and
end;
null;
or
terminate;
end select;
-- With else part
select
accept Compute_And (A, B : Boolean; Result : out Boolean) do -- # huh ?
Result := A and then B; -- # do_and
end;
null;
else
null;
null;
end select;
----------------------
-- Timed entry call --
----------------------
select
Op2.Foo;
null;
or
delay 1.0;
null;
end select;
----------------------------
-- Conditional entry call --
----------------------------
select
Op2.Foo;
null;
else
null;
null;
end select;
---------
-- ATC --
---------
select
Op2.Foo;
null;
then abort
delay 1.0;
null;
end select;
end Opmaster;
begin
null;
end Sel;
C 12 sel.adb
CS 2:4-4:8 6:4-8:8
CS A12:7-12:31
CS >S12:7 12:21-12:21
CS o16:7-16:14
CS S24:7-24:7
CS >S24:7 A25:10-25:59
CS >S25:10 26:13-26:34
CX &26:25 c26:23-26:23 c26:34-26:34
CS >S25:10 28:10-28:10
CG 29:15 c29:15-29:15
CS >T29:15 A30:10-30:59
CS >S30:10 31:13-31:34
CX &31:25 c31:23-31:23 c31:34-31:34
CS >S30:10 33:10-33:10
CS >S24:7 35:10-35:16 36:10-36:10
CS >S24:7 S41:7-41:7
CS >S41:7 A42:10-42:59
CS >S42:10 43:13-43:34
CX &43:25 c43:23-43:23 c43:34-43:34
CS >S42:10 45:10-45:10
CS >S41:7 47:10-47:10
CS >S41:7 S52:7-52:7
CS >S52:7 A53:10-53:59
CS >S53:10 54:13-54:34
CX &54:25 c54:23-54:23 c54:34-54:34
CS >S53:10 56:10-56:10
CS >S52:7 58:10-58:10 59:10-59:10
CS >S52:7 S66:7-66:7
CS >S66:7 67:10-67:14 68:10-68:10
CS >S66:7 70:10-70:16 71:10-71:10
CS >S66:7 S78:7-78:7
CS >S78:7 79:10-79:14 80:10-80:10
CS >S78:7 82:10-82:10 83:10-83:10
CS >S78:7 S90:7-90:7
CS >S90:7 91:10-91:14 92:10-92:10
CS >S90:7 94:10-94:16 95:10-95:10
CS 100:4-100:4
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-12 Thomas Quinot <qui...@adacore.com>
* par_sco.adb, scos.ads: Emit detailed SCOs for SELECT statements.
Index: par_sco.adb
===================================================================
--- par_sco.adb (revision 189431)
+++ par_sco.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -69,9 +69,9 @@
-- We need to be able to get to conditions quickly for handling the calls
-- to Set_SCO_Condition efficiently, and similarly to get to pragmas to
- -- handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify
- -- the conditions and pragmas in the table by their starting sloc, and use
- -- this hash table to map from these sloc values to SCO_Table indexes.
+ -- handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify the
+ -- conditions and pragmas in the table by their starting sloc, and use this
+ -- hash table to map from these sloc values to SCO_Table indexes.
type Header_Num is new Integer range 0 .. 996;
-- Type for hash table headers
@@ -133,13 +133,16 @@
-- F/T/S/E for a valid dominance marker, or ' ' for no dominant
N : Node_Id;
- -- Node providing the sloc(s) for the dominance marker
+ -- Node providing the Sloc(s) for the dominance marker
end record;
No_Dominant : constant Dominant_Info := (' ', Empty);
procedure Traverse_Declarations_Or_Statements
(L : List_Id;
- D : Dominant_Info := No_Dominant);
+ D : Dominant_Info := No_Dominant;
+ P : Node_Id := Empty);
+ -- Process L, a list of statements or declarations dominated by D.
+ -- If P is present, it is processed as though it had been prepended to L.
procedure Traverse_Generic_Instantiation (N : Node_Id);
procedure Traverse_Generic_Package_Declaration (N : Node_Id);
@@ -328,9 +331,7 @@
function Is_Logical_Operator (N : Node_Id) return Boolean is
begin
- return Nkind_In (N, N_Op_Not,
- N_And_Then,
- N_Or_Else);
+ return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else);
end Is_Logical_Operator;
-----------------------
@@ -475,7 +476,7 @@
procedure Output_Header (T : Character) is
Loc : Source_Ptr := No_Location;
- -- Node whose sloc is used for the decision
+ -- Node whose Sloc is used for the decision
begin
case T is
@@ -488,13 +489,22 @@
when 'G' | 'P' =>
- -- For entry, the token sloc is from the N_Entry_Body. For
- -- PRAGMA, we must get the location from the pragma node.
+ -- For entry guard, the token sloc is from the N_Entry_Body.
+ -- For PRAGMA, we must get the location from the pragma node.
-- Argument N is the pragma argument, and we have to go up two
-- levels (through the pragma argument association) to get to
- -- the pragma node itself.
+ -- the pragma node itself. For the guard on a select
+ -- alternative, we do not have access to the token location
+ -- for the WHEN, so we use the sloc of the condition itself.
- Loc := Sloc (Parent (Parent (N)));
+ if Nkind_In (Parent (N), N_Accept_Alternative,
+ N_Delay_Alternative,
+ N_Terminate_Alternative)
+ then
+ Loc := Sloc (N);
+ else
+ Loc := Sloc (Parent (Parent (N)));
+ end if;
when 'X' =>
@@ -547,10 +557,7 @@
-- Logical operators, output table entries and then process
-- operands recursively to deal with nested conditions.
- when N_And_Then |
- N_Or_Else |
- N_Op_Not =>
-
+ when N_And_Then | N_Or_Else | N_Op_Not =>
declare
T : Character;
@@ -1036,7 +1043,8 @@
procedure Traverse_Declarations_Or_Statements
(L : List_Id;
- D : Dominant_Info := No_Dominant)
+ D : Dominant_Info := No_Dominant;
+ P : Node_Id := Empty)
is
Current_Dominant : Dominant_Info := D;
-- Dominance information for the current basic block
@@ -1044,8 +1052,7 @@
Current_Test : Node_Id;
-- Conditional node (N_If_Statement or N_Elsiif being processed
- N : Node_Id;
- Dummy : Source_Ptr;
+ N : Node_Id;
SC_First : constant Nat := SC.Last + 1;
SD_First : constant Nat := SD.Last + 1;
@@ -1056,15 +1063,6 @@
-- is the letter that identifies the type of statement/declaration that
-- is being added to the sequence.
- procedure Extend_Statement_Sequence
- (From : Node_Id;
- To : Node_Id;
- Typ : Character);
- -- This version extends the current statement sequence with an entry
- -- that starts with the first token of From, and ends with the last
- -- token of To. It is used for example in a CASE statement to cover
- -- the range from the CASE token to the last token of the expression.
-
procedure Set_Statement_Entry;
-- Output CS entries for all statements saved in table SC, and end the
-- current CS sequence.
@@ -1080,6 +1078,9 @@
pragma Inline (Process_Decisions_Defer);
-- Same case for list arguments, deferred call to Process_Decisions
+ procedure Traverse_One (N : Node_Id);
+ -- Traverse one declaration or statement
+
-------------------------
-- Set_Statement_Entry --
-------------------------
@@ -1180,26 +1181,52 @@
-------------------------------
procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
- F : Source_Ptr;
- T : Source_Ptr;
+ F : Source_Ptr;
+ T : Source_Ptr;
+ Dummy : Source_Ptr;
+ To_Node : Node_Id := Empty;
+
begin
Sloc_Range (N, F, T);
+
+ case Nkind (N) is
+ when N_Accept_Statement =>
+ if Present (Parameter_Specifications (N)) then
+ To_Node := Last (Parameter_Specifications (N));
+ elsif Present (Entry_Index (N)) then
+ To_Node := Entry_Index (N);
+ end if;
+
+ when N_Case_Statement =>
+ To_Node := Expression (N);
+
+ when N_If_Statement | N_Elsif_Part =>
+ To_Node := Condition (N);
+
+ when N_Extended_Return_Statement =>
+ To_Node := Last (Return_Object_Declarations (N));
+
+ when N_Loop_Statement =>
+ To_Node := Iteration_Scheme (N);
+
+ when N_Selective_Accept |
+ N_Timed_Entry_Call |
+ N_Conditional_Entry_Call |
+ N_Asynchronous_Select =>
+ T := F;
+
+ when others =>
+ null;
+
+ end case;
+
+ if Present (To_Node) then
+ Sloc_Range (To_Node, Dummy, T);
+ end if;
+
SC.Append ((N, F, T, Typ));
end Extend_Statement_Sequence;
- procedure Extend_Statement_Sequence
- (From : Node_Id;
- To : Node_Id;
- Typ : Character)
- is
- F : Source_Ptr;
- T : Source_Ptr;
- begin
- Sloc_Range (From, F, Dummy);
- Sloc_Range (To, Dummy, T);
- SC.Append ((From, F, T, Typ));
- end Extend_Statement_Sequence;
-
-----------------------------
-- Process_Decisions_Defer --
-----------------------------
@@ -1214,430 +1241,548 @@
SD.Append ((Empty, L, T, Current_Pragma_Sloc));
end Process_Decisions_Defer;
- -- Start of processing for Traverse_Declarations_Or_Statements
+ ------------------
+ -- Traverse_One --
+ ------------------
- begin
- if Is_Non_Empty_List (L) then
+ procedure Traverse_One (N : Node_Id) is
+ begin
+ -- Initialize or extend current statement sequence. Note that for
+ -- special cases such as IF and Case statements we will modify
+ -- the range to exclude internal statements that should not be
+ -- counted as part of the current statement sequence.
- -- Loop through statements or declarations
+ case Nkind (N) is
- N := First (L);
- while Present (N) loop
+ -- Package declaration
- -- Initialize or extend current statement sequence. Note that for
- -- special cases such as IF and Case statements we will modify
- -- the range to exclude internal statements that should not be
- -- counted as part of the current statement sequence.
+ when N_Package_Declaration =>
+ Set_Statement_Entry;
+ Traverse_Package_Declaration (N);
- case Nkind (N) is
+ -- Generic package declaration
- -- Package declaration
+ when N_Generic_Package_Declaration =>
+ Set_Statement_Entry;
+ Traverse_Generic_Package_Declaration (N);
- when N_Package_Declaration =>
- Set_Statement_Entry;
- Traverse_Package_Declaration (N);
+ -- Package body
- -- Generic package declaration
+ when N_Package_Body =>
+ Set_Statement_Entry;
+ Traverse_Package_Body (N);
- when N_Generic_Package_Declaration =>
- Set_Statement_Entry;
- Traverse_Generic_Package_Declaration (N);
+ -- Subprogram declaration
- -- Package body
+ when N_Subprogram_Declaration =>
+ Process_Decisions_Defer
+ (Parameter_Specifications (Specification (N)), 'X');
- when N_Package_Body =>
- Set_Statement_Entry;
- Traverse_Package_Body (N);
+ -- Generic subprogram declaration
- -- Subprogram declaration
+ when N_Generic_Subprogram_Declaration =>
+ Process_Decisions_Defer
+ (Generic_Formal_Declarations (N), 'X');
+ Process_Decisions_Defer
+ (Parameter_Specifications (Specification (N)), 'X');
- when N_Subprogram_Declaration =>
- Process_Decisions_Defer
- (Parameter_Specifications (Specification (N)), 'X');
+ -- Task or subprogram body
- -- Generic subprogram declaration
+ when N_Task_Body | N_Subprogram_Body =>
+ Set_Statement_Entry;
+ Traverse_Subprogram_Or_Task_Body (N);
- when N_Generic_Subprogram_Declaration =>
- Process_Decisions_Defer
- (Generic_Formal_Declarations (N), 'X');
- Process_Decisions_Defer
- (Parameter_Specifications (Specification (N)), 'X');
+ -- Entry body
- -- Task or subprogram body
+ when N_Entry_Body =>
+ declare
+ Cond : constant Node_Id :=
+ Condition (Entry_Body_Formal_Part (N));
- when N_Task_Body | N_Subprogram_Body =>
+ Inner_Dominant : Dominant_Info := No_Dominant;
+
+ begin
Set_Statement_Entry;
- Traverse_Subprogram_Or_Task_Body (N);
- -- Entry body
+ if Present (Cond) then
+ Process_Decisions_Defer (Cond, 'G');
- when N_Entry_Body =>
+ -- For an entry body with a barrier, the entry body
+ -- is dominanted by a True evaluation of the barrier.
+
+ Inner_Dominant := ('T', N);
+ end if;
+
+ Traverse_Subprogram_Or_Task_Body (N, Inner_Dominant);
+ end;
+
+ -- Protected body
+
+ when N_Protected_Body =>
+ Set_Statement_Entry;
+ Traverse_Protected_Body (N);
+
+ -- Exit statement, which is an exit statement in the SCO sense,
+ -- so it is included in the current statement sequence, but
+ -- then it terminates this sequence. We also have to process
+ -- any decisions in the exit statement expression.
+
+ when N_Exit_Statement =>
+ Extend_Statement_Sequence (N, ' ');
+ Process_Decisions_Defer (Condition (N), 'E');
+ Set_Statement_Entry;
+
+ -- If condition is present, then following statement is
+ -- only executed if the condition evaluates to False.
+
+ if Present (Condition (N)) then
+ Current_Dominant := ('F', N);
+ else
+ Current_Dominant := No_Dominant;
+ end if;
+
+ -- Label, which breaks the current statement sequence, but the
+ -- label itself is not included in the next statement sequence,
+ -- since it generates no code.
+
+ when N_Label =>
+ Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
+
+ -- Block statement, which breaks the current statement sequence
+
+ when N_Block_Statement =>
+ Set_Statement_Entry;
+ Traverse_Declarations_Or_Statements
+ (L => Declarations (N),
+ D => Current_Dominant);
+ Traverse_Handled_Statement_Sequence
+ (N => Handled_Statement_Sequence (N),
+ D => Current_Dominant);
+
+ -- If statement, which breaks the current statement sequence,
+ -- but we include the condition in the current sequence.
+
+ when N_If_Statement =>
+ Current_Test := N;
+ Extend_Statement_Sequence (N, 'I');
+ Process_Decisions_Defer (Condition (N), 'I');
+ Set_Statement_Entry;
+
+ -- Now we traverse the statements in the THEN part
+
+ Traverse_Declarations_Or_Statements
+ (L => Then_Statements (N),
+ D => ('T', N));
+
+ -- Loop through ELSIF parts if present
+
+ if Present (Elsif_Parts (N)) then
declare
- Cond : constant Node_Id :=
- Condition (Entry_Body_Formal_Part (N));
- Inner_Dominant : Dominant_Info := No_Dominant;
+ Saved_Dominant : constant Dominant_Info :=
+ Current_Dominant;
+
+ Elif : Node_Id := First (Elsif_Parts (N));
+
begin
- Set_Statement_Entry;
+ while Present (Elif) loop
- if Present (Cond) then
- Process_Decisions_Defer (Cond, 'G');
+ -- An Elsif is executed only if the previous test
+ -- got a FALSE outcome.
- -- For an entry body with a barrier, the entry body
- -- is dominanted by a True evaluation of the barrier.
+ Current_Dominant := ('F', Current_Test);
- Inner_Dominant := ('T', N);
- end if;
+ -- Now update current test information
- Traverse_Subprogram_Or_Task_Body (N, Inner_Dominant);
- end;
+ Current_Test := Elif;
- -- Protected body
+ -- We generate a statement sequence for the
+ -- construct "ELSIF condition", so that we have
+ -- a statement for the resulting decisions.
- when N_Protected_Body =>
- Set_Statement_Entry;
- Traverse_Protected_Body (N);
+ Extend_Statement_Sequence (Elif, 'I');
+ Process_Decisions_Defer (Condition (Elif), 'I');
+ Set_Statement_Entry;
- -- Exit statement, which is an exit statement in the SCO sense,
- -- so it is included in the current statement sequence, but
- -- then it terminates this sequence. We also have to process
- -- any decisions in the exit statement expression.
+ -- An ELSIF part is never guaranteed to have
+ -- been executed, following statements are only
+ -- dominated by the initial IF statement.
- when N_Exit_Statement =>
- Extend_Statement_Sequence (N, ' ');
- Process_Decisions_Defer (Condition (N), 'E');
- Set_Statement_Entry;
+ Current_Dominant := Saved_Dominant;
- -- If condition is present, then following statement is
- -- only executed if the condition evaluates to False.
+ -- Traverse the statements in the ELSIF
- if Present (Condition (N)) then
- Current_Dominant := ('F', N);
- else
- Current_Dominant := No_Dominant;
- end if;
+ Traverse_Declarations_Or_Statements
+ (L => Then_Statements (Elif),
+ D => ('T', Elif));
+ Next (Elif);
+ end loop;
+ end;
+ end if;
- -- Label, which breaks the current statement sequence, but the
- -- label itself is not included in the next statement sequence,
- -- since it generates no code.
+ -- Finally traverse the ELSE statements if present
- when N_Label =>
- Set_Statement_Entry;
- Current_Dominant := No_Dominant;
+ Traverse_Declarations_Or_Statements
+ (L => Else_Statements (N),
+ D => ('F', Current_Test));
- -- Block statement, which breaks the current statement sequence
+ -- CASE statement, which breaks the current statement sequence,
+ -- but we include the expression in the current sequence.
- when N_Block_Statement =>
- Set_Statement_Entry;
- Traverse_Declarations_Or_Statements
- (L => Declarations (N),
- D => Current_Dominant);
- Traverse_Handled_Statement_Sequence
- (N => Handled_Statement_Sequence (N),
- D => Current_Dominant);
+ when N_Case_Statement =>
+ Extend_Statement_Sequence (N, 'C');
+ Process_Decisions_Defer (Expression (N), 'X');
+ Set_Statement_Entry;
- -- If statement, which breaks the current statement sequence,
- -- but we include the condition in the current sequence.
+ -- Process case branches, all of which are dominated by the
+ -- CASE statement.
- when N_If_Statement =>
- Current_Test := N;
- Extend_Statement_Sequence (N, Condition (N), 'I');
- Process_Decisions_Defer (Condition (N), 'I');
- Set_Statement_Entry;
+ declare
+ Alt : Node_Id;
+ begin
+ Alt := First (Alternatives (N));
+ while Present (Alt) loop
+ Traverse_Declarations_Or_Statements
+ (L => Statements (Alt),
+ D => Current_Dominant);
+ Next (Alt);
+ end loop;
+ end;
- -- Now we traverse the statements in the THEN part
+ -- ACCEPT statement
- Traverse_Declarations_Or_Statements
- (L => Then_Statements (N),
- D => ('T', N));
+ when N_Accept_Statement =>
+ Extend_Statement_Sequence (N, 'A');
+ Set_Statement_Entry;
- -- Loop through ELSIF parts if present
+ -- Process sequence of statements, dominant is the ACCEPT
+ -- statement.
- if Present (Elsif_Parts (N)) then
- declare
- Saved_Dominant : constant Dominant_Info :=
- Current_Dominant;
- Elif : Node_Id := First (Elsif_Parts (N));
+ Traverse_Handled_Statement_Sequence
+ (N => Handled_Statement_Sequence (N),
+ D => Current_Dominant);
- begin
- while Present (Elif) loop
+ -- SELECT
- -- An Elsif is executed only if the previous test
- -- got a FALSE outcome.
+ when N_Selective_Accept =>
+ Extend_Statement_Sequence (N, 'S');
+ Set_Statement_Entry;
- Current_Dominant := ('F', Current_Test);
+ -- Process alternatives
- -- Now update current test information
+ declare
+ Alt : Node_Id;
+ Guard : Node_Id;
+ S_Dom : Dominant_Info;
- Current_Test := Elif;
+ begin
+ Alt := First (Select_Alternatives (N));
+ while Present (Alt) loop
+ S_Dom := Current_Dominant;
+ Guard := Condition (Alt);
- -- We generate a statement sequence for the
- -- construct "ELSIF condition", so that we have
- -- a statement for the resulting decisions.
+ if Present (Guard) then
+ Process_Decisions
+ (Guard,
+ 'G',
+ Pragma_Sloc => No_Location);
+ Current_Dominant := ('T', Guard);
+ end if;
- Extend_Statement_Sequence
- (Elif, Condition (Elif), 'I');
- Process_Decisions_Defer (Condition (Elif), 'I');
- Set_Statement_Entry;
+ Traverse_One (Alt);
- -- An ELSIF part is never guaranteed to have
- -- been executed, following statements are only
- -- dominated by the initial IF statement.
+ Current_Dominant := S_Dom;
+ Next (Alt);
+ end loop;
+ end;
- Current_Dominant := Saved_Dominant;
+ Traverse_Declarations_Or_Statements
+ (L => Else_Statements (N),
+ D => Current_Dominant);
- -- Traverse the statements in the ELSIF
+ when N_Timed_Entry_Call | N_Conditional_Entry_Call =>
+ Extend_Statement_Sequence (N, 'S');
+ Set_Statement_Entry;
- Traverse_Declarations_Or_Statements
- (L => Then_Statements (Elif),
- D => ('T', Elif));
- Next (Elif);
- end loop;
- end;
- end if;
+ -- Process alternatives
- -- Finally traverse the ELSE statements if present
+ Traverse_One (Entry_Call_Alternative (N));
+ if Nkind (N) = N_Timed_Entry_Call then
+ Traverse_One (Delay_Alternative (N));
+ else
Traverse_Declarations_Or_Statements
(L => Else_Statements (N),
- D => ('F', Current_Test));
+ D => Current_Dominant);
+ end if;
- -- Case statement, which breaks the current statement sequence,
- -- but we include the expression in the current sequence.
+ when N_Asynchronous_Select =>
+ Extend_Statement_Sequence (N, 'S');
+ Set_Statement_Entry;
- when N_Case_Statement =>
- Extend_Statement_Sequence (N, Expression (N), 'C');
- Process_Decisions_Defer (Expression (N), 'X');
- Set_Statement_Entry;
+ Traverse_One (Triggering_Alternative (N));
+ Traverse_Declarations_Or_Statements
+ (L => Statements (Abortable_Part (N)),
+ D => Current_Dominant);
- -- Process case branches, all of which are dominated by the
- -- CASE statement.
+ when N_Accept_Alternative =>
+ Traverse_Declarations_Or_Statements
+ (L => Statements (N),
+ D => Current_Dominant,
+ P => Accept_Statement (N));
- declare
- Alt : Node_Id;
- begin
- Alt := First (Alternatives (N));
- while Present (Alt) loop
- Traverse_Declarations_Or_Statements
- (L => Statements (Alt),
- D => Current_Dominant);
- Next (Alt);
- end loop;
- end;
+ when N_Entry_Call_Alternative =>
+ Traverse_Declarations_Or_Statements
+ (L => Statements (N),
+ D => Current_Dominant,
+ P => Entry_Call_Statement (N));
- -- Unconditional exit points, which are included in the current
- -- statement sequence, but then terminate it
+ when N_Delay_Alternative =>
+ Traverse_Declarations_Or_Statements
+ (L => Statements (N),
+ D => Current_Dominant,
+ P => Delay_Statement (N));
- when N_Requeue_Statement |
- N_Goto_Statement |
- N_Raise_Statement =>
- Extend_Statement_Sequence (N, ' ');
- Set_Statement_Entry;
- Current_Dominant := No_Dominant;
+ when N_Triggering_Alternative =>
+ Traverse_Declarations_Or_Statements
+ (L => Statements (N),
+ D => Current_Dominant,
+ P => Triggering_Statement (N));
- -- Simple return statement. which is an exit point, but we
- -- have to process the return expression for decisions.
+ when N_Terminate_Alternative =>
+ Extend_Statement_Sequence (N, ' ');
+ Set_Statement_Entry;
- when N_Simple_Return_Statement =>
- Extend_Statement_Sequence (N, ' ');
- Process_Decisions_Defer (Expression (N), 'X');
- Set_Statement_Entry;
- Current_Dominant := No_Dominant;
+ -- Unconditional exit points, which are included in the current
+ -- statement sequence, but then terminate it
- -- Extended return statement
+ when N_Requeue_Statement |
+ N_Goto_Statement |
+ N_Raise_Statement =>
+ Extend_Statement_Sequence (N, ' ');
+ Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
- when N_Extended_Return_Statement =>
- Extend_Statement_Sequence
- (N, Last (Return_Object_Declarations (N)), 'R');
- Process_Decisions_Defer
- (Return_Object_Declarations (N), 'X');
- Set_Statement_Entry;
+ -- Simple return statement. which is an exit point, but we
+ -- have to process the return expression for decisions.
- Traverse_Handled_Statement_Sequence
- (N => Handled_Statement_Sequence (N),
- D => Current_Dominant);
+ when N_Simple_Return_Statement =>
+ Extend_Statement_Sequence (N, ' ');
+ Process_Decisions_Defer (Expression (N), 'X');
+ Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
- Current_Dominant := No_Dominant;
+ -- Extended return statement
- -- Loop ends the current statement sequence, but we include
- -- the iteration scheme if present in the current sequence.
- -- But the body of the loop starts a new sequence, since it
- -- may not be executed as part of the current sequence.
+ when N_Extended_Return_Statement =>
+ Extend_Statement_Sequence (N, 'R');
+ Process_Decisions_Defer
+ (Return_Object_Declarations (N), 'X');
+ Set_Statement_Entry;
- when N_Loop_Statement =>
- declare
- ISC : constant Node_Id := Iteration_Scheme (N);
- Inner_Dominant : Dominant_Info := No_Dominant;
+ Traverse_Handled_Statement_Sequence
+ (N => Handled_Statement_Sequence (N),
+ D => Current_Dominant);
- begin
- if Present (ISC) then
+ Current_Dominant := No_Dominant;
- -- If iteration scheme present, extend the current
- -- statement sequence to include the iteration scheme
- -- and process any decisions it contains.
+ -- Loop ends the current statement sequence, but we include
+ -- the iteration scheme if present in the current sequence.
+ -- But the body of the loop starts a new sequence, since it
+ -- may not be executed as part of the current sequence.
- -- While loop
+ when N_Loop_Statement =>
+ declare
+ ISC : constant Node_Id := Iteration_Scheme (N);
+ Inner_Dominant : Dominant_Info := No_Dominant;
- if Present (Condition (ISC)) then
- Extend_Statement_Sequence (N, ISC, 'W');
- Process_Decisions_Defer (Condition (ISC), 'W');
+ begin
+ if Present (ISC) then
- -- Set more specific dominant for inner statements
- -- (the control sloc for the decision is that of
- -- the WHILE token).
+ -- If iteration scheme present, extend the current
+ -- statement sequence to include the iteration scheme
+ -- and process any decisions it contains.
- Inner_Dominant := ('T', ISC);
+ -- While loop
- -- For loop
+ if Present (Condition (ISC)) then
+ Extend_Statement_Sequence (N, 'W');
+ Process_Decisions_Defer (Condition (ISC), 'W');
- else
- Extend_Statement_Sequence (N, ISC, 'F');
- Process_Decisions_Defer
- (Loop_Parameter_Specification (ISC), 'X');
- end if;
- end if;
+ -- Set more specific dominant for inner statements
+ -- (the control sloc for the decision is that of
+ -- the WHILE token).
- Set_Statement_Entry;
+ Inner_Dominant := ('T', ISC);
- if Inner_Dominant = No_Dominant then
- Inner_Dominant := Current_Dominant;
+ -- For loop
+
+ else
+ Extend_Statement_Sequence (N, 'F');
+ Process_Decisions_Defer
+ (Loop_Parameter_Specification (ISC), 'X');
end if;
+ end if;
- Traverse_Declarations_Or_Statements
- (L => Statements (N),
- D => Inner_Dominant);
- end;
+ Set_Statement_Entry;
- -- Pragma
+ if Inner_Dominant = No_Dominant then
+ Inner_Dominant := Current_Dominant;
+ end if;
- when N_Pragma =>
+ Traverse_Declarations_Or_Statements
+ (L => Statements (N),
+ D => Inner_Dominant);
+ end;
- -- Record sloc of pragma (pragmas don't nest)
+ -- Pragma
- pragma Assert (Current_Pragma_Sloc = No_Location);
- Current_Pragma_Sloc := Sloc (N);
+ when N_Pragma =>
- -- Processing depends on the kind of pragma
+ -- Record sloc of pragma (pragmas don't nest)
- declare
- Nam : constant Name_Id := Pragma_Name (N);
- Arg : Node_Id := First (Pragma_Argument_Associations (N));
- Typ : Character;
+ pragma Assert (Current_Pragma_Sloc = No_Location);
+ Current_Pragma_Sloc := Sloc (N);
- begin
- case Nam is
- when Name_Assert |
- Name_Check |
- Name_Precondition |
- Name_Postcondition =>
+ -- Processing depends on the kind of pragma
- -- For Assert/Check/Precondition/Postcondition, we
- -- must generate a P entry for the decision. Note
- -- that this is done unconditionally at this stage.
- -- Output for disabled pragmas is suppressed later
- -- on when we output the decision line in Put_SCOs,
- -- depending on setting by Set_SCO_Pragma_Enabled.
+ declare
+ Nam : constant Name_Id := Pragma_Name (N);
+ Arg : Node_Id :=
+ First (Pragma_Argument_Associations (N));
+ Typ : Character;
- if Nam = Name_Check then
- Next (Arg);
- end if;
+ begin
+ case Nam is
+ when Name_Assert |
+ Name_Check |
+ Name_Precondition |
+ Name_Postcondition =>
- Process_Decisions_Defer (Expression (Arg), 'P');
- Typ := 'p';
+ -- For Assert/Check/Precondition/Postcondition, we
+ -- must generate a P entry for the decision. Note
+ -- that this is done unconditionally at this stage.
+ -- Output for disabled pragmas is suppressed later
+ -- on when we output the decision line in Put_SCOs,
+ -- depending on setting by Set_SCO_Pragma_Enabled.
- when Name_Debug =>
- if Present (Arg) and then Present (Next (Arg)) then
+ if Nam = Name_Check then
+ Next (Arg);
+ end if;
- -- Case of a dyadic pragma Debug: first argument
- -- is a P decision, any nested decision in the
- -- second argument is an X decision.
+ Process_Decisions_Defer (Expression (Arg), 'P');
+ Typ := 'p';
- Process_Decisions_Defer (Expression (Arg), 'P');
- Next (Arg);
- end if;
+ when Name_Debug =>
+ if Present (Arg) and then Present (Next (Arg)) then
- Process_Decisions_Defer (Expression (Arg), 'X');
- Typ := 'p';
+ -- Case of a dyadic pragma Debug: first argument
+ -- is a P decision, any nested decision in the
+ -- second argument is an X decision.
- -- For all other pragmas, we generate decision entries
- -- for any embedded expressions, and the pragma is
- -- never disabled.
+ Process_Decisions_Defer (Expression (Arg), 'P');
+ Next (Arg);
+ end if;
- when others =>
- Process_Decisions_Defer (N, 'X');
- Typ := 'P';
- end case;
+ Process_Decisions_Defer (Expression (Arg), 'X');
+ Typ := 'p';
- -- Add statement SCO
+ -- For all other pragmas, we generate decision entries
+ -- for any embedded expressions, and the pragma is
+ -- never disabled.
- Extend_Statement_Sequence (N, Typ);
+ when others =>
+ Process_Decisions_Defer (N, 'X');
+ Typ := 'P';
+ end case;
- Current_Pragma_Sloc := No_Location;
- end;
+ -- Add statement SCO
- -- 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
- -- Prev_Ids is False.
+ Extend_Statement_Sequence (N, Typ);
- when N_Object_Declaration =>
- if not Prev_Ids (N) then
- Extend_Statement_Sequence (N, 'o');
+ Current_Pragma_Sloc := No_Location;
+ end;
- if Has_Decision (N) then
- Process_Decisions_Defer (N, 'X');
- end if;
- end if;
+ -- 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
+ -- Prev_Ids is False.
- -- All other cases, which extend the current statement sequence
- -- but do not terminate it, even if they have nested decisions.
+ when N_Object_Declaration =>
+ if not Prev_Ids (N) then
+ Extend_Statement_Sequence (N, 'o');
- when others =>
+ if Has_Decision (N) then
+ Process_Decisions_Defer (N, 'X');
+ end if;
+ end if;
- -- Determine required type character code, or ASCII.NUL if
- -- no SCO should be generated for this node.
+ -- All other cases, which extend the current statement sequence
+ -- but do not terminate it, even if they have nested decisions.
- declare
- Typ : Character;
+ when others =>
- begin
- case Nkind (N) is
- when N_Full_Type_Declaration |
- N_Incomplete_Type_Declaration |
- N_Private_Type_Declaration |
- N_Private_Extension_Declaration =>
- Typ := 't';
+ -- Determine required type character code, or ASCII.NUL if
+ -- no SCO should be generated for this node.
- when N_Subtype_Declaration =>
- Typ := 's';
+ declare
+ Typ : Character;
- when N_Renaming_Declaration =>
- Typ := 'r';
+ begin
+ case Nkind (N) is
+ when N_Full_Type_Declaration |
+ N_Incomplete_Type_Declaration |
+ N_Private_Type_Declaration |
+ N_Private_Extension_Declaration =>
+ Typ := 't';
- when N_Generic_Instantiation =>
- Typ := 'i';
+ when N_Subtype_Declaration =>
+ Typ := 's';
- when N_Representation_Clause |
- N_Use_Package_Clause |
- N_Use_Type_Clause =>
- Typ := ASCII.NUL;
+ when N_Renaming_Declaration =>
+ Typ := 'r';
- when others =>
- Typ := ' ';
- end case;
+ when N_Generic_Instantiation =>
+ Typ := 'i';
- if Typ /= ASCII.NUL then
- Extend_Statement_Sequence (N, Typ);
- end if;
- end;
+ when N_Representation_Clause |
+ N_Use_Package_Clause |
+ N_Use_Type_Clause =>
+ Typ := ASCII.NUL;
- -- Process any embedded decisions
+ when others =>
+ Typ := ' ';
+ end case;
- if Has_Decision (N) then
- Process_Decisions_Defer (N, 'X');
+ if Typ /= ASCII.NUL then
+ Extend_Statement_Sequence (N, Typ);
end if;
- end case;
+ end;
+ -- Process any embedded decisions
+
+ if Has_Decision (N) then
+ Process_Decisions_Defer (N, 'X');
+ end if;
+ end case;
+
+ end Traverse_One;
+
+ -- Start of processing for Traverse_Declarations_Or_Statements
+
+ begin
+ if Present (P) then
+ Traverse_One (P);
+ end if;
+
+ if Is_Non_Empty_List (L) then
+
+ -- Loop through statements or declarations
+
+ N := First (L);
+ while Present (N) loop
+ Traverse_One (N);
Next (N);
end loop;
Index: scos.ads
===================================================================
--- scos.ads (revision 189431)
+++ scos.ads (working copy)
@@ -152,14 +152,16 @@
-- o object declaration
-- r renaming declaration
-- i generic instantiation
- -- C CASE statement (from CASE through end of expression)
+ -- A ACCEPT statement (from ACCEPT to end of parameter profile)
+ -- C CASE statement (from CASE to end of expression)
-- E EXIT statement
- -- F FOR loop (from FOR through end of iteration scheme)
- -- I IF statement (from IF through end of condition)
+ -- F FOR loop (from FOR to end of iteration scheme)
+ -- I IF statement (from IF to end of condition)
-- P[name:] PRAGMA with the indicated name
-- p[name:] disabled PRAGMA with the indicated name
-- R extended RETURN statement
- -- W WHILE loop statement (from WHILE through end of condition)
+ -- S SELECT statement
+ -- W WHILE loop statement (from WHILE to end of condition)
-- Note: for I and W, condition above is in the RM syntax sense (this
-- condition is a decision in SCO terminology).
