put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision nested in a disabled pragma.

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* 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  <quinot@adacore.com>

	* sem_prag.adb: Minor reformatting.

From-SVN: r177347

7 files changed, 108 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3ce6f2c..402aec6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2011-08-04  Thomas Quinot  <quinot@adacore.com>
+
+	* 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  <quinot@adacore.com>
+
+	* sem_prag.adb: Minor reformatting.
+
 2011-08-04  Vincent Celier  <celier@adacore.com>
 
 	* 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 f42300a..811e0e0 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 97e4a6a..170406d 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 6154abb..b716523 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 c559e6f..a45f3d8 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 ea16370..4039e4e 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 13a6387..1dd2f58 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);