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

	* par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record
	pragma name for each SCO statement corresponding to a pragma.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178164 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 156 insertions, 104 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9379a1cb7a4..971cb8f1fb3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record
+	pragma name for each SCO statement corresponding to a pragma.
+
 2011-08-29  Arnaud Charlet  <charlet@adacore.com>
 
 	* opt.ads: Minor editing.
diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb
index b8e2560a98c..1cc0706cec6 100644
--- a/gcc/ada/get_scos.adb
+++ b/gcc/ada/get_scos.adb
@@ -23,8 +23,11 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with SCOs;  use SCOs;
-with Types; use Types;
+pragma Ada_2005;
+
+with SCOs;   use SCOs;
+with Snames; use Snames;
+with Types;  use Types;
 
 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
 
@@ -193,6 +196,10 @@ procedure Get_SCOs is
       end loop;
    end Skip_Spaces;
 
+   Buf : String (1 .. 32_768);
+   N   : Natural;
+   --  Scratch buffer, and index into it
+
 --  Start of processing for Get_Scos
 
 begin
@@ -228,32 +235,24 @@ begin
 
             --  Scan out dependency number and file name
 
-            declare
-               Ptr : String_Ptr := new String (1 .. 32768);
-               N   : Integer;
-
-            begin
-               Skip_Spaces;
-               Dnum := Get_Int;
-
-               Skip_Spaces;
+            Skip_Spaces;
+            Dnum := Get_Int;
 
-               N := 0;
-               while Nextc > ' ' loop
-                  N := N + 1;
-                  Ptr.all (N) := Getc;
-               end loop;
+            Skip_Spaces;
 
-               --  Make new unit table entry (will fill in To later)
+            N := 0;
+            while Nextc > ' ' loop
+               N := N + 1;
+               Buf (N) := Getc;
+            end loop;
 
-               SCO_Unit_Table.Append (
-                 (File_Name => new String'(Ptr.all (1 .. N)),
-                  Dep_Num   => Dnum,
-                  From      => SCO_Table.Last + 1,
-                  To        => 0));
+            --  Make new unit table entry (will fill in To later)
 
-               Free (Ptr);
-            end;
+            SCO_Unit_Table.Append (
+              (File_Name => new String'(Buf (1 .. N)),
+               Dep_Num   => Dnum,
+               From      => SCO_Table.Last + 1,
+               To        => 0));
 
          --  Statement entry
 
@@ -261,6 +260,7 @@ begin
             declare
                Typ : Character;
                Key : Character;
+               Pid : Pragma_Id;
 
             begin
                --  If continuation, reset Last indication in last entry
@@ -290,16 +290,33 @@ begin
                      Typ := ' ';
                   else
                      Skipc;
+                     if Typ = 'P' and then Nextc not in '1' .. '9' then
+                        N := 1;
+                        loop
+                           Buf (N) := Getc;
+                           exit when Nextc = ':';
+                           N := N + 1;
+                        end loop;
+                        begin
+                           Pid := Pragma_Id'Value (Buf (1 .. N));
+                        exception
+                           when Constraint_Error =>
+                              Pid := Unknown_Pragma;
+                        end;
+                        Skipc;
+                     end if;
                   end if;
 
                   Get_Source_Location_Range (Loc1, Loc2);
 
-                  Add_SCO
-                    (C1   => Key,
-                     C2   => Typ,
-                     From => Loc1,
-                     To   => Loc2,
-                     Last => At_EOL);
+                  SCO_Table.Append
+                    ((C1          => Key,
+                      C2          => Typ,
+                      From        => Loc1,
+                      To          => Loc2,
+                      Last        => At_EOL,
+                      Pragma_Sloc => No_Location,
+                      Pragma_Name => Pid));
 
                   exit when At_EOL;
                   Key := 's';
@@ -326,12 +343,13 @@ begin
                   Get_Source_Location (Loc);
                end if;
 
-               Add_SCO
-                 (C1   => Dtyp,
-                  C2   => ' ',
-                  From => Loc,
-                  To   => No_Source_Location,
-                  Last => False);
+               SCO_Table.Append
+                 ((C1     => Dtyp,
+                   C2     => ' ',
+                   From   => Loc,
+                   To     => No_Source_Location,
+                   Last   => False,
+                   others => <>));
             end;
 
             --  Loop through terms in complex expression
@@ -342,11 +360,12 @@ begin
                   Cond := C;
                   Skipc;
                   Get_Source_Location_Range (Loc1, Loc2);
-                  Add_SCO
-                    (C2   => Cond,
-                     From => Loc1,
-                     To   => Loc2,
-                     Last => False);
+                  SCO_Table.Append
+                    ((C2     => Cond,
+                      From   => Loc1,
+                      To     => Loc2,
+                      Last   => False,
+                      others => <>));
 
                elsif C = '!' or else
                      C = '&' or else
