From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 20 Oct 2025 19:01:06 +0000 (+0200)
Subject: Ada: Fix Default_Component_Value aspect wrongly ignored on derived type
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=a3d86afa13a910bd05317e9c73e08c999e16837d;p=thirdparty%2Fgcc.git

Ada: Fix Default_Component_Value aspect wrongly ignored on derived type

This is again an old issue, which was mostly fixed a few releases ago except
for the specific case of an array type derived from String.

gcc/ada/
	PR ada/68179
	* exp_ch3.adb (Expand_Freeze_Array_Type): Build an initialization
	procedure for a type derived from String declared with the aspect
	Default_Aspect_Component_Value.

gcc/testsuite/
	* gnat.dg/component_value1.adb: New test.
---

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index d5dfc5d2094..60224c19b19 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5537,7 +5537,9 @@ package body Exp_Ch3 is
             --  initialize scalars mode, and these types are treated specially
             --  and do not need initialization procedures.
 
-            elsif Is_Standard_String_Type (Base) then
+            elsif Is_Standard_String_Type (Base)
+              and then No (Default_Aspect_Component_Value (Base))
+            then
                null;
 
             --  Otherwise we have to build an init proc for the subtype
diff --git a/gcc/testsuite/gnat.dg/component_value1.adb b/gcc/testsuite/gnat.dg/component_value1.adb
new file mode 100644
index 00000000000..830f7ec4761
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/component_value1.adb
@@ -0,0 +1,32 @@
+--  { dg-do run }
+
+with Ada.Characters.Latin_1;
+
+procedure Component_Value1 is
+
+  type Y_Array is array (Natural range <>) of Character
+    with Default_Component_Value => Ada.Characters.Latin_1.Space;
+
+  type Y2_Array is new Y_Array
+    with Default_Component_Value => Ada.Characters.Latin_1.HT;
+
+  type X_String is new String
+    with Default_Component_Value => Ada.Characters.Latin_1.Space;
+
+  Y  : Y_Array  (1..20);
+  Y2 : Y2_Array (1..20);
+  X  : X_String (1..20);
+
+begin
+  if not (for all I in Y'Range => Y(I) = Ada.Characters.Latin_1.Space) then
+    raise Program_Error;
+  end if;
+
+  if not (for all I in Y2'Range => Y2(I) = Ada.Characters.Latin_1.HT) then
+    raise Program_Error;
+  end if;
+
+  if not (for all I in X'Range => X(I) = Ada.Characters.Latin_1.Space) then
+    raise Program_Error;
+  end if;
+end;