checks.adb (Determine_Range): Deal with values that might be invalid

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

	* checks.adb (Determine_Range): Deal with values that might be invalid

	* opt.adb, opt.ads (Assume_No_Invalid_Values[_Config]): New configuration
	switches.

	* par-prag.adb: Dummy entry for pragma Assume_No_Invalid_Values

	* sem_prag.adb: Implement pragma Assume_No_Default_Values

	* snames.adb, snames.ads, snames.h:
	Add entries for pragma Assume_No_Invalid_Values

	* switch-c.adb: Add processing for -gnatB switch

	* usage.adb: Add entry for flag -gnatB (no bad invalid values)

From-SVN: r139484

gcc/ada/ChangeLog

+2008-08-22  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Determine_Range): Deal with values that might be invalid
+
+	* opt.adb, opt.ads (Assume_No_Invalid_Values[_Config]): New configuration
+	switches.
+
+	* par-prag.adb: Dummy entry for pragma Assume_No_Invalid_Values
+
+	* sem_prag.adb: Implement pragma Assume_No_Default_Values
+
+	* snames.adb, snames.ads, snames.h:
+	Add entries for pragma Assume_No_Invalid_Values
+
+	* switch-c.adb: Add processing for -gnatB switch
+
+	* usage.adb: Add entry for flag -gnatB (no bad invalid values)
+
+2008-08-22  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch3.adb (Build_Init_Statements): Transfer to the body of the
+	init procedure all the expanded code associated with the spec of
+	task types and protected types.
+
 2008-08-22  Gary Dismukes  <dismukes@adacore.com>
 
 	* exp_aggr.adb (Static_Array_Aggregate): Call Analyze_And_Resolve on the

gcc/ada/checks.adb

@@ -3125,10 +3125,9 @@ package body Checks is
       --  First step, change to use base type if the expression is an entity
       --  which we do not know is valid.
 
-      --  For now, we do not do this
-
-      if False and then Is_Entity_Name (N)
+      if Is_Entity_Name (N)
         and then not Is_Known_Valid (Entity (N))
+        and then not Assume_No_Invalid_Values
       then
          Typ := Base_Type (Typ);
       end if;

gcc/ada/opt.adb

@@ -49,6 +49,7 @@ package body Opt is
       Ada_Version_Config                    := Ada_Version;
       Ada_Version_Explicit_Config           := Ada_Version_Explicit;
       Assertions_Enabled_Config             := Assertions_Enabled;
+      Assume_No_Invalid_Values_Config       := Assume_No_Invalid_Values;
       Check_Policy_List_Config              := Check_Policy_List;
       Debug_Pragmas_Enabled_Config          := Debug_Pragmas_Enabled;
       Dynamic_Elaboration_Checks_Config     := Dynamic_Elaboration_Checks;
@@ -78,6 +79,7 @@ package body Opt is
       Ada_Version                    := Save.Ada_Version;
       Ada_Version_Explicit           := Save.Ada_Version_Explicit;
       Assertions_Enabled             := Save.Assertions_Enabled;
+      Assume_No_Invalid_Values       := Save.Assume_No_Invalid_Values;
       Check_Policy_List              := Save.Check_Policy_List;
       Debug_Pragmas_Enabled          := Save.Debug_Pragmas_Enabled;
       Dynamic_Elaboration_Checks     := Save.Dynamic_Elaboration_Checks;
@@ -102,6 +104,7 @@ package body Opt is
       Save.Ada_Version                    := Ada_Version;
       Save.Ada_Version_Explicit           := Ada_Version_Explicit;
       Save.Assertions_Enabled             := Assertions_Enabled;
+      Save.Assume_No_Invalid_Values       := Assume_No_Invalid_Values;
       Save.Check_Policy_List              := Check_Policy_List;
       Save.Debug_Pragmas_Enabled          := Debug_Pragmas_Enabled;
       Save.Dynamic_Elaboration_Checks     := Dynamic_Elaboration_Checks;
@@ -134,27 +137,30 @@ package body Opt is
          --  since the whole point of this is that it still properly indicates
          --  the configuration setting even in a run time unit.
 