@@ -358,7 +377,11 @@ begin
                      Loc : Source_Location;
                   begin
                      Get_Source_Location (Loc);
-                     Add_SCO (C1 => C, From => Loc, Last => False);
+                     SCO_Table.Append
+                       ((C1     => C,
+                         From   => Loc,
+                         Last   => False,
+                         others => <>));
                   end;
 
                elsif C = ' ' then
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index c2aab468f98..29ae2ef2fa2 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -124,7 +124,8 @@ package body Par_SCO is
       From        : Source_Ptr;
       To          : Source_Ptr;
       Last        : Boolean;
-      Pragma_Sloc : Source_Ptr := No_Location);
+      Pragma_Sloc : Source_Ptr := No_Location;
+      Pragma_Name : Pragma_Id  := Unknown_Pragma);
    --  Append an entry to SCO_Table with fields set as per arguments
 
    procedure Traverse_Declarations_Or_Statements  (L : List_Id);
@@ -916,7 +917,8 @@ package body Par_SCO is
       From        : Source_Ptr;
       To          : Source_Ptr;
       Last        : Boolean;
-      Pragma_Sloc : Source_Ptr := No_Location)
+      Pragma_Sloc : Source_Ptr := No_Location;
+      Pragma_Name : Pragma_Id  := Unknown_Pragma)
    is
       function To_Source_Location (S : Source_Ptr) return Source_Location;
       --  Converts Source_Ptr value to Source_Location (line/col) format
@@ -939,13 +941,14 @@ package body Par_SCO is
    --  Start of processing for Set_Table_Entry
 
    begin
-      Add_SCO
-        (C1          => C1,
-         C2          => C2,
-         From        => To_Source_Location (From),
-         To          => To_Source_Location (To),
-         Last        => Last,
-         Pragma_Sloc => Pragma_Sloc);
+      SCO_Table.Append
+        ((C1          => C1,
+          C2          => C2,
+          From        => To_Source_Location (From),
+          To          => To_Source_Location (To),
+          Last        => Last,
+          Pragma_Sloc => Pragma_Sloc,
+          Pragma_Name => Pragma_Name));
    end Set_Table_Entry;
 
    -----------------------------------------
@@ -957,6 +960,7 @@ package body Par_SCO is
    --  since they are shared by recursive calls to this procedure.
 
    type SC_Entry is record
+      N    : Node_Id;
       From : Source_Ptr;
       To   : Source_Ptr;
       Typ  : Character;
@@ -1080,6 +1084,7 @@ package body Par_SCO is
             declare
                SCE         : SC_Entry renames SC.Table (J);
                Pragma_Sloc : Source_Ptr := No_Location;
+               Pragma_Name : Pragma_Id  := Unknown_Pragma;
             begin
                --  For the case of a statement SCO for a pragma controlled by
                --  Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
@@ -1090,6 +1095,10 @@ package body Par_SCO is
                   Pragma_Sloc := SCE.From;
                   Condition_Pragma_Hash_Table.Set
                     (Pragma_Sloc, SCO_Table.Last + 1);
+                  Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
+
+               elsif SCE.Typ = 'P' then
+                  Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
                end if;
 
                Set_Table_Entry
@@ -1098,7 +1107,8 @@ package body Par_SCO is
                   From        => SCE.From,
                   To          => SCE.To,
                   Last        => (J = SC_Last),
-                  Pragma_Sloc => Pragma_Sloc);
+                  Pragma_Sloc => Pragma_Sloc,
+                  Pragma_Name => Pragma_Name);
             end;
          end loop;
 
@@ -1134,7 +1144,7 @@ package body Par_SCO is
          T : Source_Ptr;
       begin
          Sloc_Range (N, F, T);
-         SC.Append ((F, T, Typ));
+         SC.Append ((N, F, T, Typ));
       end Extend_Statement_Sequence;
 
       procedure Extend_Statement_Sequence
@@ -1147,7 +1157,7 @@ package body Par_SCO is
       begin
          Sloc_Range (From, F, Dummy);
          Sloc_Range (To, Dummy, T);
-         SC.Append ((F, T, Typ));
+         SC.Append ((From, F, T, Typ));
       end Extend_Statement_Sequence;
 
       -----------------------------
diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb
index a1b3f231564..95c4609a9a3 100644
--- a/gcc/ada/put_scos.adb
+++ b/gcc/ada/put_scos.adb
@@ -25,6 +25,7 @@
 
 with Par_SCO; use Par_SCO;
 with SCOs;    use SCOs;
+with Snames;  use Snames;
 
 procedure Put_SCOs is
    Ctr : Nat;
@@ -35,6 +36,9 @@ procedure Put_SCOs is
    procedure Output_Source_Location (Loc : Source_Location);
    --  Output source location in line:col format
 
+   procedure Output_String (S : String);
+   --  Output S
+
    ------------------
    -- Output_Range --
    ------------------
