ada: Missing constraint check for 'Length attribute reference

In some cases involving a universal-integer-valued attribute reference
(typically a 'Length attribute reference) occurring as an actual parameter
in a call, the runtime check that the constraints of the formal parameter
are satisfied is incorrectly not performed.

gcc/ada/ChangeLog:
	* sem_attr.adb (Resolve_Attribute): When setting the Etype of a
	universal-integer-valued attribute reference to the subtype
	determined by its context, use the basetype of that subtype
	instead of the subtype itself if there is a possibility that the
	attribute value will not satisfy the constraints of that subtype.
	Otherwise the compiler is, in effect, assuming something that
	might not be true. Except use the subtype in the case of a
	not-from-source 'Pos attribute reference in order to avoid
	breaking things.

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 994a45becdc5b0f16a332b6c2f64e2817dc8eb99..9ab197299baf4870fe22308cb77052adf1ae591f 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -11231,7 +11231,38 @@ package body Sem_Attr is
       --  If attribute was universal type, reset to actual type
 
       if Is_Universal_Numeric_Type (Etype (N)) then
-         Set_Etype (N, Typ);
+
+         --  If evaluating N might yield a value that that does not satisfy
+         --  the constraints of the subtype Typ, then we need to set the
+         --  Etype of N to "Base_Type (Typ)" instead of "Typ".
+         --  Otherwise we can end up incorrectly assuming that the value
+         --  belongs to the subtype and, as a result, eliminating required
+         --  runtime checks.
+         --  Rather than trying to analyze the expression and the subtype to
+         --  test for this case, it seems better to take the simpler approach;
+         --  that is, to ignore this opportunity for an insignificant
+         --  micro-optimization and to instead call Base_Type unconditionally.
+         --  But that doesn't work; it turns out that there is a corner case
+         --  where (for reasons that are not completely understood) we need
+         --  to set the Etype to Typ for reasons of correctness. See below
+         --  for description of this case.
+
+         if Attr_Id = Attribute_Pos
+           and then not Comes_From_Source (N)
+         then
+            --  This case occurs when indexing into a packed array and
+            --  the index type is an enumeration type that is subject to
+            --  an enumeration representation specification.
+            --  See the "Analyze_And_Resolve (Expr_Copy, Standard_Natural);"
+            --  statement in exp_pakd.adb .
+            --  For reasons that are not understood, we see a regression test
+            --  failure if we don't handle that case by calling Set_Etype here
+            --  with "Typ" instead of "Base_Type (Typ)").
+
+            Set_Etype (N, Typ);
+         else
+            Set_Etype (N, Base_Type (Typ));
+         end if;
       end if;
 
       --  A Ghost attribute must appear in a specific context