2010-01-26 Robert Dewar <dewar@adacore.com>
+ * get_scos.adb (Get_SCOs): Implement new form of CS entries (multiple
+ entries per line, one for each statement in the sequence).
+ * par_sco.adb (Traverse_Declarations_Or_Statements): Increase array
+ size from 100 to 10_000 for SC_Array to avoid any real possibility of
+ overflow. Output decisions in for loops.
+ Exclude labels from CS lines.
+ * scos.ads: Clarify that label is not included in the entry point
+
+2010-01-26 Robert Dewar <dewar@adacore.com>
+
* par_sco.adb (Traverse_Declarations_Or_Statments): Implement new
format of statement sequence SCO entries (one location/statement).
* put_scos.adb (Put_SCOs): Implement new format of CS lines
use ASCII;
-- For CR/LF
+ function At_EOL return Boolean;
+ -- Skips any spaces, then checks if we are the end of a line. If so,
+ -- returns True (but does not skip over the EOL sequence). If not,
+ -- then returns False.
+
procedure Check (C : Character);
-- Checks that file is positioned at given character, and if so skips past
-- it, If not, raises Data_Error.
-- Skips zero or more spaces at the current position, leaving the file
-- positioned at the first non-blank character (or Types.EOF).
+ ------------
+ -- At_EOL --
+ ------------
+
+ function At_EOL return Boolean is
+ begin
+ Skip_Spaces;
+ return Nextc = CR or else Nextc = LF;
+ end At_EOL;
+
-----------
-- Check --
-----------
-- Statement entry
when 'S' =>
- Get_Sloc_Range (Loc1, Loc2);
- Add_SCO (C1 => 'S', From => Loc1, To => Loc2);
+ declare
+ Typ : Character;
+ Key : Character;
+
+ begin
+ Skip_Spaces;
+ Key := 'S';
+
+ loop
+ Typ := Nextc;
+
+ if Typ in '1' .. '9' then
+ Typ := ' ';
+ else
+ Skipc;
+ end if;
+
+ Get_Sloc_Range (Loc1, Loc2);
+
+ Add_SCO
+ (C1 => Key,
+ C2 => C,
+ From => Loc1,
+ To => Loc2,
+ Last => At_EOL);
+
+ exit when At_EOL;
+ Key := 's';
+ end loop;
+ end;
-- Exit entry
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');
+ declare
+ ISC : constant Node_Id := Iteration_Scheme (N);
+
+ begin
+ Extend_Statement_Sequence (N, ISC, 'F');
+
+ if Present (Condition (ISC)) then
+ Process_Decisions
+ (Condition (ISC), 'W');
+ else
+ Process_Decisions
+ (Loop_Parameter_Specification (ISC), 'X');
+ end if;
+ end;
end if;
Set_Statement_Entry;