Ada: Fix packed boolean array with Default_Component_Value aspect

Putting the Default_Component_Value aspect on a bit-packed array type has
never worked, so this plugs the loophole.  For the sake of consistency,
the recent fix for PR ada/68179 is adjusted to use Has_Default_Aspect too.

gcc/ada/
	PR ada/68179
	PR ada/123589
	* exp_ch3.adb (Expand_Freeze_Array_Type): Build an initialization
	procedure for a bit-packed array type if Has_Default_Aspect is set
	on the base type, but make sure not to build it twice.  Also test
	Has_Default_Aspect for a type derived from String.

gcc/testsuite/
	* gnat.dg/component_value2.adb: New test.

Co-authored-by: Lisa Felidae <lisa@felidae.bam.moe>
This commit is contained in:
Eric Botcazou
2026-01-17 22:27:53 +01:00
parent c53c1ce78e
commit cda2b46c68
2 changed files with 36 additions and 10 deletions

View File

@@ -5711,6 +5711,8 @@ package body Exp_Ch3 is
(Component_Type (Typ));
begin
-- First, the nonpacked case
if not Is_Bit_Packed_Array (Typ) then
if No (Init_Proc (Base)) then
@@ -5734,7 +5736,7 @@ package body Exp_Ch3 is
-- and do not need initialization procedures.
elsif Is_Standard_String_Type (Base)
and then No (Default_Aspect_Component_Value (Base))
and then not Has_Default_Aspect (Base)
then
null;
@@ -5755,18 +5757,20 @@ package body Exp_Ch3 is
end if;
end if;
-- For packed case, default initialization, except if the component type
-- is itself a packed structure with an initialization procedure, or
-- initialize/normalize scalars active, and we have a base type, or the
-- type is public, because in that case a client might specify
-- Normalize_Scalars and there better be a public Init_Proc for it.
-- For the packed case, no initialization, except if the component type
-- has an initialization procedure, or Initialize/Normalize_Scalars is
-- active, or there is a Default_Component_Value aspect, or the type is
-- public, because a client might specify Initialize_Scalars and there
-- better be a public Init_Proc for it.
elsif (Present (Init_Proc (Component_Type (Base)))
and then No (Base_Init_Proc (Base)))
or else (Init_Or_Norm_Scalars and then Base = Typ)
elsif Present (Init_Proc (Component_Type (Base)))
or else Init_Or_Norm_Scalars
or else Has_Default_Aspect (Base)
or else Is_Public (Typ)
then
Build_Array_Init_Proc (Base, N);
if No (Init_Proc (Base)) then
Build_Array_Init_Proc (Base, N);
end if;
end if;
end Expand_Freeze_Array_Type;

View File

@@ -0,0 +1,22 @@
-- { dg-do run }
procedure Component_Value2 is
type Bool_Packed_Array is array (Positive range 1 .. 20) of Boolean
with Default_Component_Value => False, Pack;
type Bool_Nonpacked_Array is array (Positive range 1 .. 20) of Boolean
with Default_Component_Value => False;
P : Bool_Packed_Array;
NP : Bool_Nonpacked_Array;
begin
if not (for all I in P'Range => P(I) = False) then
raise Program_Error;
end if;
if not (for all I in NP'Range => P(I) = False) then
raise Program_Error;
end if;
end;