OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Arnaud Charlet 2010-06-16 16:30:48 +00:00 committed by Arnaud Charlet
parent e1578ff354
commit 25adc5fbf5
9 changed files with 781 additions and 489 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -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

111
gcc/ada/exp_ch4.adb
View File

@ -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.

160
gcc/ada/get_scos.adb
View File

@ -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 --
--------------
@ -222,8 +228,8 @@ begin
-- Scan out dependency number and file name
declare
Ptr : String_Ptr := new String (1 .. 32768);
N : Integer;
Ptr : String_Ptr := new String (1 .. 32768);
N : Integer;
begin
Skip_Spaces;
@ -250,14 +256,31 @@ begin
-- Statement entry
when 'S' =>
when 'S' | 's' =>
declare
Typ : Character;
Key : Character;
begin
-- 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;
Key := 'S';
-- 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,60 +310,71 @@ 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);
C2 => ' ',
From => Loc,
To => No_Source_Location,
Last => False);
end;
-- Complex expression
-- Loop through terms in complex expression
else
Add_SCO (C1 => Dtyp, Last => False);
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_Source_Location_Range (Loc1, Loc2);
Add_SCO
(C2 => Cond,
From => Loc1,
To => Loc2,
Last => False);
-- Loop through terms in complex expression
elsif C = '!' or else
C = '&' or else
C = '|'
then
Skipc;
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);
Add_SCO
(C2 => Cond,
From => Loc1,
To => Loc2,
Last => False);
declare
Loc : Source_Location;
begin
Get_Source_Location (Loc);
Add_SCO (C1 => C, From => Loc, Last => False);
end;
elsif C = '!' or else
C = '^' or else
C = '&' or else
C = '|'
then
Skipc;
Add_SCO (C1 => C, Last => False);
elsif C = ' ' then
Skip_Spaces;
elsif C = ' ' then
Skip_Spaces;
else
raise Data_Error;
end if;
else
raise Data_Error;
end if;
C := Nextc;
end loop;
C := Nextc;
end loop;
-- Reset Last indication to True for last entry
-- Reset Last indication to True for last entry
SCO_Table.Table (SCO_Table.Last).Last := True;
SCO_Table.Table (SCO_Table.Last).Last := True;
end if;
-- No other SCO lines are possible
when others =>
raise Data_Error;

556
gcc/ada/par_sco.adb
View File

@ -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));
@ -439,9 +529,9 @@ package body Par_SCO is
-- 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;
@ -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.
SCO_Table.Table (SCO_Table.Last).Last := True;
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
@ -476,7 +577,7 @@ package body Par_SCO is
-- Conditional expression, processed like an if statement
when N_Conditional_Expression =>
when N_Conditional_Expression =>
declare
Cond : constant Node_Id := First (Expressions (N));
Thnx : constant Node_Id := Next (Cond);
@ -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 --
-----------------------------------------
-- 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 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.
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
-- entry stored, so the current statement sequence is represented
-- 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;
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
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
-- 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.
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;
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
C1 := 'S';
else
C1 := 's';
end if;
-- 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 loop;
end;
end loop;
SC_Last := 0;
end if;
-- 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;
Extend_Statement_Sequence
(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 ???
case Pragma_Name (N) is
when Name_Assert |
Name_Check |
Name_Precondition |
Name_Postcondition =>
-- For all other pragmas, we always generate decision
-- entries for any embedded expressions.
-- 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
case Nam is
when Name_Assert |
Name_Check |
Name_Precondition |
Name_Postcondition =>
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;
when others =>
Process_Decisions (N, 'X');
end case;
end;
-- For all other pragmas, we generate decision entries
-- for any embedded expressions.
when others =>
Process_Decisions_Defer (N, 'X');
end case;
-- 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;

158
gcc/ada/par_sco.ads
View File

@ -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

153
gcc/ada/put_scos.adb
View File

@ -23,9 +23,43 @@
-- --
------------------------------------------------------------------------------
with SCOs; use SCOs;
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,35 +143,61 @@ begin
-- Decision
when 'I' | 'E' | 'P' | 'W' | 'X' =>
if T.C2 = ' ' then
Start := Start + 1;
end if;
Start := Start + 1;
-- Loop through table entries for this decision
-- 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.
loop
declare
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);
else
Write_Info_Char (T.C2);
Output_Range (T);
end if;
exit when T.Last;
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;
end loop;
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);
begin
Write_Info_Char (' ');
if 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);
Output_Range (T);
end if;
exit when T.Last;
Start := Start + 1;
end;
end loop;
end if;
when others =>
raise Program_Error;

3
gcc/ada/scos.adb
View File

@ -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
View File

@ -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

12
gcc/ada/sem_warn.adb
View File

@ -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;