-         Ada_Version                := Ada_Version_Runtime;
-         Dynamic_Elaboration_Checks := False;
-         Extensions_Allowed         := True;
-         External_Name_Exp_Casing   := As_Is;
-         External_Name_Imp_Casing   := Lowercase;
-         Optimize_Alignment         := 'O';
-         Persistent_BSS_Mode        := False;
-         Use_VADS_Size              := False;
-         Optimize_Alignment_Local   := True;
+         Ada_Version                 := Ada_Version_Runtime;
+         Dynamic_Elaboration_Checks  := False;
+         Extensions_Allowed          := True;
+         External_Name_Exp_Casing    := As_Is;
+         External_Name_Imp_Casing    := Lowercase;
+         Optimize_Alignment          := 'O';
+         Persistent_BSS_Mode         := False;
+         Use_VADS_Size               := False;
+         Optimize_Alignment_Local    := True;
 
          --  For an internal unit, assertions/debug pragmas are off unless this
-         --  is the main unit and they were explicitly enabled.
+         --  is the main unit and they were explicitly enabled. We also make
+         --  sure we do not assume that values are necessarily valid.
 
          if Main_Unit then
-            Assertions_Enabled    := Assertions_Enabled_Config;
-            Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
-            Check_Policy_List     := Check_Policy_List_Config;
+            Assertions_Enabled       := Assertions_Enabled_Config;
+            Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
+            Debug_Pragmas_Enabled    := Debug_Pragmas_Enabled_Config;
+            Check_Policy_List        := Check_Policy_List_Config;
          else
-            Assertions_Enabled    := False;
-            Debug_Pragmas_Enabled := False;
-            Check_Policy_List     := Empty;
+            Assertions_Enabled       := False;
+            Assume_No_Invalid_Values := False;
+            Debug_Pragmas_Enabled    := False;
+            Check_Policy_List        := Empty;
          end if;
 
       --  Case of non-internal unit
@@ -163,6 +169,7 @@ package body Opt is
          Ada_Version                 := Ada_Version_Config;
          Ada_Version_Explicit        := Ada_Version_Explicit_Config;
          Assertions_Enabled          := Assertions_Enabled_Config;
+         Assume_No_Invalid_Values    := Assume_No_Invalid_Values_Config;
          Check_Policy_List           := Check_Policy_List_Config;
          Debug_Pragmas_Enabled       := Debug_Pragmas_Enabled_Config;
          Dynamic_Elaboration_Checks  := Dynamic_Elaboration_Checks_Config;

gcc/ada/opt.ads

@@ -158,6 +158,15 @@ package Opt is
    --  GNAT
    --  Enable assertions made using pragma Assert
 
