2010-01-26 Robert Dewar <dewar@adacore.com>

	* par_sco.adb (Traverse_Declarations_Or_Statements): Only generate
	decisions for pragmas Assert, Check, Precondition, Postcondition if
	-gnata set.
	* scos.ads: Update comments.
	* get_scos.adb, put_scos.adb: Minor fix to code reading statement SCOs.
	Also remove obsolete code for CT (exit point) SCOs.

2010-01-26  Thomas Quinot  <quinot@adacore.com>

	* switch-c.adb: Fix handling of -gnatz*



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

10 files changed, 118 insertions, 56 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0cb26f2e40b..2b501289020 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,18 @@
 2010-01-26  Robert Dewar  <dewar@adacore.com>
 
+	* par_sco.adb (Traverse_Declarations_Or_Statements): Only generate
+	decisions for pragmas Assert, Check, Precondition, Postcondition if
+	-gnata set.
+	* scos.ads: Update comments.
+	* get_scos.adb, put_scos.adb: Minor fix to code reading statement SCOs.
+	Also remove obsolete code for CT (exit point) SCOs.
+
+2010-01-26  Thomas Quinot  <quinot@adacore.com>
+
+	* switch-c.adb: Fix handling of -gnatz*
+
+2010-01-26  Robert Dewar  <dewar@adacore.com>
+
 	* par_sco.adb (Traverse_Declarations_Or_Statements): Separate F/W
 	qualifiers for FOR/WHILE loops
 	* scos.ads: Use separate type letters F/W for for/while loops
diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb
index 5dd33f4bbf1..da63f90e307 100644
--- a/gcc/ada/get_scos.adb
+++ b/gcc/ada/get_scos.adb
@@ -272,7 +272,7 @@ begin
 
                   Add_SCO
                     (C1   => Key,
-                     C2   => C,
+                     C2   => Typ,
                      From => Loc1,
                      To   => Loc2,
                      Last => At_EOL);
@@ -282,15 +282,9 @@ begin
                end loop;
             end;
 
-         --  Exit entry
-
-         when 'T' =>
-            Get_Sloc_Range (Loc1, Loc2);
-            Add_SCO (C1 => 'T', From => Loc1, To => Loc2);
-
          --  Decision entry
 
-         when 'I' | 'E' | 'W' | 'X' =>
+         when 'I' | 'E' | 'P' | 'W' | 'X' =>
             Dtyp := C;
             Skip_Spaces;
             C := Getc;
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index e9ed4b3a51c..82ab9d651a0 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -35,6 +35,7 @@ with Put_SCOs;
 with SCOs;     use SCOs;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
+with Snames;   use Snames;
 with Table;
 
 with GNAT.HTable;      use GNAT.HTable;
@@ -101,10 +102,10 @@ package body Par_SCO is
 
    procedure Process_Decisions (N : Node_Id; T : Character);
    --  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 IEWX (for context of
-   --  expresion: if/while/when-exit/expression). If T is other than X, then
-   --  the node is always a decision a decision is always present (at the very
-   --  least a simple decision is present at the top level).
+   --  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).
 
    procedure Process_Decisions (L : List_Id; T : Character);
    --  Calls above procedure for each element of the list L
@@ -938,7 +939,7 @@ package body Par_SCO is
                --  any decisions in the exit statement expression.
 
                when N_Exit_Statement =>
-                  Extend_Statement_Sequence (N, 'E');
+                  Extend_Statement_Sequence (N, ' ');
                   Set_Statement_Entry;
                   Process_Decisions (Condition (N), 'E');
 
@@ -1071,6 +1072,48 @@ package body Par_SCO is
                   Set_Statement_Entry;
                   Traverse_Declarations_Or_Statements (Statements (N));
 
+               --  Pragma
+
+               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.
+
+                  --  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 ???
+
+                  --  For all other pragmas, we always generate decision
+                  --  entries for any embedded expressions.
+
+                  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 =>
+
+                           if Nam = Name_Check then
+                              Next (Arg);
+                           end if;
+
+                           if Assertions_Enabled then
+                              Process_Decisions (Expression (Arg), 'P');
+                           end if;
+
+                        when others =>
+                           Process_Decisions (N, 'X');
+                     end case;
+                  end;
+
                --  All other cases, which extend the current statement sequence
                --  but do not terminate it, even if they have nested decisions.
 
@@ -1101,9 +1144,6 @@ package body Par_SCO is
                         when N_Generic_Instantiation         =>
                            Typ := 'i';
 
-                        when N_Pragma                        =>
-                           Typ := 'P';
-
                         when others                          =>
                            Typ := ' ';
                      end case;
diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb
index 3be6d8b3b3a..39b6288520e 100644
--- a/gcc/ada/put_scos.adb
+++ b/gcc/ada/put_scos.adb
@@ -115,7 +115,7 @@ begin
 
                   --  Decision
 
-                  when 'I' | 'E' | 'W' | 'X' =>
+                  when 'I' | 'E' | 'P' | 'W' | 'X' =>
                      if T.C2 = ' ' then
                         Start := Start + 1;
                      end if;
diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads
index 6cc8742f3ab..19804e4567b 100644
--- a/gcc/ada/scos.ads
+++ b/gcc/ada/scos.ads
@@ -281,10 +281,7 @@ package SCOs is
 
    --    Statements
    --      C1   = 'S' for entry point, 's' otherwise
-   --      C2   = 't', 's', 'o', 'r', 'i',
-   --             'C', 'E', 'F', 'I', 'P', 'R', 'W', ' '
-   --             (type/subtype/object/renaming/instantiation/
-   --              CASE/EXIT/FOR/IF/PRAGMA/RETURN/WHILE/other)
+   --      C2   = statement type code to appear on CS line (or ' ' if none)
    --      From = starting source location
    --      To   = ending source location
    --      Last = False for all but the last entry, True for last entry
@@ -296,7 +293,7 @@ package SCOs is
    --    statements on a single CS line.
 
    --    Decision
-   --      C1   = 'I', 'E', 'P', 'W', 'X' (if/exit/pragma/while/expression)
+   --      C1   = decision type code
    --      C2   = ' '
    --      From = location of IF/EXIT/PRAGMA/WHILE token,
    --             No_Source_Location for X
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 0746ea99b80..d1bbf53adf6 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8218,7 +8218,7 @@ package body Sem_Ch6 is
          Prag := Spec_PPC_List (Spec_Id);
          while Present (Prag) loop
             if Pragma_Name (Prag) = Name_Precondition
-              and then PPC_Enabled (Prag)
+              and then Pragma_Enabled (Prag)
             then
                --  Add pragma Check at the start of the declarations of N.
                --  Note that this processing reverses the order of the list,
@@ -8297,7 +8297,7 @@ package body Sem_Ch6 is
          Prag := Spec_PPC_List (Spec_Id);
          while Present (Prag) loop
             if Pragma_Name (Prag) = Name_Postcondition
-              and then PPC_Enabled (Prag)
+              and then Pragma_Enabled (Prag)
             then
                if Plist = No_List then
                   Plist := Empty_List;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d49ebd10f1e..31799333ede 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1420,7 +1420,7 @@ package body Sem_Prag is
 
          --  Record whether pragma is enabled
 
-         Set_PPC_Enabled (N, Check_Enabled (Pname));
+         Set_Pragma_Enabled (N, Check_Enabled (Pname));
 
          --  If we are within an inlined body, the legality of the pragma
          --  has been checked already.
@@ -5789,6 +5789,7 @@ package body Sem_Prag is
 
             Check_Arg_Is_Identifier (Arg1);
             Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
+            Set_Pragma_Enabled (N, Check_On);
 
             --  If expansion is active and the check is not enabled then we
             --  rewrite the Check as:
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index f4c171cebf7..73377f1a39f 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2257,14 +2257,6 @@ package body Sinfo is
       return Node4 (N);
    end Parent_Spec;
 
-   function PPC_Enabled
-     (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Pragma);
-      return Flag5 (N);
-   end PPC_Enabled;
-
    function Position
       (N : Node_Id) return Node_Id is
    begin
@@ -2281,6 +2273,14 @@ package body Sinfo is
       return List2 (N);
    end Pragma_Argument_Associations;
 
+   function Pragma_Enabled
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Flag5 (N);
+   end Pragma_Enabled;
+
    function Pragma_Identifier
       (N : Node_Id) return Node_Id is
    begin
@@ -5135,14 +5135,6 @@ package body Sinfo is
       Set_Node4 (N, Val); -- semantic field, no parent set
    end Set_Parent_Spec;
 
-   procedure Set_PPC_Enabled
-     (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Pragma);
-      Set_Flag5 (N, Val);
-   end Set_PPC_Enabled;
-
    procedure Set_Position
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -5159,6 +5151,14 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Pragma_Argument_Associations;
 
+   procedure Set_Pragma_Enabled
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag5 (N, Val);
+   end Set_Pragma_Enabled;
+
    procedure Set_Pragma_Identifier
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 7fc555a80ae..8a6a157cc34 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1526,10 +1526,11 @@ package Sinfo is
    --    package specification. This field is Empty for library bodies (the
    --    parent spec in this case can be found from the corresponding spec).
 
