2009-04-09 Robert Dewar <dewar@adacore.com>

* checks.adb:
        (Insert_Valid_Check): Avoid unnecessary generation of junk declaration
        when no invalid values exist, Avoid duplicate read of atomic variable.

        * cstand.adb (Build_Signed_Integer_Type): Set Is_Known_Valid
        (Standard_Unsigned): Set Is_Known_Valid

        * sem_ch3.adb (Analyze_Subtype_Declaration): Copy Is_Known_Valid on
	subtype declaration if no constraint.
        (Set_Modular_Size): Set Is_Known_Valid if appropriate
        (Build_Derived_Numeric_Type): Copy Is_Known_Valid if no constraint

From-SVN: r145836

gcc/ada/checks.adb

@@ -5125,10 +5125,12 @@ package body Checks is
       Exp : Node_Id;
 
    begin
-      --  Do not insert if checks off, or if not checking validity
+      --  Do not insert if checks off, or if not checking validity or
+      --  if expression is known to be valid
 
       if not Validity_Checks_On
         or else Range_Or_Validity_Checks_Suppressed (Expr)
+        or else Expr_Known_Valid (Expr)
       then
          return;
       end if;
@@ -5152,6 +5154,14 @@ package body Checks is
       begin
          Set_Do_Range_Check (Exp, False);
 
+         --  Force evaluation to avoid multiple reads for atomic/volatile
+
+         if Is_Entity_Name (Exp)
+           and then Is_Volatile (Entity (Exp))
+         then
+            Force_Evaluation (Exp, Name_Req => True);
+         end if;
+
          --  Insert the validity check. Note that we do this with validity
          --  checks turned off, to avoid recursion, we do not want validity
          --  checks on the validity checking code itself!

gcc/ada/cstand.adb

@@ -933,17 +933,17 @@ package body CStand is
       Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
       Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard);
       Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer));
-      Init_Esize         (Standard_Debug_Renaming_Type, 0);
-      Init_RM_Size       (Standard_Debug_Renaming_Type, 0);
+      Init_Esize          (Standard_Debug_Renaming_Type, 0);
+      Init_RM_Size        (Standard_Debug_Renaming_Type, 0);
       Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type);
