gnatbind.adb (Restriction_Could_Be_Set): New procedure

2008-04-08  Robert Dewar  <dewar@adacore.com>

	* gnatbind.adb (Restriction_Could_Be_Set): New procedure
	(List_Applicable_Restrictions): Do not list existing restrictions

From-SVN: r134035

gcc/ada/gnatbind.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -164,48 +164,96 @@ procedure Gnatbind is
       Additional_Restrictions_Listed : Boolean := False;
       --  Set True if we have listed header for restrictions
 
-   begin
-      --  Loop through restrictions
+      function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
+      --  Returns True if the given restriction can be listed as an additional
+      --  restriction that could be set.
 
-      for R in All_Restrictions loop
-         if not No_Restriction_List (R) then
+      ------------------------------
+      -- Restriction_Could_Be_Set --
+      ------------------------------
 
-            --  We list a restriction if it is not violated, or if
-            --  it is violated but the violation count is exactly known.
+      function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
+         CR : Restrictions_Info renames Cumulative_Restrictions;
 
-            if Cumulative_Restrictions.Violated (R) = False
-              or else (R in All_Parameter_Restrictions
-                       and then
-                         Cumulative_Restrictions.Unknown (R) = False)
-            then
-               if not Additional_Restrictions_Listed then
-                  Write_Eol;
-                  Write_Line
-                    ("The following additional restrictions may be" &
-                     " applied to this partition:");
-                  Additional_Restrictions_Listed := True;
-               end if;
+      begin
+         case R is
+
+            --  Boolean restriction
+
+            when All_Boolean_Restrictions =>
 
-               Write_Str ("pragma Restrictions (");
+               --  The condition for listing a boolean restriction as an
+               --  additional restriction that could be set is that it is
+               --  not violated by any unit, and not already set.
 
-               declare
-                  S : constant String := Restriction_Id'Image (R);
-               begin
-                  Name_Len := S'Length;
-                  Name_Buffer (1 .. Name_Len) := S;
-               end;
+               return CR.Violated (R) = False and then CR.Set (R) = False;
 
-               Set_Casing (Mixed_Case);
-               Write_Str (Name_Buffer (1 .. Name_Len));
+            --  Parameter restriction
 
-               if R in All_Parameter_Restrictions then
-                  Write_Str (" => ");
-                  Write_Int (Int (Cumulative_Restrictions.Count (R)));
+            when All_Parameter_Restrictions =>
+
+               --  If the restriction is violated and the level of violation is
+               --  unknown, the restriction can definitely not be listed.
+
+               if CR.Violated (R) and then CR.Unknown (R) then
+                  return False;
+
+               --  We can list the restriction if it is not set
+
+               elsif not CR.Set (R) then
+                  return True;
+
+               --  We can list the restriction if is set to a greater value
+               --  than the maximum value known for the violation.
+
+               else
+                  return CR.Value (R) > CR.Count (R);
                end if;
 
-               Write_Str (");");
+            --  No other values for R possible
+
+            when others =>
+               raise Program_Error;
+
+         end case;
+      end Restriction_Could_Be_Set;
+
+   --  Start of processing for List_Applicable_Restrictions
+
+   begin
+      --  Loop through restrictions
+
+      for R in All_Restrictions loop
+         if not No_Restriction_List (R)
+            and then Restriction_Could_Be_Set (R)
+         then
+            if not Additional_Restrictions_Listed then
                Write_Eol;
+               Write_Line
+                 ("The following additional restrictions may be" &
+                  " applied to this partition:");
+               Additional_Restrictions_Listed := True;
+            end if;
+
+            Write_Str ("pragma Restrictions (");
+
+            declare
+               S : constant String := Restriction_Id'Image (R);
+            begin
+               Name_Len := S'Length;
+               Name_Buffer (1 .. Name_Len) := S;
+            end;
+
+            Set_Casing (Mixed_Case);
+            Write_Str (Name_Buffer (1 .. Name_Len));
+
+            if R in All_Parameter_Restrictions then
+               Write_Str (" => ");
+               Write_Int (Int (Cumulative_Restrictions.Count (R)));
             end if;
+
+            Write_Str (");");
+            Write_Eol;
          end if;
       end loop;
    end List_Applicable_Restrictions;