+   Assume_No_Invalid_Values : Boolean := True;
+   --  ??? true for now, enable by setting to false later
+   --  GNAT
+   --  Normallly, in accordance with (RM 13.9.1 (9-11)) the front end assumes
+   --  that values could have invalid representations, unless it can clearly
+   --  prove that the values are valid. If this switch is set (by -gnatB or by
+   --  pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values
+   --  are valid and in range of their representations.
+
    Back_Annotate_Rep_Info : Boolean := False;
    --  GNAT
    --  If set True, enables back annotation of representation information
@@ -1414,6 +1423,13 @@ package Opt is
    --  mode, as possibly set by the command line switch -gnata, and possibly
    --  modified by the use of the configuration pragma Assertion_Policy.
 
+   Assume_No_Invalid_Values_Config : Boolean;
+   --  GNAT
+   --  This is the value of the configuration switch for assuming no invalid
+   --  values enabled mode mode, as possibly set by the command line switch
+   --  -gnatB, and possibly modified by the use of the configuration pragma
+   --  Assume_No_Invalid_Values.
+
    Check_Policy_List_Config : Node_Id;
    --  GNAT
    --  This points to the list of N_Pragma nodes for Check_Policy pragmas
@@ -1612,6 +1628,7 @@ private
       Ada_Version                    : Ada_Version_Type;
       Ada_Version_Explicit           : Ada_Version_Type;
       Assertions_Enabled             : Boolean;
+      Assume_No_Invalid_Values       : Boolean;
       Check_Policy_List              : Node_Id;
       Debug_Pragmas_Enabled          : Boolean;
       Dynamic_Elaboration_Checks     : Boolean;

gcc/ada/par-prag.adb

@@ -1050,6 +1050,7 @@ begin
 
       when Pragma_Abort_Defer                   |
            Pragma_Assertion_Policy              |
+           Pragma_Assume_No_Invalid_Values      |
            Pragma_AST_Entry                     |
            Pragma_All_Calls_Remote              |
            Pragma_Annotate                      |

gcc/ada/sem_prag.adb

@@ -5289,6 +5289,25 @@ package body Sem_Prag is
             Opt.Check_Policy_List := N;
          end Assertion_Policy;
 
+         ------------------------------
+         -- Assume_No_Invalid_Values --
+         ------------------------------
+
+         --  pragma Assume_No_Invalid_Values (On | Off);
+
+         when Pragma_Assume_No_Invalid_Values =>
+            GNAT_Pragma;
+            Check_Valid_Configuration_Pragma;
+            Check_Arg_Count (1);
+            Check_No_Identifiers;
+            Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
+
+            if Chars (Expression (Arg1)) = Name_On then
+               Assume_No_Invalid_Values := True;
+            else
+               Assume_No_Invalid_Values := False;
+            end if;
+
          ---------------
          -- AST_Entry --
          ---------------
@@ -6315,8 +6334,8 @@ package body Sem_Prag is
          --  pragma Discard_Names [([On =>] LOCAL_NAME)];
 
          when Pragma_Discard_Names => Discard_Names : declare
-            E_Id : Entity_Id;
             E    : Entity_Id;
+            E_Id : Entity_Id;
 
          begin
             Check_Ada_83_Warning;
@@ -6346,6 +6365,7 @@ package body Sem_Prag is
                   Check_Arg_Count (1);
                   Check_Optional_Identifier (Arg1, Name_On);
                   Check_Arg_Is_Local_Name (Arg1);
+
                   E_Id := Expression (Arg1);
 
                   if Etype (E_Id) = Any_Type then
@@ -6355,8 +6375,8 @@ package body Sem_Prag is
                   end if;
 
                   if (Is_First_Subtype (E)
-                       and then (Is_Enumeration_Type (E)
-                                  or else Is_Tagged_Type (E)))
+                      and then
+                        (Is_Enumeration_Type (E) or else Is_Tagged_Type (E)))
                     or else Ekind (E) = E_Exception
                   then
                      Set_Discard_Names (E);
@@ -6364,6 +6384,7 @@ package body Sem_Prag is
                      Error_Pragma_Arg
                        ("inappropriate entity for pragma%", Arg1);
                   end if;
+
                end if;
             end if;
          end Discard_Names;
@@ -12200,6 +12221,7 @@ package body Sem_Prag is
       Pragma_Annotate                      => -1,
       Pragma_Assert                        => -1,
       Pragma_Assertion_Policy              =>  0,
+      Pragma_Assume_No_Invalid_Values      =>  0,
       Pragma_Asynchronous                  => -1,
       Pragma_Atomic                        =>  0,
       Pragma_Atomic_Components             =>  0,

gcc/ada/snames.adb

@@ -179,6 +179,7 @@ package body Snames is
      "ada_05#" &
      "ada_2005#" &
      "assertion_policy#" &
+     "assume_no_invalid_values#" &
      "c_pass_by_copy#" &
      "check_name#" &
      "check_policy#" &

gcc/ada/switch-c.adb

@@ -212,6 +212,12 @@ package body Switch.C is
                Ptr := Ptr + 1;
                Brief_Output := True;
 
+            --  Processing for B switch
+
+            when 'B' =>
+               Ptr := Ptr + 1;
+               Assume_No_Invalid_Values := True;
+
             --  Processing for c switch
 
             when 'c' =>

gcc/ada/usage.adb

@@ -137,6 +137,11 @@ begin
    Write_Switch_Char ("b");
    Write_Line ("Generate brief messages to stderr even if verbose mode set");
 
+   --  Line for -gnatB switch
+
+   Write_Switch_Char ("B");
+   Write_Line ("Assume no bad (invalid) values except in 'Valid attribute");
+
    --  Line for -gnatc switch
 
    Write_Switch_Char ("c");