From: Steve Baird <ba...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 33 ++++++++++++++++++++++++++++++++-
1 file changed, 32 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 994a45becdc..9ab197299ba 100644
--- 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
--
2.43.0