-      Set_Integer_Bounds (Standard_Debug_Renaming_Type,
-        Typ => Base_Type (Standard_Debug_Renaming_Type),
+      Set_Integer_Bounds  (Standard_Debug_Renaming_Type,
+        Typ => Base_Type  (Standard_Debug_Renaming_Type),
         Lb  => Uint_1,
         Hb  => Uint_0);
-      Set_Is_Constrained (Standard_Debug_Renaming_Type);
+      Set_Is_Constrained  (Standard_Debug_Renaming_Type);
       Set_Has_Size_Clause (Standard_Debug_Renaming_Type);
 
-      Make_Name      (Standard_Debug_Renaming_Type, "_renaming_type");
+      Make_Name           (Standard_Debug_Renaming_Type, "_renaming_type");
 
       --  Note on type names. The type names for the following special types
       --  are constructed so that they will look reasonable should they ever
@@ -1144,6 +1144,7 @@ package body CStand is
       Set_Is_Unsigned_Type  (Standard_Unsigned);
       Set_Size_Known_At_Compile_Time
                             (Standard_Unsigned);
+      Set_Is_Known_Valid    (Standard_Unsigned, True);
 
       R_Node := New_Node (N_Range, Stloc);
       Set_Low_Bound  (R_Node, Make_Integer (Uint_0));
@@ -1311,7 +1312,6 @@ package body CStand is
       begin
          Comp      := First_Entity (Standard_Exception_Type);
          Comp_List := New_List;
-
          while Present (Comp) loop
             Append (
               Make_Component_Declaration (Stloc,
@@ -1487,7 +1487,6 @@ package body CStand is
 
    function Identifier_For (S : Standard_Entity_Type) return Node_Id is
       Ident_Node : Node_Id;
-
    begin
       Ident_Node := New_Node (N_Identifier, Stloc);
       Set_Chars (Ident_Node, Chars (Standard_Entity (S)));

gcc/ada/sem_ch3.adb

@@ -603,7 +603,7 @@ package body Sem_Ch3 is
    --  given kind of type (index constraint to an array type, for example).
 
    procedure Modular_Type_Declaration (T : Entity_Id; Def : Node_Id);
-   --  Create new modular type. Verify that modulus is in  bounds and is
+   --  Create new modular type. Verify that modulus is in bounds and is
    --  a power of two (implementation restriction).
 
    procedure New_Concatenation_Op (Typ : Entity_Id);
@@ -3382,6 +3382,7 @@ package body Sem_Ch3 is
                Set_Scalar_Range         (Id, Scalar_Range       (T));
                Set_Machine_Radix_10     (Id, Machine_Radix_10   (T));
                Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
                Set_RM_Size              (Id, RM_Size            (T));
 
             when Enumeration_Kind =>
@@ -3390,6 +3391,7 @@ package body Sem_Ch3 is
                Set_Scalar_Range         (Id, Scalar_Range       (T));
                Set_Is_Character_Type    (Id, Is_Character_Type  (T));
                Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
                Set_RM_Size              (Id, RM_Size            (T));
 
             when Ordinary_Fixed_Point_Kind =>
@@ -3398,6 +3400,7 @@ package body Sem_Ch3 is
                Set_Small_Value          (Id, Small_Value        (T));
                Set_Delta_Value          (Id, Delta_Value        (T));
                Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
                Set_RM_Size              (Id, RM_Size            (T));
 
             when Float_Kind =>
@@ -3410,12 +3413,14 @@ package body Sem_Ch3 is
                Set_Ekind                (Id, E_Signed_Integer_Subtype);
                Set_Scalar_Range         (Id, Scalar_Range       (T));
                Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
                Set_RM_Size              (Id, RM_Size            (T));
 
             when Modular_Integer_Kind =>
                Set_Ekind                (Id, E_Modular_Integer_Subtype);
                Set_Scalar_Range         (Id, Scalar_Range       (T));
                Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
                Set_RM_Size              (Id, RM_Size            (T));
 
             when Class_Wide_Kind =>
@@ -5205,6 +5210,7 @@ package body Sem_Ch3 is
       Set_Size_Info      (Implicit_Base,                 Parent_Base);
       Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Base));
       Set_Parent         (Implicit_Base, Parent (Derived_Type));
+      Set_Is_Known_Valid (Implicit_Base, Is_Known_Valid (Parent_Base));
 
       --  Set RM Size for discrete type or decimal fixed-point type
       --  Ordinary fixed-point is excluded, why???
@@ -5258,6 +5264,8 @@ package body Sem_Ch3 is
          if Has_Infinities (Parent_Type) then
             Set_Includes_Infinities (Scalar_Range (Derived_Type));
          end if;
+
+         Set_Is_Known_Valid (Derived_Type, Is_Known_Valid (Parent_Type));
       end if;
 
       Set_Is_Descendent_Of_Address (Derived_Type,
@@ -5273,6 +5281,9 @@ package body Sem_Ch3 is
          Set_Non_Binary_Modulus
            (Implicit_Base, Non_Binary_Modulus (Parent_Base));
 
+         Set_Is_Known_Valid
+           (Implicit_Base, Is_Known_Valid (Parent_Base));
+
       elsif Is_Floating_Point_Type (Parent_Type) then
 
          --  Digits of base type is always copied from the digits value of
@@ -14881,6 +14892,12 @@ package body Sem_Ch3 is
          else
             Init_Esize (T, System_Max_Binary_Modulus_Power);
          end if;
+
+         if not Non_Binary_Modulus (T)
+           and then Esize (T) = RM_Size (T)
+         then
+            Set_Is_Known_Valid (T);
+         end if;
       end Set_Modular_Size;
 
    --  Start of processing for Modular_Type_Declaration