-   --  PPC_Enabled (Flag5-Sem)
-   --    Present in N_Pragma nodes. This flag is relevant only for precondition
-   --    and postcondition nodes. It is true if the check corresponding to the
-   --    pragma type is enabled at the point where the pragma appears.
+   --  Pragma_Enabled (Flag5-Sem)
+   --    Present in N_Pragma nodes. This flag is relevant only for pragmas
+   --    Assert, Check, Precondition, and Postcondition. It is true if the
+   --    check corresponding to the pragma type is enabled at the point where
+   --    the pragma appears.
 
    --  Present_Expr (Uint3-Sem)
    --    Present in an N_Variant node. This has a meaningful value only after
@@ -1979,7 +1980,7 @@ package Sinfo is
       --  Debug_Statement (Node3) (set to Empty if not Debug, Assert)
       --  Pragma_Identifier (Node4)
       --  Next_Rep_Item (Node5-Sem)
-      --  PPC_Enabled (Flag5-Sem)
+      --  Pragma_Enabled (Flag5-Sem)
 
       --  Note: we should have a section on what pragmas are passed on to
       --  the back end to be processed. This section should note that pragma
@@ -8311,15 +8312,15 @@ package Sinfo is
    function Parent_Spec
      (N : Node_Id) return Node_Id;    -- Node4
 
-   function PPC_Enabled
-     (N : Node_Id) return Boolean;    -- Flag5
-
    function Position
      (N : Node_Id) return Node_Id;    -- Node2
 
    function Pragma_Argument_Associations
      (N : Node_Id) return List_Id;    -- List2
 
+   function Pragma_Enabled
+     (N : Node_Id) return Boolean;    -- Flag5
+
    function Pragma_Identifier
      (N : Node_Id) return Node_Id;    -- Node4
 
@@ -9229,15 +9230,15 @@ package Sinfo is
    procedure Set_Parent_Spec
      (N : Node_Id; Val : Node_Id);            -- Node4
 
-   procedure Set_PPC_Enabled
-     (N : Node_Id; Val : Boolean := True);    -- Flag5
-
    procedure Set_Position
      (N : Node_Id; Val : Node_Id);            -- Node2
 
    procedure Set_Pragma_Argument_Associations
      (N : Node_Id; Val : List_Id);            -- List2
 
+   procedure Set_Pragma_Enabled
+     (N : Node_Id; Val : Boolean := True);    -- Flag5
+
    procedure Set_Pragma_Identifier
      (N : Node_Id; Val : Node_Id);            -- Node4
 
@@ -11370,9 +11371,9 @@ package Sinfo is
    pragma Inline (Parameter_List_Truncated);
    pragma Inline (Parameter_Type);
    pragma Inline (Parent_Spec);
-   pragma Inline (PPC_Enabled);
    pragma Inline (Position);
    pragma Inline (Pragma_Argument_Associations);
+   pragma Inline (Pragma_Enabled);
    pragma Inline (Pragma_Identifier);
    pragma Inline (Pragmas_After);
    pragma Inline (Pragmas_Before);
@@ -11673,9 +11674,9 @@ package Sinfo is
    pragma Inline (Set_Parameter_List_Truncated);
    pragma Inline (Set_Parameter_Type);
    pragma Inline (Set_Parent_Spec);
-   pragma Inline (Set_PPC_Enabled);
    pragma Inline (Set_Position);
    pragma Inline (Set_Pragma_Argument_Associations);
+   pragma Inline (Set_Pragma_Enabled);
    pragma Inline (Set_Pragma_Identifier);
    pragma Inline (Set_Pragmas_After);
    pragma Inline (Set_Pragmas_Before);
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 89b219afe80..7b194107ff6 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -933,10 +933,23 @@ package body Switch.C is
             --  Processing for z switch
 
             when 'z' =>
+               --  -gnatz must be the first and only switch in Switch_Chars,
+               --  and is a two-letter switch.
+
+               if Ptr /= Switch_Chars'First + 5
+                 or else (Max - Ptr + 1) > 2
+               then
+                  Osint.Fail
+                    ("-gnatz* may not be combined with other switches");
+               end if;
+
+               if Ptr = Max then
+                  Bad_Switch ("-gnatz");
+               end if;
+
                Ptr := Ptr + 1;
 
-               --  Allowed for compiler only if this is the only
-               --  -z switch, we do not allow multiple occurrences
+               --  Only one occurrence of -gnat* is permitted
 
                if Distribution_Stub_Mode = No_Stubs then
                   case Switch_Chars (Ptr) is
@@ -951,6 +964,9 @@ package body Switch.C is
                   end case;
 
                   Ptr := Ptr + 1;
+
+               else
+                  Osint.Fail ("only one -gnatz* switch allowed");
                end if;
 
             --  Processing for Z switch