https://gcc.gnu.org/g:3e2b3dd728d851480bb752055bb0937cd4812ef1
commit r15-2748-g3e2b3dd728d851480bb752055bb0937cd4812ef1
Author: Javier Miranda <mira...@adacore.com>
Date: Tue Jul 23 11:46:19 2024 +0000
ada: Spurious error on the default value of a derived scalar type
When the aspect Default_Value is inherited by a derived scalar
type, and both the parent type T and the derived type DT are
declared in the same scope, a spurious error may be reported.
This occurs if a subprogram declared in the same scope has a
parameter of type DT with a default value, leading the compiler
to incorrectly flag the default value specified in the aspect
of type T as having the wrong type.
gcc/ada/
* freeze.adb (Freeze_Entity): For scalar derived types that
inherit the aspect Default_Value, do not analyze and resolve the
inherited aspect, as the type of the aspect remains the parent
type.
Diff:
---
gcc/ada/freeze.adb | 19 ++++++++++++++++++-
1 file changed, 18 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a947018052c9..7d5be6b67445 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7820,7 +7820,24 @@ package body Freeze is
-- type itself, and we treat Default_Component_Value similarly for
-- the sake of uniformity).
- if Is_First_Subtype (E) and then Has_Default_Aspect (E) then
+ -- But for an inherited Default_Value aspect specification, the type
+ -- of the aspect remains the parent type. RM 3.3.1(11.1), a dynamic
+ -- semantics rule, says "The implicit initial value for a scalar
+ -- subtype that has the Default_Value aspect specified is the value
+ -- of that aspect converted to the nominal subtype". For an inherited
+ -- Default_Value aspect specification, no conversion is evaluated at
+ -- the point of the derived type declaration.
+
+ if Is_First_Subtype (E)
+ and then Has_Default_Aspect (E)
+ and then
+ (not Is_Scalar_Type (E)
+ or else
+ not Is_Derived_Type (E)
+ or else
+ Default_Aspect_Value (E)
+ /= Default_Aspect_Value (Etype (Base_Type (E))))
+ then
declare
Nam : Name_Id;
Exp : Node_Id;
