get_scos.adb, [...]: Code clean up, update documentation.
* get_scos.adb, par_sco.adb, par_sco.ads, put_scos.adb, scos.adb, scos.ads, exp_ch4.adb, sem_warn.adb: Code clean up, update documentation. From-SVN: r160849
This commit is contained in:
parent
e1578ff354
commit
25adc5fbf5
|
@ -1,3 +1,9 @@
|
|||
2010-06-16 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* get_scos.adb, par_sco.adb, par_sco.ads, put_scos.adb, scos.adb,
|
||||
scos.ads, exp_ch4.adb, sem_warn.adb: Code clean up, update
|
||||
documentation.
|
||||
|
||||
2010-06-16 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* exp_disp.adb (Expand_Dispatching_Call): Adjust the decoration of the
|
||||
|
|
|
@ -47,6 +47,7 @@ with Namet; use Namet;
|
|||
with Nlists; use Nlists;
|
||||
with Nmake; use Nmake;
|
||||
with Opt; use Opt;
|
||||
with Par_SCO; use Par_SCO;
|
||||
with Restrict; use Restrict;
|
||||
with Rident; use Rident;
|
||||
with Rtsfind; use Rtsfind;
|
||||
|
@ -8676,7 +8677,6 @@ package body Exp_Ch4 is
|
|||
|
||||
Result := New_Reference_To (Standard_True, Loc);
|
||||
C := Suitable_Element (First_Entity (Typ));
|
||||
|
||||
while Present (C) loop
|
||||
declare
|
||||
New_Lhs : Node_Id;
|
||||
|
@ -8745,7 +8745,28 @@ package body Exp_Ch4 is
|
|||
Shortcut_Ent : constant Entity_Id := Boolean_Literals (Shortcut_Value);
|
||||
-- If Left = Shortcut_Value then Right need not be evaluated
|
||||
|
||||
Expr_If_Left_True, Expr_If_Left_False : Node_Id;
|
||||
function Make_Test_Expr (Opnd : Node_Id) return Node_Id;
|
||||
-- For Opnd a boolean expression, return a Boolean expression equivalent
|
||||
-- to Opnd /= Shortcut_Value.
|
||||
|
||||
--------------------
|
||||
-- Make_Test_Expr --
|
||||
--------------------
|
||||
|
||||
function Make_Test_Expr (Opnd : Node_Id) return Node_Id is
|
||||
begin
|
||||
if Shortcut_Value then
|
||||
return Make_Op_Not (Sloc (Opnd), Opnd);
|
||||
else
|
||||
return Opnd;
|
||||
end if;
|
||||
end Make_Test_Expr;
|
||||
|
||||
Op_Var : Entity_Id;
|
||||
-- Entity for a temporary variable holding the value of the operator,
|
||||
-- used for expansion in the case where actions are present.
|
||||
|
||||
-- Start of processing for Expand_Short_Circuit_Operator
|
||||
|
||||
begin
|
||||
-- Deal with non-standard booleans
|
||||
|
@ -8759,6 +8780,13 @@ package body Exp_Ch4 is
|
|||
-- Check for cases where left argument is known to be True or False
|
||||
|
||||
if Compile_Time_Known_Value (Left) then
|
||||
|
||||
-- Mark SCO for left condition as compile time known
|
||||
|
||||
if Generate_SCO and then Comes_From_Source (Left) then
|
||||
Set_SCO_Condition (Left, Expr_Value_E (Left) = Standard_True);
|
||||
end if;
|
||||
|
||||
-- Rewrite True AND THEN Right / False OR ELSE Right to Right.
|
||||
-- Any actions associated with Right will be executed unconditionally
|
||||
-- and can thus be inserted into the tree unconditionally.
|
||||
|
@ -8787,40 +8815,60 @@ package body Exp_Ch4 is
|
|||
-- If Actions are present, we expand
|
||||
|
||||
-- left AND THEN right
|
||||
-- left OR ELSE right
|
||||
|
||||
-- into
|
||||
|
||||
-- if left then right else false end
|
||||
-- if left then true else right end
|
||||
-- C : Boolean := False;
|
||||
-- IF left THEN
|
||||
-- Actions;
|
||||
-- IF right THEN
|
||||
-- C := True;
|
||||
-- END IF;
|
||||
-- END IF;
|
||||
|
||||
-- with the actions for the right operand being transferred to the
|
||||
-- approriate actions list of the conditional expression. This
|
||||
-- conditional expression is then further expanded (and will eventually
|
||||
-- disappear).
|
||||
-- and finally rewrite the operator into a reference to C. Similarly
|
||||
-- for left OR ELSE right, with negated values. Note that this rewriting
|
||||
-- preserves two invariants that traces-based coverage analysis depends
|
||||
-- upon:
|
||||
|
||||
-- - there is exactly one conditional jump for each operand;
|
||||
|
||||
-- - for each possible values of the expression, there is exactly
|
||||
-- one location in the generated code that is branched to
|
||||
-- (the inner assignment in one case, the point just past the
|
||||
-- outer END IF; in the other case).
|
||||
|
||||
if Present (Actions (N)) then
|
||||
Actlist := Actions (N);
|
||||
|
||||
if Kind = N_And_Then then
|
||||
Expr_If_Left_True := Right;
|
||||
Expr_If_Left_False := New_Occurrence_Of (Standard_False, Loc);
|
||||
Op_Var := Make_Temporary (Loc, 'C', Related_Node => N);
|
||||
|
||||
else
|
||||
Expr_If_Left_True := New_Occurrence_Of (Standard_True, Loc);
|
||||
Expr_If_Left_False := Right;
|
||||
end if;
|
||||
Insert_Action (N,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier =>
|
||||
Op_Var,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc),
|
||||
Expression =>
|
||||
New_Occurrence_Of (Shortcut_Ent, Loc)));
|
||||
|
||||
Rewrite (N,
|
||||
Make_Conditional_Expression (Loc,
|
||||
Expressions => New_List (
|
||||
Left,
|
||||
Expr_If_Left_True,
|
||||
Expr_If_Left_False)));
|
||||
Append_To (Actlist,
|
||||
Make_Implicit_If_Statement (Right,
|
||||
Condition => Make_Test_Expr (Right),
|
||||
Then_Statements => New_List (
|
||||
Make_Assignment_Statement (Sloc (Right),
|
||||
Name =>
|
||||
New_Occurrence_Of (Op_Var, Sloc (Right)),
|
||||
Expression =>
|
||||
New_Occurrence_Of
|
||||
(Boolean_Literals (not Shortcut_Value), Sloc (Right))))));
|
||||
|
||||
-- If the right part of an AND THEN is a function call then it can
|
||||
-- be part of the expansion of the predefined equality operator of a
|
||||
-- tagged type and we may need to adjust its SCIL dispatching node.
|
||||
Insert_Action (N,
|
||||
Make_Implicit_If_Statement (Left,
|
||||
Condition => Make_Test_Expr (Left),
|
||||
Then_Statements => Actlist));
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Op_Var, Loc));
|
||||
|
||||
if Generate_SCIL
|
||||
and then Kind = N_And_Then
|
||||
|
@ -8829,12 +8877,6 @@ package body Exp_Ch4 is
|
|||
Adjust_SCIL_Node (N, Right);
|
||||
end if;
|
||||
|
||||
if Kind = N_And_Then then
|
||||
Set_Then_Actions (N, Actlist);
|
||||
else
|
||||
Set_Else_Actions (N, Actlist);
|
||||
end if;
|
||||
|
||||
Analyze_And_Resolve (N, Standard_Boolean);
|
||||
Adjust_Result_Type (N, Typ);
|
||||
return;
|
||||
|
@ -8843,6 +8885,13 @@ package body Exp_Ch4 is
|
|||
-- No actions present, check for cases of right argument True/False
|
||||
|
||||
if Compile_Time_Known_Value (Right) then
|
||||
|
||||
-- Mark SCO for left condition as compile time known
|
||||
|
||||
if Generate_SCO and then Comes_From_Source (Right) then
|
||||
Set_SCO_Condition (Right, Expr_Value_E (Right) = Standard_True);
|
||||
end if;
|
||||
|
||||
-- Change (Left and then True), (Left or else False) to Left.
|
||||
-- Note that we know there are no actions associated with the right
|
||||
-- operand, since we just checked for this case above.
|
||||
|
|
|
@ -54,7 +54,12 @@ procedure Get_SCOs is
|
|||
-- value read. Data_Error is raised for overflow (value greater than
|
||||
-- Int'Last), or if the initial character is not a digit.
|
||||
|
||||
procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location);
|
||||
procedure Get_Source_Location (Loc : out Source_Location);
|
||||
-- Reads a source location in the form line:col and places the source
|
||||
-- location in Loc. Raises Data_Error if the format does not match this
|
||||
-- requirement. Note that initial spaces are not skipped.
|
||||
|
||||
procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location);
|
||||
-- Skips initial spaces, then reads a source location range in the form
|
||||
-- line:col-line:col and places the two source locations in Loc1 and Loc2.
|
||||
-- Raises Data_Error if format does not match this requirement.
|
||||
|
@ -129,31 +134,32 @@ procedure Get_SCOs is
|
|||
raise Data_Error;
|
||||
end Get_Int;
|
||||
|
||||
--------------------
|
||||
-- Get_Sloc_Range --
|
||||
--------------------
|
||||
-------------------------
|
||||
-- Get_Source_Location --
|
||||
-------------------------
|
||||
|
||||
procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location) is
|
||||
procedure Get_Source_Location (Loc : out Source_Location) is
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
Skip_Spaces;
|
||||
|
||||
Loc1.Line := Logical_Line_Number (Get_Int);
|
||||
Loc.Line := Logical_Line_Number (Get_Int);
|
||||
Check (':');
|
||||
Loc1.Col := Column_Number (Get_Int);
|
||||
|
||||
Check ('-');
|
||||
|
||||
Loc2.Line := Logical_Line_Number (Get_Int);
|
||||
Check (':');
|
||||
Loc2.Col := Column_Number (Get_Int);
|
||||
|
||||
Loc.Col := Column_Number (Get_Int);
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
raise Data_Error;
|
||||
end Get_Sloc_Range;
|
||||
end Get_Source_Location;
|
||||
|
||||
-------------------------------
|
||||
-- Get_Source_Location_Range --
|
||||
-------------------------------
|
||||
|
||||
procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location) is
|
||||
begin
|
||||
Skip_Spaces;
|
||||
Get_Source_Location (Loc1);
|
||||
Check ('-');
|
||||
Get_Source_Location (Loc2);
|
||||
end Get_Source_Location_Range;
|
||||
--------------
|
||||
-- Skip_EOL --
|
||||
--------------
|
||||
|
@ -250,14 +256,31 @@ begin
|
|||
|
||||
-- Statement entry
|
||||
|
||||
when 'S' =>
|
||||
when 'S' | 's' =>
|
||||
declare
|
||||
Typ : Character;
|
||||
Key : Character;
|
||||
|
||||
begin
|
||||
Skip_Spaces;
|
||||
-- If continuation, reset Last indication in last entry
|
||||
-- stored for previous CS or cs line, and start with key
|
||||
-- set to s for continuations.
|
||||
|
||||
if C = 's' then
|
||||
SCO_Table.Table (SCO_Table.Last).Last := False;
|
||||
Key := 's';
|
||||
|
||||
-- CS case (first line, so start with key set to S)
|
||||
|
||||
else
|
||||
Key := 'S';
|
||||
end if;
|
||||
|
||||
-- Initialize to scan items on one line
|
||||
|
||||
Skip_Spaces;
|
||||
|
||||
-- Loop through items on one line
|
||||
|
||||
loop
|
||||
Typ := Nextc;
|
||||
|
@ -268,7 +291,7 @@ begin
|
|||
Skipc;
|
||||
end if;
|
||||
|
||||
Get_Sloc_Range (Loc1, Loc2);
|
||||
Get_Source_Location_Range (Loc1, Loc2);
|
||||
|
||||
Add_SCO
|
||||
(C1 => Key,
|
||||
|
@ -287,32 +310,37 @@ begin
|
|||
when 'I' | 'E' | 'P' | 'W' | 'X' =>
|
||||
Dtyp := C;
|
||||
Skip_Spaces;
|
||||
C := Getc;
|
||||
|
||||
-- Case of simple condition
|
||||
-- Output header
|
||||
|
||||
declare
|
||||
Loc : Source_Location;
|
||||
|
||||
begin
|
||||
-- Acquire location information
|
||||
|
||||
if Dtyp = 'X' then
|
||||
Loc := No_Source_Location;
|
||||
else
|
||||
Get_Source_Location (Loc);
|
||||
end if;
|
||||
|
||||
if C = 'c' or else C = 't' or else C = 'f' then
|
||||
Cond := C;
|
||||
Get_Sloc_Range (Loc1, Loc2);
|
||||
Add_SCO
|
||||
(C1 => Dtyp,
|
||||
C2 => Cond,
|
||||
From => Loc1,
|
||||
To => Loc2,
|
||||
Last => True);
|
||||
|
||||
-- Complex expression
|
||||
|
||||
else
|
||||
Add_SCO (C1 => Dtyp, Last => False);
|
||||
C2 => ' ',
|
||||
From => Loc,
|
||||
To => No_Source_Location,
|
||||
Last => False);
|
||||
end;
|
||||
|
||||
-- Loop through terms in complex expression
|
||||
|
||||
C := Nextc;
|
||||
while C /= CR and then C /= LF loop
|
||||
if C = 'c' or else C = 't' or else C = 'f' then
|
||||
Cond := C;
|
||||
Skipc;
|
||||
Get_Sloc_Range (Loc1, Loc2);
|
||||
Get_Source_Location_Range (Loc1, Loc2);
|
||||
Add_SCO
|
||||
(C2 => Cond,
|
||||
From => Loc1,
|
||||
|
@ -320,12 +348,17 @@ begin
|
|||
Last => False);
|
||||
|
||||
elsif C = '!' or else
|
||||
C = '^' or else
|
||||
C = '&' or else
|
||||
C = '|'
|
||||
then
|
||||
Skipc;
|
||||
Add_SCO (C1 => C, Last => False);
|
||||
|
||||
declare
|
||||
Loc : Source_Location;
|
||||
begin
|
||||
Get_Source_Location (Loc);
|
||||
Add_SCO (C1 => C, From => Loc, Last => False);
|
||||
end;
|
||||
|
||||
elsif C = ' ' then
|
||||
Skip_Spaces;
|
||||
|
@ -340,7 +373,8 @@ begin
|
|||
-- Reset Last indication to True for last entry
|
||||
|
||||
SCO_Table.Table (SCO_Table.Last).Last := True;
|
||||
end if;
|
||||
|
||||
-- No other SCO lines are possible
|
||||
|
||||
when others =>
|
||||
raise Data_Error;
|
||||
|
|
|
@ -104,8 +104,9 @@ package body Par_SCO is
|
|||
-- 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 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).
|
||||
-- the node N is the conditional expression involved, and 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
|
||||
|
@ -115,15 +116,18 @@ package body Par_SCO is
|
|||
C2 : Character;
|
||||
From : Source_Ptr;
|
||||
To : Source_Ptr;
|
||||
Node : Node_Id;
|
||||
Last : Boolean);
|
||||
-- Append an entry to SCO_Table with fields set as per arguments
|
||||
|
||||
procedure Traverse_Declarations_Or_Statements (L : List_Id);
|
||||
procedure Traverse_Generic_Instantiation (N : Node_Id);
|
||||
procedure Traverse_Generic_Package_Declaration (N : Node_Id);
|
||||
procedure Traverse_Handled_Statement_Sequence (N : Node_Id);
|
||||
procedure Traverse_Package_Body (N : Node_Id);
|
||||
procedure Traverse_Package_Declaration (N : Node_Id);
|
||||
procedure Traverse_Subprogram_Body (N : Node_Id);
|
||||
procedure Traverse_Subprogram_Declaration (N : Node_Id);
|
||||
-- Traverse the corresponding construct, generating SCO table entries
|
||||
|
||||
procedure Write_SCOs_To_ALI_File is new Put_SCOs;
|
||||
|
@ -228,6 +232,11 @@ package body Par_SCO is
|
|||
Write_Str (" False");
|
||||
end if;
|
||||
|
||||
if Present (T.Node) then
|
||||
Write_Str (" Node = ");
|
||||
Write_Int (Int (T.Node));
|
||||
end if;
|
||||
|
||||
Write_Eol;
|
||||
end;
|
||||
end loop;
|
||||
|
@ -299,8 +308,7 @@ package body Par_SCO is
|
|||
|
||||
function Is_Logical_Operator (N : Node_Id) return Boolean is
|
||||
begin
|
||||
return Nkind_In (N, N_Op_Xor,
|
||||
N_Op_Not,
|
||||
return Nkind_In (N, N_Op_Not,
|
||||
N_And_Then,
|
||||
N_Or_Else);
|
||||
end Is_Logical_Operator;
|
||||
|
@ -327,6 +335,17 @@ package body Par_SCO is
|
|||
|
||||
procedure Process_Decisions (N : Node_Id; T : Character) is
|
||||
|
||||
Mark : Nat;
|
||||
-- This is used to mark the location of a decision sequence in the SCO
|
||||
-- table. We use it for backing out a simple decision in an expression
|
||||
-- context that contains only NOT operators.
|
||||
|
||||
X_Not_Decision : Boolean;
|
||||
-- This flag keeps track of whether a decision sequence in the SCO table
|
||||
-- contains only NOT operators, and is for an expression context (T=X).
|
||||
-- The flag will be set False if T is other than X, or if an operator
|
||||
-- other than NOT is in the sequence.
|
||||
|
||||
function Process_Node (N : Node_Id) return Traverse_Result;
|
||||
-- Processes one node in the traversal, looking for logical operators,
|
||||
-- and if one is found, outputs the appropriate table entries.
|
||||
|
@ -340,13 +359,15 @@ package body Par_SCO is
|
|||
-- Process_Decision_Operand, because we can't get decisions mixed up in
|
||||
-- the global table. Call has no effect if N is Empty.
|
||||
|
||||
procedure Output_Element (N : Node_Id; T : Character);
|
||||
procedure Output_Element (N : Node_Id);
|
||||
-- Node N is an operand of a logical operator that is not itself a
|
||||
-- logical operator, or it is a simple decision. This routine outputs
|
||||
-- the table entry for the element, with C1 set to T (' ' for one of
|
||||
-- the elements of a complex decision, or 'I'/'W'/'E' for a simple
|
||||
-- decision (from an IF, WHILE, or EXIT WHEN). Last is set to False,
|
||||
-- and an entry is made in the condition hash table.
|
||||
-- the table entry for the element, with C1 set to ' '. Last is set
|
||||
-- False, and an entry is made in the condition hash table.
|
||||
|
||||
procedure Output_Header (T : Character);
|
||||
-- Outputs a decision header node. T is I/W/E/P for IF/WHILE/EXIT WHEN/
|
||||
-- PRAGMA, and 'X' for the expression case.
|
||||
|
||||
procedure Process_Decision_Operand (N : Node_Id);
|
||||
-- This is called on node N, the top level node of a decision, or on one
|
||||
|
@ -376,16 +397,20 @@ package body Par_SCO is
|
|||
else
|
||||
L := Left_Opnd (N);
|
||||
|
||||
if Nkind (N) = N_Op_Xor then
|
||||
C := '^';
|
||||
elsif Nkind_In (N, N_Op_Or, N_Or_Else) then
|
||||
if Nkind_In (N, N_Op_Or, N_Or_Else) then
|
||||
C := '|';
|
||||
else
|
||||
C := '&';
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Set_Table_Entry (C, ' ', No_Location, No_Location, False);
|
||||
Set_Table_Entry
|
||||
(C1 => C,
|
||||
C2 => ' ',
|
||||
From => Sloc (N),
|
||||
To => No_Location,
|
||||
Node => Empty,
|
||||
Last => False);
|
||||
|
||||
Output_Decision_Operand (L);
|
||||
Output_Decision_Operand (Right_Opnd (N));
|
||||
|
@ -393,7 +418,7 @@ package body Par_SCO is
|
|||
-- Not a logical operator
|
||||
|
||||
else
|
||||
Output_Element (N, ' ');
|
||||
Output_Element (N);
|
||||
end if;
|
||||
end Output_Decision_Operand;
|
||||
|
||||
|
@ -401,15 +426,79 @@ package body Par_SCO is
|
|||
-- Output_Element --
|
||||
--------------------
|
||||
|
||||
procedure Output_Element (N : Node_Id; T : Character) is
|
||||
procedure Output_Element (N : Node_Id) is
|
||||
FSloc : Source_Ptr;
|
||||
LSloc : Source_Ptr;
|
||||
begin
|
||||
Sloc_Range (N, FSloc, LSloc);
|
||||
Set_Table_Entry (T, 'c', FSloc, LSloc, False);
|
||||
Set_Table_Entry
|
||||
(C1 => ' ',
|
||||
C2 => 'c',
|
||||
From => FSloc,
|
||||
To => LSloc,
|
||||
Node => Empty,
|
||||
Last => False);
|
||||
Condition_Hash_Table.Set (FSloc, SCO_Table.Last);
|
||||
end Output_Element;
|
||||
|
||||
-------------------
|
||||
-- Output_Header --
|
||||
-------------------
|
||||
|
||||
procedure Output_Header (T : Character) is
|
||||
begin
|
||||
case T is
|
||||
when 'I' | 'E' | 'W' =>
|
||||
|
||||
-- For IF, EXIT, WHILE, the token SLOC can be found from
|
||||
-- the SLOC of the parent of the expression.
|
||||
|
||||
Set_Table_Entry
|
||||
(C1 => T,
|
||||
C2 => ' ',
|
||||
From => Sloc (Parent (N)),
|
||||
To => No_Location,
|
||||
Node => Empty,
|
||||
Last => False);
|
||||
|
||||
when 'P' =>
|
||||
|
||||
-- For PRAGMA, we must record 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.
|
||||
|
||||
declare
|
||||
Pnode : constant Node_Id := Parent (Parent (N));
|
||||
begin
|
||||
Set_Table_Entry
|
||||
(C1 => 'P',
|
||||
C2 => ' ',
|
||||
From => Sloc (Pnode),
|
||||
To => No_Location,
|
||||
Node => Pnode,
|
||||
Last => False);
|
||||
end;
|
||||
|
||||
when 'X' =>
|
||||
|
||||
-- For an expression, no Sloc
|
||||
|
||||
Set_Table_Entry
|
||||
(C1 => 'X',
|
||||
C2 => ' ',
|
||||
From => No_Location,
|
||||
To => No_Location,
|
||||
Node => Empty,
|
||||
Last => False);
|
||||
|
||||
-- No other possibilities
|
||||
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
end case;
|
||||
end Output_Header;
|
||||
|
||||
------------------------------
|
||||
-- Process_Decision_Operand --
|
||||
------------------------------
|
||||
|
@ -419,6 +508,7 @@ package body Par_SCO is
|
|||
if Is_Logical_Operator (N) then
|
||||
if Nkind (N) /= N_Op_Not then
|
||||
Process_Decision_Operand (Left_Opnd (N));
|
||||
X_Not_Decision := False;
|
||||
end if;
|
||||
|
||||
Process_Decision_Operand (Right_Opnd (N));
|
||||
|
@ -458,15 +548,26 @@ package body Par_SCO is
|
|||
|
||||
-- Output header for sequence
|
||||
|
||||
Set_Table_Entry (T, ' ', No_Location, No_Location, False);
|
||||
X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
|
||||
Mark := SCO_Table.Last;
|
||||
Output_Header (T);
|
||||
|
||||
-- Output the decision
|
||||
|
||||
Output_Decision_Operand (N);
|
||||
|
||||
-- Change Last in last table entry to True to mark end
|
||||
-- If the decision was in an expression context (T = 'X')
|
||||
-- and contained only NOT operators, then we don't output
|
||||
-- it, so delete it.
|
||||
|
||||
if X_Not_Decision then
|
||||
SCO_Table.Set_Last (Mark);
|
||||
|
||||
-- Otherwise, set Last in last table entry to mark end
|
||||
|
||||
else
|
||||
SCO_Table.Table (SCO_Table.Last).Last := True;
|
||||
end if;
|
||||
|
||||
-- Process any embedded decisions
|
||||
|
||||
|
@ -508,11 +609,12 @@ package body Par_SCO is
|
|||
-- See if we have simple decision at outer level and if so then
|
||||
-- generate the decision entry for this simple decision. A simple
|
||||
-- decision is a boolean expression (which is not a logical operator
|
||||
-- or short circuit form) appearing as the operand of an IF, WHILE
|
||||
-- or EXIT WHEN construct.
|
||||
-- or short circuit form) appearing as the operand of an IF, WHILE,
|
||||
-- EXIT WHEN, or special PRAGMA construct.
|
||||
|
||||
if T /= 'X' and then not Is_Logical_Operator (N) then
|
||||
Output_Element (N, T);
|
||||
Output_Header (T);
|
||||
Output_Element (N);
|
||||
|
||||
-- Change Last in last table entry to True to mark end of
|
||||
-- sequence, which is this case is only one element long.
|
||||
|
@ -671,6 +773,9 @@ package body Par_SCO is
|
|||
if Nkind (Lu) = N_Subprogram_Body then
|
||||
Traverse_Subprogram_Body (Lu);
|
||||
|
||||
elsif Nkind (Lu) = N_Subprogram_Declaration then
|
||||
Traverse_Subprogram_Declaration (Lu);
|
||||
|
||||
elsif Nkind (Lu) = N_Package_Declaration then
|
||||
Traverse_Package_Declaration (Lu);
|
||||
|
||||
|
@ -680,12 +785,14 @@ package body Par_SCO is
|
|||
elsif Nkind (Lu) = N_Generic_Package_Declaration then
|
||||
Traverse_Generic_Package_Declaration (Lu);
|
||||
|
||||
-- For anything else, the only issue is default expressions for
|
||||
-- parameters, where we have to worry about possible embedded decisions
|
||||
-- but nothing else.
|
||||
elsif Nkind (Lu) in N_Generic_Instantiation then
|
||||
Traverse_Generic_Instantiation (Lu);
|
||||
|
||||
-- All other cases of compilation units (e.g. renamings), generate
|
||||
-- no SCO information.
|
||||
|
||||
else
|
||||
Process_Decisions (Lu, 'X');
|
||||
null;
|
||||
end if;
|
||||
|
||||
-- Make entry for new unit in unit tables, we will fill in the file
|
||||
|
@ -704,11 +811,20 @@ package body Par_SCO is
|
|||
-- Set_SCO_Condition --
|
||||
-----------------------
|
||||
|
||||
procedure Set_SCO_Condition (First_Loc : Source_Ptr; Typ : Character) is
|
||||
Index : constant Nat := Condition_Hash_Table.Get (First_Loc);
|
||||
procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean) is
|
||||
Orig : constant Node_Id := Original_Node (Cond);
|
||||
Index : Nat;
|
||||
Start : Source_Ptr;
|
||||
Dummy : Source_Ptr;
|
||||
|
||||
Constant_Condition_Code : constant array (Boolean) of Character :=
|
||||
(False => 'f', True => 't');
|
||||
begin
|
||||
Sloc_Range (Orig, Start, Dummy);
|
||||
Index := Condition_Hash_Table.Get (Start);
|
||||
|
||||
if Index /= 0 then
|
||||
SCO_Table.Table (Index).C2 := Typ;
|
||||
SCO_Table.Table (Index).C2 := Constant_Condition_Code (Val);
|
||||
end if;
|
||||
end Set_SCO_Condition;
|
||||
|
||||
|
@ -721,6 +837,7 @@ package body Par_SCO is
|
|||
C2 : Character;
|
||||
From : Source_Ptr;
|
||||
To : Source_Ptr;
|
||||
Node : Node_Id;
|
||||
Last : Boolean)
|
||||
is
|
||||
function To_Source_Location (S : Source_Ptr) return Source_Location;
|
||||
|
@ -749,6 +866,7 @@ package body Par_SCO is
|
|||
C2 => C2,
|
||||
From => To_Source_Location (From),
|
||||
To => To_Source_Location (To),
|
||||
Node => Node,
|
||||
Last => Last);
|
||||
end Set_Table_Entry;
|
||||
|
||||
|
@ -756,34 +874,73 @@ package body Par_SCO is
|
|||
-- Traverse_Declarations_Or_Statements --
|
||||
-----------------------------------------
|
||||
|
||||
procedure Traverse_Declarations_Or_Statements (L : List_Id) is
|
||||
N : Node_Id;
|
||||
Dummy : Source_Ptr;
|
||||
-- Tables used by Traverse_Declarations_Or_Statements for temporarily
|
||||
-- holding statement and decision entries. These are declared globally
|
||||
-- since they are shared by recursive calls to this procedure.
|
||||
|
||||
type SC_Entry is record
|
||||
From : Source_Ptr;
|
||||
To : Source_Ptr;
|
||||
Typ : Character;
|
||||
end record;
|
||||
-- Used to store a single entry in the following array
|
||||
-- Used to store a single entry in the following table, From:To represents
|
||||
-- the range of entries in the CS line entry, and typ is the type, with
|
||||
-- space meaning that no type letter will accompany the entry.
|
||||
|
||||
SC_Array : array (Nat range 1 .. 10_000) of SC_Entry;
|
||||
SC_Last : Nat;
|
||||
package SC is new Table.Table (
|
||||
Table_Component_Type => SC_Entry,
|
||||
Table_Index_Type => Nat,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 1000,
|
||||
Table_Increment => 200,
|
||||
Table_Name => "SCO_SC");
|
||||
-- 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
|
||||
-- as a result of the call to this procedure. SC.Last is the last
|
||||
-- entry stored, so the current statement sequence is represented
|
||||
-- by SC_Array (1 .. SC_Last). Extend_Statement_Sequence adds an
|
||||
-- entry to this array, and Set_Statement_Entry clears it, copying
|
||||
-- the entries to the main SCO output table. The reason that we do
|
||||
-- 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 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. Anyway
|
||||
-- exceeding 10,000 statements in a basic block is very unlikely.
|
||||
-- by SC_Array (SC_First .. SC.Last), where SC_First is saved on
|
||||
-- entry to each recursive call to the routine.
|
||||
--
|
||||
-- Extend_Statement_Sequence adds an entry to this array, and then
|
||||
-- Set_Statement_Entry clears the entries starting with SC_First,
|
||||
-- copying these entries to the main SCO output table. The reason that
|
||||
-- we do 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.
|
||||
|
||||
type SD_Entry is record
|
||||
Nod : Node_Id;
|
||||
Lst : List_Id;
|
||||
Typ : Character;
|
||||
end record;
|
||||
-- Used to store a single entry in the following table. Nod is the node to
|
||||
-- be searched for decisions for the case of Process_Decisions_Defer with a
|
||||
-- node argument (with Lst set to No_List. Lst is the list to be searched
|
||||
-- for decisions for the case of Process_Decisions_Defer with a List
|
||||
-- argument (in which case Nod is set to Empty).
|
||||
|
||||
package SD is new Table.Table (
|
||||
Table_Component_Type => SD_Entry,
|
||||
Table_Index_Type => Nat,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 1000,
|
||||
Table_Increment => 200,
|
||||
Table_Name => "SCO_SD");
|
||||
-- Used to store possible decision information. Instead of calling the
|
||||
-- Process_Decisions procedures directly, we call Process_Decisions_Defer,
|
||||
-- which simply stores the arguments in this table. Then when we clear
|
||||
-- out a statement sequence using Set_Statement_Entry, after generating
|
||||
-- the CS lines for the statements, the entries in this table result in
|
||||
-- calls to Process_Decision. The reason for doing things this way is to
|
||||
-- ensure that decisions are output after the CS line for the statements
|
||||
-- in which the decisions occur.
|
||||
|
||||
procedure Traverse_Declarations_Or_Statements (L : List_Id) is
|
||||
N : Node_Id;
|
||||
Dummy : Source_Ptr;
|
||||
|
||||
SC_First : constant Nat := SC.Last + 1;
|
||||
SD_First : constant Nat := SD.Last + 1;
|
||||
-- Record first entries used in SC/SD at this recursive level
|
||||
|
||||
procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
|
||||
-- Extend the current statement sequence to encompass the node N. Typ
|
||||
|
@ -806,32 +963,70 @@ package body Par_SCO is
|
|||
-- called when we find a statement or declaration that generates its
|
||||
-- own table entry, so that we must end the current statement sequence.
|
||||
|
||||
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
|
||||
-- Set_Statement_Entry is called, which goes through the saved entries
|
||||
-- making the corresponding calls to Process_Decision.
|
||||
|
||||
procedure Process_Decisions_Defer (L : List_Id; T : Character);
|
||||
pragma Inline (Process_Decisions_Defer);
|
||||
-- Same case for list arguments, deferred call to Process_Decisions
|
||||
|
||||
-------------------------
|
||||
-- Set_Statement_Entry --
|
||||
-------------------------
|
||||
|
||||
procedure Set_Statement_Entry is
|
||||
C1 : Character;
|
||||
SC_Last : constant Int := SC.Last;
|
||||
SD_Last : constant Int := SD.Last;
|
||||
|
||||
begin
|
||||
if SC_Last /= 0 then
|
||||
for J in 1 .. SC_Last loop
|
||||
if J = 1 then
|
||||
-- Output statement entries from saved entries in SC table
|
||||
|
||||
for J in SC_First .. SC_Last loop
|
||||
if J = SC_First then
|
||||
C1 := 'S';
|
||||
else
|
||||
C1 := 's';
|
||||
end if;
|
||||
|
||||
declare
|
||||
SCE : SC_Entry renames SC.Table (J);
|
||||
begin
|
||||
Set_Table_Entry
|
||||
(C1 => C1,
|
||||
C2 => SC_Array (J).Typ,
|
||||
From => SC_Array (J).From,
|
||||
To => SC_Array (J).To,
|
||||
C2 => SCE.Typ,
|
||||
From => SCE.From,
|
||||
To => SCE.To,
|
||||
Node => Empty,
|
||||
Last => (J = SC_Last));
|
||||
end;
|
||||
end loop;
|
||||
|
||||
SC_Last := 0;
|
||||
-- Clear out used section of SC table
|
||||
|
||||
SC.Set_Last (SC_First - 1);
|
||||
|
||||
-- Output any embedded decisions
|
||||
|
||||
for J in SD_First .. SD_Last loop
|
||||
declare
|
||||
SDE : SD_Entry renames SD.Table (J);
|
||||
begin
|
||||
if Present (SDE.Nod) then
|
||||
Process_Decisions (SDE.Nod, SDE.Typ);
|
||||
else
|
||||
Process_Decisions (SDE.Lst, SDE.Typ);
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
-- Clear out used section of SD table
|
||||
|
||||
SD.Set_Last (SD_First - 1);
|
||||
end Set_Statement_Entry;
|
||||
|
||||
-------------------------------
|
||||
|
@ -839,20 +1034,11 @@ package body Par_SCO is
|
|||
-------------------------------
|
||||
|
||||
procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
|
||||
F : Source_Ptr;
|
||||
T : Source_Ptr;
|
||||
begin
|
||||
-- Clear out statement sequence if array full
|
||||
|
||||
if SC_Last = SC_Array'Last then
|
||||
Set_Statement_Entry;
|
||||
else
|
||||
SC_Last := SC_Last + 1;
|
||||
end if;
|
||||
|
||||
-- Record new entry
|
||||
|
||||
Sloc_Range
|
||||
(N, SC_Array (SC_Last).From, SC_Array (SC_Last).To);
|
||||
SC_Array (SC_Last).Typ := Typ;
|
||||
Sloc_Range (N, F, T);
|
||||
SC.Append ((F, T, Typ));
|
||||
end Extend_Statement_Sequence;
|
||||
|
||||
procedure Extend_Statement_Sequence
|
||||
|
@ -860,27 +1046,32 @@ package body Par_SCO is
|
|||
To : Node_Id;
|
||||
Typ : Character)
|
||||
is
|
||||
F : Source_Ptr;
|
||||
T : Source_Ptr;
|
||||
begin
|
||||
-- Clear out statement sequence if array full
|
||||
|
||||
if SC_Last = SC_Array'Last then
|
||||
Set_Statement_Entry;
|
||||
else
|
||||
SC_Last := SC_Last + 1;
|
||||
end if;
|
||||
|
||||
-- Make new entry
|
||||
|
||||
Sloc_Range (From, SC_Array (SC_Last).From, Dummy);
|
||||
Sloc_Range (To, Dummy, SC_Array (SC_Last).To);
|
||||
SC_Array (SC_Last).Typ := Typ;
|
||||
Sloc_Range (From, F, Dummy);
|
||||
Sloc_Range (To, Dummy, T);
|
||||
SC.Append ((F, T, Typ));
|
||||
end Extend_Statement_Sequence;
|
||||
|
||||
-----------------------------
|
||||
-- Process_Decisions_Defer --
|
||||
-----------------------------
|
||||
|
||||
procedure Process_Decisions_Defer (N : Node_Id; T : Character) is
|
||||
begin
|
||||
SD.Append ((N, No_List, T));
|
||||
end Process_Decisions_Defer;
|
||||
|
||||
procedure Process_Decisions_Defer (L : List_Id; T : Character) is
|
||||
begin
|
||||
SD.Append ((Empty, L, T));
|
||||
end Process_Decisions_Defer;
|
||||
|
||||
-- Start of processing for Traverse_Declarations_Or_Statements
|
||||
|
||||
begin
|
||||
if Is_Non_Empty_List (L) then
|
||||
SC_Last := 0;
|
||||
|
||||
-- Loop through statements or declarations
|
||||
|
||||
|
@ -915,17 +1106,18 @@ package body Par_SCO is
|
|||
-- Subprogram declaration
|
||||
|
||||
when N_Subprogram_Declaration =>
|
||||
Set_Statement_Entry;
|
||||
Process_Decisions
|
||||
Process_Decisions_Defer
|
||||
(Parameter_Specifications (Specification (N)), 'X');
|
||||
Set_Statement_Entry;
|
||||
|
||||
-- Generic subprogram declaration
|
||||
|
||||
when N_Generic_Subprogram_Declaration =>
|
||||
Set_Statement_Entry;
|
||||
Process_Decisions (Generic_Formal_Declarations (N), 'X');
|
||||
Process_Decisions
|
||||
Process_Decisions_Defer
|
||||
(Generic_Formal_Declarations (N), 'X');
|
||||
Process_Decisions_Defer
|
||||
(Parameter_Specifications (Specification (N)), 'X');
|
||||
Set_Statement_Entry;
|
||||
|
||||
-- Subprogram_Body
|
||||
|
||||
|
@ -940,8 +1132,8 @@ package body Par_SCO is
|
|||
|
||||
when N_Exit_Statement =>
|
||||
Extend_Statement_Sequence (N, ' ');
|
||||
Process_Decisions_Defer (Condition (N), 'E');
|
||||
Set_Statement_Entry;
|
||||
Process_Decisions (Condition (N), 'E');
|
||||
|
||||
-- Label, which breaks the current statement sequence, but the
|
||||
-- label itself is not included in the next statement sequence,
|
||||
|
@ -963,16 +1155,33 @@ package body Par_SCO is
|
|||
|
||||
when N_If_Statement =>
|
||||
Extend_Statement_Sequence (N, Condition (N), 'I');
|
||||
Process_Decisions_Defer (Condition (N), 'I');
|
||||
Set_Statement_Entry;
|
||||
Process_Decisions (Condition (N), 'I');
|
||||
|
||||
-- Now we traverse the statements in the THEN part
|
||||
|
||||
Traverse_Declarations_Or_Statements (Then_Statements (N));
|
||||
|
||||
-- Loop through ELSIF parts if present
|
||||
|
||||
if Present (Elsif_Parts (N)) then
|
||||
declare
|
||||
Elif : Node_Id := First (Elsif_Parts (N));
|
||||
|
||||
begin
|
||||
while Present (Elif) loop
|
||||
Process_Decisions (Condition (Elif), 'I');
|
||||
|
||||
-- We generate a statement sequence for the
|
||||
-- construct "ELSIF condition", so that we have
|
||||
-- a statement for the resulting decisions.
|
||||
|
||||
Extend_Statement_Sequence
|
||||
(Elif, Condition (Elif), 'I');
|
||||
Process_Decisions_Defer (Condition (Elif), 'I');
|
||||
Set_Statement_Entry;
|
||||
|
||||
-- Traverse the statements in the ELSIF
|
||||
|
||||
Traverse_Declarations_Or_Statements
|
||||
(Then_Statements (Elif));
|
||||
Next (Elif);
|
||||
|
@ -980,6 +1189,8 @@ package body Par_SCO is
|
|||
end;
|
||||
end if;
|
||||
|
||||
-- Finally traverse the ELSE statements if present
|
||||
|
||||
Traverse_Declarations_Or_Statements (Else_Statements (N));
|
||||
|
||||
-- Case statement, which breaks the current statement sequence,
|
||||
|
@ -987,14 +1198,13 @@ package body Par_SCO is
|
|||
|
||||
when N_Case_Statement =>
|
||||
Extend_Statement_Sequence (N, Expression (N), 'C');
|
||||
Process_Decisions_Defer (Expression (N), 'X');
|
||||
Set_Statement_Entry;
|
||||
Process_Decisions (Expression (N), 'X');
|
||||
|
||||
-- Process case branches
|
||||
|
||||
declare
|
||||
Alt : Node_Id;
|
||||
|
||||
begin
|
||||
Alt := First (Alternatives (N));
|
||||
while Present (Alt) loop
|
||||
|
@ -1017,22 +1227,17 @@ package body Par_SCO is
|
|||
|
||||
when N_Simple_Return_Statement =>
|
||||
Extend_Statement_Sequence (N, ' ');
|
||||
Process_Decisions_Defer (Expression (N), 'X');
|
||||
Set_Statement_Entry;
|
||||
Process_Decisions (Expression (N), 'X');
|
||||
|
||||
-- Extended return statement
|
||||
|
||||
when N_Extended_Return_Statement =>
|
||||
declare
|
||||
Odecl : constant Node_Id :=
|
||||
First (Return_Object_Declarations (N));
|
||||
begin
|
||||
if Present (Expression (Odecl)) then
|
||||
Extend_Statement_Sequence
|
||||
(N, Expression (Odecl), 'R');
|
||||
Process_Decisions (Expression (Odecl), 'X');
|
||||
end if;
|
||||
end;
|
||||
(N, Last (Return_Object_Declarations (N)), 'R');
|
||||
Process_Decisions_Defer
|
||||
(Return_Object_Declarations (N), 'X');
|
||||
Set_Statement_Entry;
|
||||
|
||||
Traverse_Handled_Statement_Sequence
|
||||
(Handled_Statement_Sequence (N));
|
||||
|
@ -1057,13 +1262,13 @@ package body Par_SCO is
|
|||
|
||||
if Present (Condition (ISC)) then
|
||||
Extend_Statement_Sequence (N, ISC, 'W');
|
||||
Process_Decisions (Condition (ISC), 'W');
|
||||
Process_Decisions_Defer (Condition (ISC), 'W');
|
||||
|
||||
-- For statement
|
||||
|
||||
else
|
||||
Extend_Statement_Sequence (N, ISC, 'F');
|
||||
Process_Decisions
|
||||
Process_Decisions_Defer
|
||||
(Loop_Parameter_Specification (ISC), 'X');
|
||||
end if;
|
||||
end;
|
||||
|
@ -1077,42 +1282,55 @@ package body Par_SCO is
|
|||
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.
|
||||
-- Processing depends on the kind of pragma
|
||||
|
||||
-- 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
|
||||
case Pragma_Name (N) is
|
||||
when Name_Assert |
|
||||
Name_Check |
|
||||
Name_Precondition |
|
||||
Name_Postcondition =>
|
||||
|
||||
-- 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.
|
||||
|
||||
declare
|
||||
Nam : constant Name_Id :=
|
||||
Chars (Pragma_Identifier (N));
|
||||
Arg : Node_Id :=
|
||||
First (Pragma_Argument_Associations (N));
|
||||
|
||||
begin
|
||||
if Nam = Name_Check then
|
||||
Next (Arg);
|
||||
end if;
|
||||
|
||||
if Assertions_Enabled then
|
||||
Process_Decisions (Expression (Arg), 'P');
|
||||
end if;
|
||||
Process_Decisions_Defer (Expression (Arg), 'P');
|
||||
end;
|
||||
|
||||
-- For all other pragmas, we generate decision entries
|
||||
-- for any embedded expressions.
|
||||
|
||||
when others =>
|
||||
Process_Decisions (N, 'X');
|
||||
Process_Decisions_Defer (N, 'X');
|
||||
end case;
|
||||
end;
|
||||
|
||||
-- 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.
|
||||
|
||||
when N_Object_Declaration =>
|
||||
if not Prev_Ids (N) then
|
||||
Extend_Statement_Sequence (N, 'o');
|
||||
|
||||
if Has_Decision (N) then
|
||||
Process_Decisions_Defer (N, 'X');
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- All other cases, which extend the current statement sequence
|
||||
-- but do not terminate it, even if they have nested decisions.
|
||||
|
@ -1135,9 +1353,6 @@ package body Par_SCO is
|
|||
when N_Subtype_Declaration =>
|
||||
Typ := 's';
|
||||
|
||||
when N_Object_Declaration =>
|
||||
Typ := 'o';
|
||||
|
||||
when N_Renaming_Declaration =>
|
||||
Typ := 'r';
|
||||
|
||||
|
@ -1154,7 +1369,7 @@ package body Par_SCO is
|
|||
-- Process any embedded decisions
|
||||
|
||||
if Has_Decision (N) then
|
||||
Process_Decisions (N, 'X');
|
||||
Process_Decisions_Defer (N, 'X');
|
||||
end if;
|
||||
end case;
|
||||
|
||||
|
@ -1165,6 +1380,31 @@ package body Par_SCO is
|
|||
end if;
|
||||
end Traverse_Declarations_Or_Statements;
|
||||
|
||||
------------------------------------
|
||||
-- Traverse_Generic_Instantiation --
|
||||
------------------------------------
|
||||
|
||||
procedure Traverse_Generic_Instantiation (N : Node_Id) is
|
||||
First : Source_Ptr;
|
||||
Last : Source_Ptr;
|
||||
|
||||
begin
|
||||
-- First we need a statement entry to cover the instantiation
|
||||
|
||||
Sloc_Range (N, First, Last);
|
||||
Set_Table_Entry
|
||||
(C1 => 'S',
|
||||
C2 => ' ',
|
||||
From => First,
|
||||
To => Last,
|
||||
Node => Empty,
|
||||
Last => True);
|
||||
|
||||
-- Now output any embedded decisions
|
||||
|
||||
Process_Decisions (N, 'X');
|
||||
end Traverse_Generic_Instantiation;
|
||||
|
||||
------------------------------------------
|
||||
-- Traverse_Generic_Package_Declaration --
|
||||
------------------------------------------
|
||||
|
@ -1232,4 +1472,16 @@ package body Par_SCO is
|
|||
Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N));
|
||||
end Traverse_Subprogram_Body;
|
||||
|
||||
-------------------------------------
|
||||
-- Traverse_Subprogram_Declaration --
|
||||
-------------------------------------
|
||||
|
||||
procedure Traverse_Subprogram_Declaration (N : Node_Id) is
|
||||
ADN : constant Node_Id := Aux_Decls_Node (Parent (N));
|
||||
begin
|
||||
Traverse_Declarations_Or_Statements (Config_Pragmas (ADN));
|
||||
Traverse_Declarations_Or_Statements (Declarations (ADN));
|
||||
Traverse_Declarations_Or_Statements (Pragmas_After (ADN));
|
||||
end Traverse_Subprogram_Declaration;
|
||||
|
||||
end Par_SCO;
|
||||
|
|
|
@ -25,156 +25,12 @@
|
|||
|
||||
-- This package contains the routines used to deal with generation and output
|
||||
-- of Soure Coverage Obligations (SCO's) used for coverage analysis purposes.
|
||||
-- See package SCOs for full documentation of format of SCO information.
|
||||
|
||||
with Types; use Types;
|
||||
|
||||
package Par_SCO is
|
||||
|
||||
----------------
|
||||
-- SCO Format --
|
||||
----------------
|
||||
|
||||
-- Source coverage obligations are generated on a unit-by-unit basis in the
|
||||
-- ALI file, using lines that start with the identifying character C. These
|
||||
-- lines are generated if the -gnatC switch is set.
|
||||
|
||||
-- Sloc Ranges
|
||||
|
||||
-- In several places in the SCO lines, Sloc ranges appear. These are used
|
||||
-- to indicate the first and last Sloc of some construct in the tree and
|
||||
-- they have the form:
|
||||
|
||||
-- line:col-line:col
|
||||
|
||||
-- Note that SCO's are generated only for generic templates, not for
|
||||
-- generic instances (since only the first are part of the source). So
|
||||
-- we don't need generic instantiation stuff in these line:col items.
|
||||
|
||||
-- SCO File headers
|
||||
|
||||
-- The SCO information follows the cross-reference information, so it
|
||||
-- need not be read by tools like gnatbind, gnatmake etc. The SCO output
|
||||
-- is divided into sections, one section for each unit for which SCO's
|
||||
-- are generated. A SCO section has a header of the form:
|
||||
|
||||
-- C dependency-number filename
|
||||
|
||||
-- This header precedes SCO information for the unit identified by
|
||||
-- dependency number and file name. The dependency number is the
|
||||
-- index into the generated D lines and is ones origin (i.e. 2 =
|
||||
-- reference to second generated D line).
|
||||
|
||||
-- Note that the filename here will reflect the original name if
|
||||
-- a Source_Reference pragma was encountered (since all line number
|
||||
-- references will be with respect to the original file).
|
||||
|
||||
-- Statements
|
||||
|
||||
-- For the purpose of SCO generation, the notion of statement includes
|
||||
-- simple statements and also the following declaration types:
|
||||
|
||||
-- type_declaration
|
||||
-- subtype_declaration
|
||||
-- object_declaration
|
||||
-- renaming_declaration
|
||||
-- generic_instantiation
|
||||
|
||||
-- Statement lines
|
||||
|
||||
-- These lines correspond to a sequence of one or more statements which
|
||||
-- are always exeecuted in sequence, The first statement may be an entry
|
||||
-- point (e.g. statement after a label), and the last statement may be
|
||||
-- an exit point (e.g. an exit statement), but no other entry or exit
|
||||
-- points may occur within the sequence of statements. The idea is that
|
||||
-- the sequence can be treated as a single unit from a coverage point of
|
||||
-- view, if any of the code for the statement sequence is executed, this
|
||||
-- corresponds to coverage of the entire statement sequence. The form of
|
||||
-- a statement line in the ALI file is:
|
||||
|
||||
-- CS sloc-range
|
||||
|
||||
-- Exit points
|
||||
|
||||
-- An exit point is a statement that causes transfer of control. Examples
|
||||
-- are exit statements, raise statements and return statements. The form
|
||||
-- of an exit point in the ALI file is:
|
||||
|
||||
-- CT sloc-range
|
||||
|
||||
-- Decisions
|
||||
|
||||
-- Decisions represent the most significant section of the SCO lines
|
||||
|
||||
-- Note: in the following description, logical operator includes the
|
||||
-- short circuited forms (so can be any of AND, OR, XOR, NOT, AND THEN,
|
||||
-- or OR ELSE).
|
||||
|
||||
-- Decisions are either simple or complex. A simple decision is a boolean
|
||||
-- expresssion that occurs in the context of a control structure in the
|
||||
-- source program, including WHILE, IF, EXIT WHEN. Note that a boolean
|
||||
-- expression in any other context, e.g. on the right side of an
|
||||
-- assignment, is not considered to be a decision.
|
||||
|
||||
-- A complex decision is an occurrence of a logical operator which is not
|
||||
-- itself an operand of some other logical operator. If any operand of
|
||||
-- the logical operator is itself a logical operator, this is not a
|
||||
-- separate decision, it is part of the same decision.
|
||||
|
||||
-- So for example, if we have
|
||||
|
||||
-- A, B, C, D : Boolean;
|
||||
-- function F (Arg : Boolean) return Boolean);
|
||||
-- ...
|
||||
-- A and then (B or else F (C and then D))
|
||||
|
||||
-- There are two (complex) decisions here:
|
||||
|
||||
-- 1. X and then (Y or else Z)
|
||||
|
||||
-- where X = A, Y = B, and Z = F (C and then D)
|
||||
|
||||
-- 2. C and then D
|
||||
|
||||
-- For each decision, a decision line is generated with the form:
|
||||
|
||||
-- C* expression
|
||||
|
||||
-- Here * is one of the following characters:
|
||||
|
||||
-- I decision in IF statement or conditional expression
|
||||
-- E decision in EXIT WHEN statement
|
||||
-- W decision in WHILE iteration scheme
|
||||
-- X decision appearing in some other expression context
|
||||
|
||||
-- The expression is a prefix polish form indicating the structure of
|
||||
-- the decision, including logical operators and short circuit forms.
|
||||
-- The following is a grammar showing the structure of expression:
|
||||
|
||||
-- expression ::= term (if expr is not logical operator)
|
||||
-- expression ::= & term term (if expr is AND THEN)
|
||||
-- expression ::= | term term (if expr is OR ELSE)
|
||||
-- expression ::= !term (if expr is NOT)
|
||||
|
||||
-- term ::= element
|
||||
-- term ::= expression
|
||||
|
||||
-- element ::= outcome sloc-range
|
||||
|
||||
-- outcome is one of the following letters:
|
||||
|
||||
-- c condition
|
||||
-- t true condition
|
||||
-- f false condition
|
||||
|
||||
-- where t/f are used to mark a condition that has been recognized by
|
||||
-- the compiler as always being true or false.
|
||||
|
||||
-- & indicates either AND THEN connecting two conditions
|
||||
|
||||
-- | indicates either OR ELSE connection two conditions
|
||||
|
||||
-- ! indicates NOT applied to the expression
|
||||
|
||||
-----------------
|
||||
-- Subprograms --
|
||||
-----------------
|
||||
|
@ -187,11 +43,11 @@ package Par_SCO is
|
|||
-- internal tables recording the SCO information. Note that this is done
|
||||
-- before any semantic analysis/expansion happens.
|
||||
|
||||
procedure Set_SCO_Condition (First_Loc : Source_Ptr; Typ : Character);
|
||||
procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean);
|
||||
-- This procedure is called during semantic analysis to record a condition
|
||||
-- which has been identified as always True (Typ = 't') or always False
|
||||
-- (Typ = 'f') by the compiler. The condition is identified by the
|
||||
-- First_Sloc value in the original tree.
|
||||
-- which has been identified as always True or always False, as indicated
|
||||
-- by Val. The condition is identified by the First_Sloc value in the
|
||||
-- original tree associated with Cond.
|
||||
|
||||
procedure SCO_Output;
|
||||
-- Outputs SCO lines for all units, with appropriate section headers, for
|
||||
|
@ -199,8 +55,8 @@ package Par_SCO is
|
|||
-- possibly modified by calls to Set_SCO_Condition.
|
||||
|
||||
procedure dsco;
|
||||
-- Debug routine to dump SCO table. This is a raw format dump showing
|
||||
-- exactly what the tables contain.
|
||||
-- Debug routine to dump internal SCO table. This is a raw format dump
|
||||
-- showing exactly what the table contains.
|
||||
|
||||
procedure pscos;
|
||||
-- Debugging procedure to output contents of SCO binary tables in the
|
||||
|
|
|
@ -23,9 +23,43 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Atree; use Atree;
|
||||
with SCOs; use SCOs;
|
||||
with Sinfo; use Sinfo;
|
||||
|
||||
procedure Put_SCOs is
|
||||
Ctr : Nat;
|
||||
|
||||
procedure Output_Range (T : SCO_Table_Entry);
|
||||
-- Outputs T.From and T.To in line:col-line:col format
|
||||
|
||||
procedure Output_Source_Location (Loc : Source_Location);
|
||||
-- Output source location in line:col format
|
||||
|
||||
------------------
|
||||
-- Output_Range --
|
||||
------------------
|
||||
|
||||
procedure Output_Range (T : SCO_Table_Entry) is
|
||||
begin
|
||||
Output_Source_Location (T.From);
|
||||
Write_Info_Char ('-');
|
||||
Output_Source_Location (T.To);
|
||||
end Output_Range;
|
||||
|
||||
----------------------------
|
||||
-- Output_Source_Location --
|
||||
----------------------------
|
||||
|
||||
procedure Output_Source_Location (Loc : Source_Location) is
|
||||
begin
|
||||
Write_Info_Nat (Nat (Loc.Line));
|
||||
Write_Info_Char (':');
|
||||
Write_Info_Nat (Nat (Loc.Col));
|
||||
end Output_Source_Location;
|
||||
|
||||
-- Start of processing for Put_SCOs
|
||||
|
||||
begin
|
||||
-- Loop through entries in SCO_Unit_Table
|
||||
|
||||
|
@ -64,35 +98,16 @@ begin
|
|||
Output_SCO_Line : declare
|
||||
T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
||||
|
||||
procedure Output_Range (T : SCO_Table_Entry);
|
||||
-- Outputs T.From and T.To in line:col-line:col format
|
||||
|
||||
------------------
|
||||
-- Output_Range --
|
||||
------------------
|
||||
|
||||
procedure Output_Range (T : SCO_Table_Entry) is
|
||||
begin
|
||||
Write_Info_Nat (Nat (T.From.Line));
|
||||
Write_Info_Char (':');
|
||||
Write_Info_Nat (Nat (T.From.Col));
|
||||
Write_Info_Char ('-');
|
||||
Write_Info_Nat (Nat (T.To.Line));
|
||||
Write_Info_Char (':');
|
||||
Write_Info_Nat (Nat (T.To.Col));
|
||||
end Output_Range;
|
||||
|
||||
-- Start of processing for Output_SCO_Line
|
||||
|
||||
begin
|
||||
Write_Info_Initiate ('C');
|
||||
Write_Info_Char (T.C1);
|
||||
|
||||
case T.C1 is
|
||||
|
||||
-- Statements
|
||||
|
||||
when 'S' =>
|
||||
Write_Info_Initiate ('C');
|
||||
Write_Info_Char ('S');
|
||||
|
||||
Ctr := 0;
|
||||
loop
|
||||
Write_Info_Char (' ');
|
||||
|
||||
|
@ -105,6 +120,18 @@ begin
|
|||
|
||||
Start := Start + 1;
|
||||
pragma Assert (SCO_Table.Table (Start).C1 = 's');
|
||||
|
||||
Ctr := Ctr + 1;
|
||||
|
||||
-- Up to 6 items on a line, if more than 6 items,
|
||||
-- continuation lines are marked Cs.
|
||||
|
||||
if Ctr = 6 then
|
||||
Write_Info_Terminate;
|
||||
Write_Info_Initiate ('C');
|
||||
Write_Info_Char ('s');
|
||||
Ctr := 0;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Statement continuations should not occur since they
|
||||
|
@ -116,25 +143,50 @@ begin
|
|||
-- Decision
|
||||
|
||||
when 'I' | 'E' | 'P' | 'W' | 'X' =>
|
||||
if T.C2 = ' ' then
|
||||
Start := Start + 1;
|
||||
|
||||
-- For disabled pragma, skip decision output. Note that
|
||||
-- if the SCO table has been populated by Get_SCOs
|
||||
-- (re-reading previously generated SCO information),
|
||||
-- then the Node field of pragma entries is Empty. This
|
||||
-- is the only way that Node can be Empty, so if we see
|
||||
-- an Empty node field, we know the pragma is enabled.
|
||||
|
||||
if T.C1 = 'P'
|
||||
and then Present (T.Node)
|
||||
and then not Pragma_Enabled (Original_Node (T.Node))
|
||||
then
|
||||
while not SCO_Table.Table (Start).Last loop
|
||||
Start := Start + 1;
|
||||
end loop;
|
||||
|
||||
-- For all other cases output decision line
|
||||
|
||||
else
|
||||
Write_Info_Initiate ('C');
|
||||
Write_Info_Char (T.C1);
|
||||
|
||||
if T.C1 /= 'X' then
|
||||
Write_Info_Char (' ');
|
||||
Output_Source_Location (T.From);
|
||||
end if;
|
||||
|
||||
-- Loop through table entries for this decision
|
||||
|
||||
loop
|
||||
declare
|
||||
T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
||||
T : SCO_Table_Entry
|
||||
renames SCO_Table.Table (Start);
|
||||
|
||||
begin
|
||||
Write_Info_Char (' ');
|
||||
|
||||
if T.C1 = '!' or else
|
||||
T.C1 = '^' or else
|
||||
T.C1 = '&' or else
|
||||
T.C1 = '|'
|
||||
then
|
||||
Write_Info_Char (T.C1);
|
||||
Output_Source_Location (T.From);
|
||||
|
||||
else
|
||||
Write_Info_Char (T.C2);
|
||||
|
@ -145,6 +197,7 @@ begin
|
|||
Start := Start + 1;
|
||||
end;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
|
|
|
@ -34,10 +34,11 @@ package body SCOs is
|
|||
To : Source_Location := No_Source_Location;
|
||||
C1 : Character := ' ';
|
||||
C2 : Character := ' ';
|
||||
Node : Node_Id := Empty;
|
||||
Last : Boolean := False)
|
||||
is
|
||||
begin
|
||||
SCO_Table.Append ((From, To, C1, C2, Last));
|
||||
SCO_Table.Append ((From, To, Node, C1, C2, Last));
|
||||
end Add_SCO;
|
||||
|
||||
----------------
|
||||
|
|
111
gcc/ada/scos.ads
111
gcc/ada/scos.ads
|
@ -148,21 +148,27 @@ package SCOs is
|
|||
-- o object declaration
|
||||
-- r renaming declaration
|
||||
-- i generic instantiation
|
||||
-- C CASE statement (includes only the expression)
|
||||
-- C CASE statement (from CASE through end of expression)
|
||||
-- E EXIT statement
|
||||
-- F FOR loop statement (includes only the iteration scheme)
|
||||
-- I IF statement (includes only the condition [in the RM sense, which
|
||||
-- is a decision in the SCO sense])
|
||||
-- F FOR loop statement (from FOR through end of iteration scheme)
|
||||
-- I IF statement (from IF through end of condition)
|
||||
-- P PRAGMA
|
||||
-- R extended RETURN statement
|
||||
-- W WHILE loop statement (includes only the condition)
|
||||
-- W WHILE loop statement (from WHILE through end of condition)
|
||||
|
||||
-- Note: for I and W, condition above is in the RM syntax sense (this
|
||||
-- condition is a decision in SCO terminology).
|
||||
|
||||
-- and is omitted for all other cases.
|
||||
|
||||
-- Note: up to 6 entries can appear on a single CS line. If more than 6
|
||||
-- entries appear in one logical statement sequence, continuation lines are
|
||||
-- marked by Cs and appear immediately after the CS line they continue.
|
||||
|
||||
-- Decisions
|
||||
|
||||
-- Note: in the following description, logical operator includes only the
|
||||
-- short circuited forms and NOT (so can be only NOT, AND THEN, OR ELSE).
|
||||
-- short-circuited forms and NOT (so can be only NOT, AND THEN, OR ELSE).
|
||||
-- The reason that we can exclude AND/OR/XOR is that we expect SCO's to
|
||||
-- be generated using the restriction No_Direct_Boolean_Operators if we
|
||||
-- are interested in decision coverage, which does not permit the use of
|
||||
|
@ -171,18 +177,27 @@ package SCOs is
|
|||
-- we are generating SCO's only for simple coverage, then we are not
|
||||
-- interested in decisions in any case.
|
||||
|
||||
-- Decisions are either simple or complex. A simple decision is a boolean
|
||||
-- expresssion that occurs in the context of a control structure in the
|
||||
-- source program, including WHILE, IF, EXIT WHEN, or in an Assert,
|
||||
-- Check, Pre_Condition or Post_Condition pragma. For pragmas, decision
|
||||
-- SCOs are generated only if the corresponding pragma is enabled. Note
|
||||
-- that a boolean expression in any other context, for example as right
|
||||
-- hand side of an assignment, is not considered to be a simple decision.
|
||||
-- Note: the reason we include NOT is for informational purposes. The
|
||||
-- presence of NOT does not generate additional coverage obligations,
|
||||
-- but if we know where the NOT's are, the coverage tool can generate
|
||||
-- more accurate diagnostics on uncovered tests.
|
||||
|
||||
-- A complex decision is an occurrence of a logical operator which is not
|
||||
-- itself an operand of some other logical operator. If any operand of
|
||||
-- the logical operator is itself a logical operator, this is not a
|
||||
-- separate decision, it is part of the same decision.
|
||||
-- A top level boolean expression is a boolean expression that is not an
|
||||
-- operand of a logical operator.
|
||||
|
||||
-- Decisions are either simple or complex. A simple decision is a top
|
||||
-- level boolean expresssion that has only one condition and that occurs
|
||||
-- in the context of a control structure in the source program, including
|
||||
-- WHILE, IF, EXIT WHEN, or in an Assert, Check, Pre_Condition or
|
||||
-- Post_Condition pragma. For pragmas, decision SCOs are generated only
|
||||
-- if the corresponding pragma is enabled. Note that a top level boolean
|
||||
-- expression with only one condition that occurs in any other context,
|
||||
-- for example as right hand side of an assignment, is not considered to
|
||||
-- be a (simple) decision.
|
||||
|
||||
-- A complex decision is a top level boolean expression that has more
|
||||
-- than one condition. A complex decision may occur in any boolean
|
||||
-- expression context.
|
||||
|
||||
-- So for example, if we have
|
||||
|
||||
|
@ -201,7 +216,7 @@ package SCOs is
|
|||
|
||||
-- For each decision, a decision line is generated with the form:
|
||||
|
||||
-- C*sloc expression
|
||||
-- C* sloc expression
|
||||
|
||||
-- Here * is one of the following characters:
|
||||
|
||||
|
@ -217,7 +232,7 @@ package SCOs is
|
|||
-- For X, sloc is omitted.
|
||||
|
||||
-- The expression is a prefix polish form indicating the structure of
|
||||
-- the decision, including logical operators and short circuit forms.
|
||||
-- the decision, including logical operators and short-circuit forms.
|
||||
-- The following is a grammar showing the structure of expression:
|
||||
|
||||
-- expression ::= term (if expr is not logical operator)
|
||||
|
@ -248,8 +263,14 @@ package SCOs is
|
|||
|
||||
-- ! indicates NOT applied to the expression.
|
||||
|
||||
-- In the context of Couverture, the No_Direct_Boolean_Opeartors
|
||||
-- restriction is assumed, and no other operator can appear.
|
||||
-- Note that complex decisions do NOT include non-short-circuited logical
|
||||
-- operators (AND/XOR/OR). In the context of existing coverage tools the
|
||||
-- No_Direct_Boolean_Operators restriction is assumed, so these operators
|
||||
-- cannot appear in the source in any case.
|
||||
|
||||
-- The SCO line for a decision always occurs after the CS line for the
|
||||
-- enclosing statement. The SCO line for a nested decision always occurs
|
||||
-- after the line for the enclosing decision.
|
||||
|
||||
---------------------------------------------------------------------
|
||||
-- Internal table used to store Source Coverage Obligations (SCOs) --
|
||||
|
@ -265,6 +286,7 @@ package SCOs is
|
|||
type SCO_Table_Entry is record
|
||||
From : Source_Location;
|
||||
To : Source_Location;
|
||||
Node : Node_Id;
|
||||
C1 : Character;
|
||||
C2 : Character;
|
||||
Last : Boolean;
|
||||
|
@ -284,27 +306,55 @@ package SCOs is
|
|||
-- C2 = statement type code to appear on CS line (or ' ' if none)
|
||||
-- From = starting source location
|
||||
-- To = ending source location
|
||||
-- Node = Empty
|
||||
-- Last = False for all but the last entry, True for last entry
|
||||
|
||||
-- Note: successive statements (possibly interspersed with entries of
|
||||
-- other kinds, that are ignored for this purpose), starting with one
|
||||
-- labeled with C1 = 'S', up to and including the first one labeled with
|
||||
-- Last=True, indicate the sequence to be output for a sequence of
|
||||
-- statements on a single CS line.
|
||||
-- Last = True, indicate the sequence to be output for a sequence of
|
||||
-- statements on a single CS line (possibly followed by Cs continuation
|
||||
-- lines).
|
||||
|
||||
-- Decision
|
||||
-- C1 = decision type code
|
||||
-- Decision (IF/EXIT/WHILE)
|
||||
-- C1 = 'I'/'E'/'W' (for IF/EXIT/WHILE)
|
||||
-- C2 = ' '
|
||||
-- From = location of IF/EXIT/PRAGMA/WHILE token,
|
||||
-- No_Source_Location for X
|
||||
-- From = IF/EXIT/WHILE token
|
||||
-- To = No_Source_Location
|
||||
-- Node = Empty
|
||||
-- Last = unused
|
||||
|
||||
-- Decision (PRAGMA)
|
||||
-- C1 = 'P'
|
||||
-- C2 = ' '
|
||||
-- From = PRAGMA token
|
||||
-- To = No_Source_Location
|
||||
-- Node = N_Pragma node or Empty when reading SCO data (see below)
|
||||
-- Last = unused
|
||||
|
||||
-- Note: when the parse tree is first scanned, we unconditionally build
|
||||
-- a pragma decision entry for any decision in a pragma (here as always
|
||||
-- in SCO contexts, the only relevant pragmas are Assert, Check,
|
||||
-- Precondition and Postcondition). Then when we output the SCO info
|
||||
-- to the ALI file, we use the Node field to check the Pragma_Enabled
|
||||
-- flag, and if it is False, we suppress output of the pragma decision
|
||||
-- line. On reading back SCO data from an ALI file, the Node field is
|
||||
-- always set to Empty.
|
||||
|
||||
-- Decision (Expression)
|
||||
-- C1 = 'X'
|
||||
-- C2 = ' '
|
||||
-- From = No_Source_Location
|
||||
-- To = No_Source_Location
|
||||
-- Node = Empty
|
||||
-- Last = unused
|
||||
|
||||
-- Operator
|
||||
-- C1 = '!', '^', '&', '|'
|
||||
-- C1 = '!', '&', '|'
|
||||
-- C2 = ' '
|
||||
-- From = location of NOT/AND/OR token
|
||||
-- To = No_Source_Location
|
||||
-- Node = Empty
|
||||
-- Last = False
|
||||
|
||||
-- Element (condition)
|
||||
|
@ -312,12 +362,12 @@ package SCOs is
|
|||
-- C2 = 'c', 't', or 'f' (condition/true/false)
|
||||
-- From = starting source location
|
||||
-- To = ending source location
|
||||
-- Node = Empty
|
||||
-- Last = False for all but the last entry, True for last entry
|
||||
|
||||
-- Note: the sequence starting with a decision, and continuing with
|
||||
-- operators and elements up to and including the first one labeled with
|
||||
-- Last = True, indicate the sequence to be output for a complex decision
|
||||
-- on a single CD decision line.
|
||||
-- Last = True, indicate the sequence to be output on one decision line.
|
||||
|
||||
----------------
|
||||
-- Unit Table --
|
||||
|
@ -365,6 +415,7 @@ package SCOs is
|
|||
To : Source_Location := No_Source_Location;
|
||||
C1 : Character := ' ';
|
||||
C2 : Character := ' ';
|
||||
Node : Node_Id := Empty;
|
||||
Last : Boolean := False);
|
||||
-- Adds one entry to SCO table with given field values
|
||||
|
||||
|
|
|
@ -3507,26 +3507,16 @@ package body Sem_Warn is
|
|||
and then Is_Known_Branch
|
||||
then
|
||||
declare
|
||||
Start : Source_Ptr;
|
||||
Dummy : Source_Ptr;
|
||||
Typ : Character;
|
||||
Atrue : Boolean;
|
||||
|
||||
begin
|
||||
Sloc_Range (Orig, Start, Dummy);
|
||||
Atrue := Test_Result;
|
||||
|
||||
if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not then
|
||||
Atrue := not Atrue;
|
||||
end if;
|
||||
|
||||
if Atrue then
|
||||
Typ := 't';
|
||||
else
|
||||
Typ := 'f';
|
||||
end if;
|
||||
|
||||
Set_SCO_Condition (Start, Typ);
|
||||
Set_SCO_Condition (Orig, Atrue);
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
|
Loading…
Reference in New Issue