@@ -57,6 +61,17 @@ procedure Put_SCOs is
       Write_Info_Nat  (Nat (Loc.Col));
    end Output_Source_Location;
 
+   -------------------
+   -- Output_String --
+   -------------------
+
+   procedure Output_String (S : String) is
+   begin
+      for J in S'Range loop
+         Write_Info_Char (S (J));
+      end loop;
+   end Output_String;
+
 --  Start of processing for Put_SCOs
 
 begin
@@ -81,9 +96,7 @@ begin
             Write_Info_Nat (SUT.Dep_Num);
             Write_Info_Char (' ');
 
-            for N in SUT.File_Name'Range loop
-               Write_Info_Char (SUT.File_Name (N));
-            end loop;
+            Output_String (SUT.File_Name.all);
 
             Write_Info_Terminate;
          end if;
@@ -125,11 +138,30 @@ begin
 
                         Write_Info_Char (' ');
 
-                        if SCO_Table.Table (Start).C2 /= ' ' then
-                           Write_Info_Char (SCO_Table.Table (Start).C2);
-                        end if;
+                        declare
+                           Sent : SCO_Table_Entry
+                                    renames SCO_Table.Table (Start);
+                        begin
+                           if Sent.C2 /= ' ' then
+                              Write_Info_Char (Sent.C2);
+                              if Sent.C2 = 'P'
+                                   and then Sent.Pragma_Name /= Unknown_Pragma
+                              then
+                                 declare
+                                    Pnam : constant String :=
+                                             Sent.Pragma_Name'Img;
+                                 begin
+                                    --  Strip leading "PRAGMA_"
+
+                                    Output_String
+                                      (Pnam (Pnam'First + 7 .. Pnam'Last));
+                                    Write_Info_Char (':');
+                                 end;
+                              end if;
+                           end if;
 
-                        Output_Range (SCO_Table.Table (Start));
+                           Output_Range (Sent);
+                        end;
 
                         --  Increment entry counter (up to 6 entries per line,
                         --  continuation lines are marked Cs).
diff --git a/gcc/ada/scos.adb b/gcc/ada/scos.adb
index a45f3d88467..b7df692de3a 100644
--- a/gcc/ada/scos.adb
+++ b/gcc/ada/scos.adb
@@ -25,22 +25,6 @@
 
 package body SCOs is
 
-   -------------
-   -- Add_SCO --
-   -------------
-
-   procedure Add_SCO
-     (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, Pragma_Sloc));
-   end Add_SCO;
-
    ----------------
    -- Initialize --
    ----------------
diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads
index d8ab7a82b2b..7c0bb820d54 100644
--- a/gcc/ada/scos.ads
+++ b/gcc/ada/scos.ads
@@ -28,7 +28,11 @@
 --  the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
 --  is used in the ALI file.
 
-with Types; use Types;
+with Snames; use Snames;
+--  Note: used for Pragma_Id only, no other feature from Snames should be used,
+--  as a simplified version is maintained in Xcov.
+
+with Types;  use Types;
 
 with GNAT.Table;
 
@@ -143,18 +147,18 @@ package SCOs is
    --    where each sloc-range corresponds to a single statement, and * is
    --    one of:
 
-   --      t  type declaration
-   --      s  subtype declaration
-   --      o  object declaration
-   --      r  renaming declaration
-   --      i  generic instantiation
-   --      C  CASE statement (from CASE through end of expression)
-   --      E  EXIT statement
-   --      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 (from WHILE through end of condition)
+   --      t        type declaration
+   --      s        subtype declaration
+   --      o        object declaration
+   --      r        renaming declaration
+   --      i        generic instantiation
+   --      C        CASE statement (from CASE through end of expression)
+   --      E        EXIT statement
+   --      F        FOR loop (from FOR through end of iteration scheme)
+   --      I        IF statement (from IF through end of condition)
+   --      P[name:] PRAGMA with the indicated name
+   --      R        extended RETURN statement
+   --      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).
@@ -352,16 +356,19 @@ package SCOs is
    No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
 
    type SCO_Table_Entry is record
-      From : Source_Location;
-      To   : Source_Location;
-      C1   : Character;
-      C2   : Character;
-      Last : Boolean;
+      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;
       --  For the statement SCO for a pragma, or for any expression SCO nested
       --  in a pragma Debug/Assert/PPC, location of PRAGMA token (used for
       --  control of SCO output, value not recorded in ALI file).
+
+      Pragma_Name : Pragma_Id := Unknown_Pragma;
+      --  For the statement SCO for a pragma, gives the pragma name
    end record;
 
    package SCO_Table is new GNAT.Table (
@@ -486,13 +493,4 @@ package SCOs is
    procedure Initialize;
    --  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;
-      Pragma_Sloc : Source_Ptr      := No_Location);
-   --  Adds one entry to SCO table with given field values
-
 end SCOs;