From c2873f74238f63398915693078adc7ccc7698828 Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Thu, 4 Aug 2011 09:48:09 +0000 Subject: [PATCH] put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision nested in a disabled pragma. 2011-08-04 Thomas Quinot * put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision nested in a disabled pragma. * scos.ads, scos.adb, par_sco.ads, par_sco.adb: Record sloc of enclosing pragma, if any, for X decisions. 2011-08-04 Thomas Quinot * sem_prag.adb: Minor reformatting. From-SVN: r177347 --- gcc/ada/ChangeLog | 11 ++++++ gcc/ada/par_sco.adb | 86 ++++++++++++++++++++++++++++++++------------ gcc/ada/par_sco.ads | 5 ++- gcc/ada/put_scos.adb | 11 ++++-- gcc/ada/scos.adb | 15 ++++---- gcc/ada/scos.ads | 15 +++++--- gcc/ada/sem_prag.adb | 6 ++-- 7 files changed, 108 insertions(+), 41 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3ce6f2cd786..402aec6ef0a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2011-08-04 Thomas Quinot + + * put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision + nested in a disabled pragma. + * scos.ads, scos.adb, par_sco.ads, par_sco.adb: Record sloc of + enclosing pragma, if any, for X decisions. + +2011-08-04 Thomas Quinot + + * sem_prag.adb: Minor reformatting. + 2011-08-04 Vincent Celier * a-tags.adb (Check_TSD): Avoid concatenation of strings, as it is not diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index f42300ada1f..811e0e02a2e 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -113,11 +113,12 @@ package body Par_SCO is -- Calls above procedure for each element of the list L procedure Set_Table_Entry - (C1 : Character; - C2 : Character; - From : Source_Ptr; - To : Source_Ptr; - Last : Boolean); + (C1 : Character; + C2 : Character; + From : Source_Ptr; + To : Source_Ptr; + Last : Boolean; + Pragma_Sloc : Source_Ptr := No_Location); -- Append an entry to SCO_Table with fields set as per arguments procedure Traverse_Declarations_Or_Statements (L : List_Id); @@ -329,8 +330,11 @@ package body Par_SCO is -- Version taking a node - procedure Process_Decisions (N : Node_Id; T : Character) is + Pragma_Sloc : Source_Ptr := No_Location; + -- While processing decisions within a pragma Assert/Debug/PPC, this is set + -- to the sloc of the pragma. + 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 @@ -462,6 +466,11 @@ package body Par_SCO is Loc := Sloc (Parent (Parent (N))); + -- Record sloc of pragma (pragmas don't nest) + + pragma Assert (Pragma_Sloc = No_Location); + Pragma_Sloc := Loc; + when 'X' => -- For an expression, no Sloc @@ -475,11 +484,12 @@ package body Par_SCO is end case; Set_Table_Entry - (C1 => T, - C2 => ' ', - From => Loc, - To => No_Location, - Last => False); + (C1 => T, + C2 => ' ', + From => Loc, + To => No_Location, + Last => False, + Pragma_Sloc => Pragma_Sloc); if T = 'P' then @@ -491,7 +501,6 @@ package body Par_SCO is SCO_Table.Table (SCO_Table.Last).C2 := 'd'; Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last); end if; - end Output_Header; ------------------------------ @@ -623,6 +632,12 @@ package body Par_SCO is end if; Traverse (N); + + -- Reset Pragma_Sloc after full subtree traversal + + if T = 'P' then + Pragma_Sloc := No_Location; + end if; end Process_Decisions; ----------- @@ -733,6 +748,31 @@ package body Par_SCO is Write_SCOs_To_ALI_File; end SCO_Output; + ------------------------- + -- SCO_Pragma_Disabled -- + ------------------------- + + function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean is + Index : Nat; + + begin + if Loc = No_Location then + return False; + end if; + + Index := Condition_Pragma_Hash_Table.Get (Loc); + + -- The test here for zero is to deal with possible previous errors + + if Index /= 0 then + pragma Assert (SCO_Table.Table (Index).C1 = 'P'); + return SCO_Table.Table (Index).C2 = 'd'; + + else + return False; + end if; + end SCO_Pragma_Disabled; + ---------------- -- SCO_Record -- ---------------- @@ -863,11 +903,12 @@ package body Par_SCO is --------------------- procedure Set_Table_Entry - (C1 : Character; - C2 : Character; - From : Source_Ptr; - To : Source_Ptr; - Last : Boolean) + (C1 : Character; + C2 : Character; + From : Source_Ptr; + To : Source_Ptr; + Last : Boolean; + Pragma_Sloc : Source_Ptr := No_Location) is function To_Source_Location (S : Source_Ptr) return Source_Location; -- Converts Source_Ptr value to Source_Location (line/col) format @@ -891,11 +932,12 @@ package body Par_SCO is begin Add_SCO - (C1 => C1, - C2 => C2, - From => To_Source_Location (From), - To => To_Source_Location (To), - Last => Last); + (C1 => C1, + C2 => C2, + From => To_Source_Location (From), + To => To_Source_Location (To), + Last => Last, + Pragma_Sloc => Pragma_Sloc); end Set_Table_Entry; ----------------------------------------- diff --git a/gcc/ada/par_sco.ads b/gcc/ada/par_sco.ads index 97e4a6a61af..170406dd2c7 100644 --- a/gcc/ada/par_sco.ads +++ b/gcc/ada/par_sco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -57,6 +57,9 @@ package Par_SCO is -- analysis is on a copy of the node, which is different from the node -- seen by Par_SCO in the parse tree (but the Sloc values are the same). + function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean; + -- True if Loc is the source location of a disabled pragma + procedure SCO_Output; -- Outputs SCO lines for all units, with appropriate section headers, for -- unit U in the ALI file, as recorded by previous calls to SCO_Record, diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 6154abb6dce..b71652372ee 100644 --- a/gcc/ada/put_scos.adb +++ b/gcc/ada/put_scos.adb @@ -23,7 +23,8 @@ -- -- ------------------------------------------------------------------------------ -with SCOs; use SCOs; +with Par_SCO; use Par_SCO; +with SCOs; use SCOs; procedure Put_SCOs is Ctr : Nat; @@ -145,9 +146,13 @@ begin when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' => Start := Start + 1; - -- For disabled pragma, skip decision output + -- For disabled pragma, or nested decision nested, skip + -- decision output. - if T.C1 = 'P' and then T.C2 = 'd' then + if (T.C1 = 'P' and then T.C2 = 'd') + or else + SCO_Pragma_Disabled (T.Pragma_Sloc) + then while not SCO_Table.Table (Start).Last loop Start := Start + 1; end loop; diff --git a/gcc/ada/scos.adb b/gcc/ada/scos.adb index c559e6f8dc4..a45f3d88467 100644 --- a/gcc/ada/scos.adb +++ b/gcc/ada/scos.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,14 +30,15 @@ package body SCOs is ------------- procedure Add_SCO - (From : Source_Location := No_Source_Location; - To : Source_Location := No_Source_Location; - C1 : Character := ' '; - C2 : Character := ' '; - Last : Boolean := False) + (From : Source_Location := No_Source_Location; + To : Source_Location := No_Source_Location; + C1 : Character := ' '; + C2 : Character := ' '; + Last : Boolean := False; + Pragma_Sloc : Source_Ptr := No_Location) is begin - SCO_Table.Append ((From, To, C1, C2, Last)); + SCO_Table.Append ((From, To, C1, C2, Last, Pragma_Sloc)); end Add_SCO; ---------------- diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index ea16370fc2c..4039e4e541d 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -353,6 +353,10 @@ package SCOs is C1 : Character; C2 : Character; Last : Boolean; + + Pragma_Sloc : Source_Ptr := No_Location; + -- For a SCO nested with a pragma Debug/Assert/PPC, location of pragma + -- (used for control of SCO output, value not recorded in ALI file). end record; package SCO_Table is new GNAT.Table ( @@ -477,11 +481,12 @@ package SCOs is -- Reset tables for a new compilation procedure Add_SCO - (From : Source_Location := No_Source_Location; - To : Source_Location := No_Source_Location; - C1 : Character := ' '; - C2 : Character := ' '; - Last : Boolean := False); + (From : Source_Location := No_Source_Location; + To : Source_Location := No_Source_Location; + C1 : Character := ' '; + C2 : Character := ' '; + Last : Boolean := False; + Pragma_Sloc : Source_Ptr := No_Location); -- Adds one entry to SCO table with given field values end SCOs; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 13a63870766..1dd2f58ea64 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1700,7 +1700,7 @@ package body Sem_Prag is return; end Chain_PPC; - -- Start of processing for Check_Precondition_Postcondition + -- Start of processing for Check_Precondition_Postcondition begin if not Is_List_Member (N) then @@ -6713,11 +6713,11 @@ package body Sem_Prag is -- cause insertion of actions that would escape the attempt to -- suppress the check code. - -- Note that the Sloc for the if statement corresponds to the + -- Note that the Sloc for the IF statement corresponds to the -- argument condition, not the pragma itself. The reason for this -- is that we may generate a warning if the condition is False at -- compile time, and we do not want to delete this warning when we - -- delete the if statement. + -- delete the IF statement. Expr := Get_Pragma_Arg (Arg2); -- 2.30.2