with SCOs; use SCOs;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
+with Snames; use Snames;
with Table;
with GNAT.HTable; use GNAT.HTable;
procedure Process_Decisions (N : Node_Id; T : Character);
-- If N is Empty, has no effect. Otherwise scans the tree for the node N,
- -- to output any decisions it contains. T is one of IEWX (for context of
- -- expresion: if/while/when-exit/expression). If T is other than X, then
- -- the node is always a decision a decision is always present (at the very
- -- least a simple decision is present at the top level).
+ -- to output any decisions it contains. T is one of IEPWX (for context of
+ -- expresion: if/exit when/pragma/while/expression). If T is other than X,
+ -- then a decision is always present (at the very least a simple decision
+ -- is present at the top level).
procedure Process_Decisions (L : List_Id; T : Character);
-- Calls above procedure for each element of the list L
end record;
-- Used to store a single entry in the following array
- SC_Array : array (Nat range 1 .. 100) of SC_Entry;
+ SC_Array : array (Nat range 1 .. 10_000) of SC_Entry;
SC_Last : Nat;
-- Used to store statement components for a CS entry to be output
-- as a result of the call to this procedure. SC_Last is the last
-- the temporary caching of results in this array is that we want
-- the SCO table entries for a given CS line to be contiguous, and
-- the processing may output intermediate entries such as decision
- -- entries. Note that the limit of 100 here is arbitrary, but does
- -- not cause any trouble, if we encounter more than 100 statements
+ -- entries. Note that the limit of 10_000 here is arbitrary, but does
+ -- not cause any trouble, if we encounter more than 10_000 statements
-- we simply break the current CS sequence at that point, which is
-- harmless, since this is only used for back annotation and it is
- -- not critical that back annotation always work in all cases.
+ -- not critical that back annotation always work in all cases. Anyway
+ -- exceeding 10,000 statements in a basic block is very unlikely.
procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
-- Extend the current statement sequence to encompass the node N. Typ
Set_Statement_Entry;
Process_Decisions (Condition (N), 'E');
- -- Label, which breaks the current statement sequence, and then
- -- we include the label in the subsequent statement sequence.
+ -- 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;
- Extend_Statement_Sequence (N, ' ');
- -- Block statement, which breaks the current statement seqeunce
- -- it probably does not need to, but for now it does.
+ -- Block statement, which breaks the current statement sequence
when N_Block_Statement =>
Set_Statement_Entry;
when N_Loop_Statement =>
if Present (Iteration_Scheme (N)) then
- Extend_Statement_Sequence (N, Iteration_Scheme (N), 'F');
- Process_Decisions (Condition (Iteration_Scheme (N)), 'W');
+
+ -- If iteration scheme present, extend the current
+ -- statement sequence to include the iteration scheme
+ -- and process any decisions it contains.
+
+ declare
+ ISC : constant Node_Id := Iteration_Scheme (N);
+
+ begin
+ -- While statement
+
+ if Present (Condition (ISC)) then
+ Extend_Statement_Sequence (N, ISC, 'W');
+ Process_Decisions (Condition (ISC), 'W');
+
+ -- For statement
+
+ else
+ Extend_Statement_Sequence (N, ISC, 'F');
+ Process_Decisions
+ (Loop_Parameter_Specification (ISC), 'X');
+ end if;
+ end;
end if;
Set_Statement_Entry;
Traverse_Declarations_Or_Statements (Statements (N));
+ -- Pragma
+
+ when N_Pragma =>
+ Extend_Statement_Sequence (N, 'P');
+
+ -- For pragmas Assert, Check, Precondition, and
+ -- Postcondition, we generate decision entries for the
+ -- condition only if the pragma is enabled. For now, we just
+ -- check Assertions_Enabled, which will be set to reflect
+ -- the presence of -gnata.
+
+ -- Later we should move processing of the relevant pragmas
+ -- to Par_Prag, and properly set the flag Pragma_Enabled at
+ -- parse time, so that we can check this flag instead ???
+
+ -- For all other pragmas, we always generate decision
+ -- entries for any embedded expressions.
+
+ declare
+ Nam : constant Name_Id :=
+ Chars (Pragma_Identifier (N));
+ Arg : Node_Id := First (Pragma_Argument_Associations (N));
+ begin
+ case Nam is
+ when Name_Assert |
+ Name_Check |
+ Name_Precondition |
+ Name_Postcondition =>
+
+ if Nam = Name_Check then
+ Next (Arg);
+ end if;
+
+ if Assertions_Enabled then
+ Process_Decisions (Expression (Arg), 'P');
+ end if;
+
+ when others =>
+ Process_Decisions (N, 'X');
+ end case;
+ end;
+
-- All other cases, which extend the current statement sequence
-- but do not terminate it, even if they have nested decisions.
when N_Generic_Instantiation =>
Typ := 'i';
- when N_Pragma =>
- Typ := 'P';
-
when others =>
Typ := ' ';
end case;
OSDN Git Service
