restrict.ads, [...] (Restriction_Active): Now returns False if only a restriction...

2006-10-31  Arnaud Charlet  <charlet@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* restrict.ads, restrict.adb (Restriction_Active): Now returns False if
	only a restriction warning is active for the given restriction. This is
	desirable because we do not want to modify code in the case where only
	a warning is set.
	(Set_Profile_Restrictions): Make sure that a Profile_Warnings never
	causes overriding of real restrictions.
	Take advantage of new No_Restrictions constant.

	* raise.h: (__gnat_set_globals): Change profile.

From-SVN: r118295

diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h
index 5e4d0cb6fd444ce55552b7842b87c1ac6ffc952e..b62f2309466427afcf8aba92d49a4ba6217f4222 100644 (file)
--- a/gcc/ada/raise.h
+++ b/gcc/ada/raise.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2006, 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- *
@@ -64,10 +64,7 @@ extern void __gnat_free                      (void *);
 extern void *__gnat_realloc            (void *, __SIZE_TYPE__);
 extern void __gnat_finalize            (void);
 extern void set_gnat_exit_status       (int);
-extern void __gnat_set_globals         (int, int,
-                                                char, char, char, char,
-                                                char *, char *,
-                                                int, int, int, int, int, int);
+extern void __gnat_set_globals         (void);
 extern void __gnat_initialize          (void *);
 extern void __gnat_init_float          (void);
 extern void __gnat_install_handler     (void);

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index f12c1eb1c832df1e9d91a15d10c5529483514cfc..93fd6f0b0454018bffdad707f22716d473169297 100644 (file)
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -484,7 +484,7 @@ package body Restrict is
 
    function Restriction_Active (R : All_Restrictions) return Boolean is
    begin
-      return Restrictions.Set (R);
+      return Restrictions.Set (R) and then not Restriction_Warnings (R);
    end Restriction_Active;
 
    ---------------------
@@ -570,13 +570,27 @@ package body Restrict is
    begin
       for J in R'Range loop
          if R (J) then
-            if J in All_Boolean_Restrictions then
-               Set_Restriction (J, N);
-            else
-               Set_Restriction (J, N, V (J));
-            end if;
+            declare
+               Already_Restricted : constant Boolean := Restriction_Active (J);
+
+            begin
+               --  Set the restriction
+
+               if J in All_Boolean_Restrictions then
+                  Set_Restriction (J, N);
+               else
+                  Set_Restriction (J, N, V (J));
+               end if;
+
+               --  Set warning flag, except that we do not set the warning
+               --  flag if the restriction was already active and this is
+               --  the warning case. That avoids a warning overriding a real
+               --  restriction, which should never happen.
 
-            Restriction_Warnings (J) := Warn;
+               if not (Warn and Already_Restricted) then
+                  Restriction_Warnings (J) := Warn;
+               end if;
+            end;
          end if;
       end loop;
    end Set_Profile_Restrictions;
@@ -607,12 +621,11 @@ package body Restrict is
          Restrictions_Loc (R) := Sloc (N);
       end if;
 
-      --  Record the restriction if we are in the main unit,
-      --  or in the extended main unit. The reason that we
-      --  test separately for Main_Unit is that gnat.adc is
-      --  processed with Current_Sem_Unit = Main_Unit, but
-      --  nodes in gnat.adc do not appear to be the extended
-      --  main source unit (they probably should do ???)
+      --  Record the restriction if we are in the main unit, or in the extended
+      --  main unit. The reason that we test separately for Main_Unit is that
+      --  gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in
+      --  gnat.adc do not appear to be in the extended main source unit (they
+      --  probably should do ???)
 
       if Current_Sem_Unit = Main_Unit
         or else In_Extended_Main_Source_Unit (N)
@@ -698,7 +711,7 @@ package body Restrict is
          end if;
       end loop;
 
-      --  Entry is in table
+      --  Entry is not currently in table
 
       No_Dependence.Append ((Unit, Warn));
    end Set_Restriction_No_Dependence;

diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index 8eb9c8dccfc573c8ac9f150e0490a1425e526b29..063de24955e8b9fb2400e96779f7bca5d533b83f 100644 (file)
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -33,7 +33,7 @@ with Uintp;  use Uintp;
 
 package Restrict is
 
-   Restrictions : Restrictions_Info;
+   Restrictions : Restrictions_Info := No_Restrictions;
    --  This variable records restrictions found in any units in the main
    --  extended unit, and in the case of restrictions checked for partition
    --  consistency, restrictions found in any with'ed units, parent specs
@@ -50,7 +50,7 @@ package Restrict is
    --  pragma, and a value of System_Location is used for restrictions
    --  set from package Standard by the processing in Targparm.
 
-   Main_Restrictions : Restrictions_Info;
+   Main_Restrictions : Restrictions_Info := No_Restrictions;
    --  This variable records only restrictions found in any units of the
    --  main extended unit. These are the variables used for ali file output,
    --  since we want the binder to be able to accurately diagnose inter-unit
@@ -243,7 +243,9 @@ package Restrict is
    pragma Inline (Restriction_Active);
    --  Determines if a given restriction is active. This call should only be
    --  used where the compiled code depends on whether the restriction is
-   --  active. Always use Check_Restriction to record a violation.
+   --  active. Always use Check_Restriction to record a violation. Note that
+   --  this returns False if we only have a Restriction_Warnings set, since
+   --  restriction warnings should never affect generated code.
 
    function Restricted_Profile return Boolean;
    --  Tests if set of restrictions corresponding to Profile (Restricted) is