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 --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a947018052c98b455adf1e1fcb7eaf8e8ba97c6f..7d5be6b674459d8a05ea37b6867e623df482cc0c 100644 (file)
--- 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;