From 25adc5fbf5c9ac211442106de78cba432212449c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 16 Jun 2010 16:30:48 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 6 + gcc/ada/exp_ch4.adb | 111 ++++++--- gcc/ada/get_scos.adb | 160 ++++++++----- gcc/ada/par_sco.adb | 556 +++++++++++++++++++++++++++++++------------ gcc/ada/par_sco.ads | 158 +----------- gcc/ada/put_scos.adb | 153 ++++++++---- gcc/ada/scos.adb | 3 +- gcc/ada/scos.ads | 111 ++++++--- gcc/ada/sem_warn.adb | 12 +- 9 files changed, 781 insertions(+), 489 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 83f82c61c33..a6243129b82 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2010-06-16 Arnaud Charlet + + * 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 * exp_disp.adb (Expand_Dispatching_Call): Adjust the decoration of the diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e66a063a4c1..6846b75c64d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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. diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index da63f90e307..04fbd51db46 100644 --- a/gcc/ada/get_scos.adb +++ b/gcc/ada/get_scos.adb @@ -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; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 82ab9d651a0..5b5e4cf4d49 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -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; diff --git a/gcc/ada/par_sco.ads b/gcc/ada/par_sco.ads index 6cb68a71441..9bbe04ffee0 100644 --- a/gcc/ada/par_sco.ads +++ b/gcc/ada/par_sco.ads @@ -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 diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 39b6288520e..53962b2545a 100644 --- a/gcc/ada/put_scos.adb +++ b/gcc/ada/put_scos.adb @@ -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; diff --git a/gcc/ada/scos.adb b/gcc/ada/scos.adb index c559e6f8dc4..3c0caeec2d0 100644 --- a/gcc/ada/scos.adb +++ b/gcc/ada/scos.adb @@ -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; ---------------- diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 19804e4567b..9e6a973a0cd 100644 --- a/gcc/ada/scos.ads +++ b/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 diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 7fc0804fcf3..7a5414fe879 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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;