[Ada] Bad Valid_Scalars result if signed int component type signed has partial view.

For an object X of a composite type, the attribute X'Valid_Scalars should
return False if and only if there exists at least one invalid scalar
subcomponent of X. The validity test for a scalar part may include a
range test. In some cases involving a private type that is implemented as
a signed integer type, this range test was incorrectly implemented using
unsigned comparisons. For an enclosing object X, this could result in
X'Valid_Scalars yielding the wrong Boolean result. Such an incorrect
result would almost always be False, although an incorrect True result is
theoretically possible (this would require that both bounds of the
component subtype are negative and that the invalid component has a positive
value).

gcc/ada/

	* exp_attr.adb
	(Make_Range_Test): In determining which subtype's First and Last
	attributes are to be queried as part of a range test, call
	Validated_View in order to get a scalar (as opposed to private)
	subtype.
	(Attribute_Valid): In determining whether to perform a signed or
	unsigned comparison for a range test, call Validated_View in order
	to get a scalar (as opposed to private) type. Also correct a typo
	which, by itself, is the source of the problem reported for this
	ticket.

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index d28bb08..33eec37 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -7103,7 +7103,8 @@ package body Exp_Attr is
       --  See separate sections below for the generated code in each case.
 
       when Attribute_Valid => Valid : declare
-         PBtyp : Entity_Id := Base_Type (Ptyp);
+         PBtyp : Entity_Id := Base_Type (Validated_View (Ptyp));
+         --  The scalar base type, looking through private types
 
          Save_Validity_Checks_On : constant Boolean := Validity_Checks_On;
          --  Save the validity checking mode. We always turn off validity
@@ -7150,21 +7151,27 @@ package body Exp_Attr is
                Temp := Duplicate_Subexpr (Pref);
             end if;
 
-            return
-              Make_In (Loc,
-                Left_Opnd  => Unchecked_Convert_To (PBtyp, Temp),
-                Right_Opnd =>
-                  Make_Range (Loc,
-                    Low_Bound  =>
-                      Unchecked_Convert_To (PBtyp,
-                        Make_Attribute_Reference (Loc,
-                          Prefix         => New_Occurrence_Of (Ptyp, Loc),
-                          Attribute_Name => Name_First)),
-                    High_Bound =>
-                      Unchecked_Convert_To (PBtyp,
-                        Make_Attribute_Reference (Loc,
-                          Prefix         => New_Occurrence_Of (Ptyp, Loc),
-                          Attribute_Name => Name_Last))));
+            declare
+               Val_Typ : constant Entity_Id := Validated_View (Ptyp);
+            begin
+               return
+                 Make_In (Loc,
+                   Left_Opnd  => Unchecked_Convert_To (PBtyp, Temp),
+                   Right_Opnd =>
+                     Make_Range (Loc,
+                       Low_Bound  =>
+                         Unchecked_Convert_To (PBtyp,
+                           Make_Attribute_Reference (Loc,
+                             Prefix         =>
+                               New_Occurrence_Of (Val_Typ, Loc),
+                             Attribute_Name => Name_First)),
+                       High_Bound =>
+                         Unchecked_Convert_To (PBtyp,
+                           Make_Attribute_Reference (Loc,
+                             Prefix         =>
+                               New_Occurrence_Of (Val_Typ, Loc),
+                             Attribute_Name => Name_Last))));
+            end;
          end Make_Range_Test;
 
          --  Local variables
@@ -7186,13 +7193,6 @@ package body Exp_Attr is
 
          Validity_Checks_On := False;
 
-         --  Retrieve the base type. Handle the case where the base type is a
-         --  private enumeration type.
-
-         if Is_Private_Type (PBtyp) and then Present (Full_View (PBtyp)) then
-            PBtyp := Full_View (PBtyp);
-         end if;
-
          --  Floating-point case. This case is handled by the Valid attribute
          --  code in the floating-point attribute run-time library.
 
@@ -7462,7 +7462,7 @@ package body Exp_Attr is
                Uns  : constant Boolean :=
                         Is_Unsigned_Type (Ptyp)
                           or else (Is_Private_Type (Ptyp)
-                                    and then Is_Unsigned_Type (Btyp));
+                                    and then Is_Unsigned_Type (PBtyp));
                Size : Uint;
                P    : Node_Id := Pref;