diff mbox series

[COMMITTED,6/9] ada: Spurious error on the default value of a derived scalar type

Message ID 20240806090241.576862-6-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,1/9] ada: Reject use-clause conflicts in the run-time library | expand

Commit Message

Marc Poulhiès Aug. 6, 2024, 9:02 a.m. UTC 
From: Javier Miranda <miranda@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/freeze.adb | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)
diff mbox series

Patch

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a947018052c..7d5be6b6744 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;