https://gcc.gnu.org/g:b14337e3777ac4525ceedd5df3decb63fc271604
commit r16-2405-gb14337e3777ac4525ceedd5df3decb63fc271604
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Wed Jul 2 15:25:55 2025 +0200
ada: Fix wrong indirect access to bit-packed array in iterated loop
This comes from a missing expansion of the bit-packed array reference in
the loop, because the actual subtype created for the dereference lacks a
Packed_Array_Impl_Type as it is ultimately created by the Preanalyze_Range
call present in Analyze_Loop_Statement.
gcc/ada/ChangeLog:
* sem_util.adb (Get_Actual_Subtype): Only create a new subtype when
the expander is active. Remove a useless test of type inequality,
as well as a useless call to Set_Has_Delayed_Freeze on the subtype.
Diff:
---
gcc/ada/sem_util.adb | 60 ++++++++++++++++++----------------------------------
1 file changed, 21 insertions(+), 39 deletions(-)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 40bc6339fd9a..d1d2537c6d68 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10061,16 +10061,19 @@ package body Sem_Util is
and then not Has_Unknown_Discriminants (Utyp)
and then not (Ekind (Utyp) = E_String_Literal_Subtype)
then
- -- Nothing to do if in spec expression (why not???)
+ -- If the type has no discriminants, there is no subtype to build,
+ -- even if the underlying type is discriminated.
- if In_Spec_Expression then
+ if Is_Private_Type (Typ) and then not Has_Discriminants (Typ) then
return Typ;
- elsif Is_Private_Type (Typ) and then not Has_Discriminants (Typ) then
-
- -- If the type has no discriminants, there is no subtype to
- -- build, even if the underlying type is discriminated.
+ -- If we are performing preanalysis on a conjured-up copy of a name
+ -- (see calls to Preanalyze_Range in sem_ch5.adb) then we don't want
+ -- to freeze Atyp, now or ever. In this case, the tree we eventually
+ -- pass to the back end should contain no references to Atyp (and a
+ -- freeze node would contain such a reference).
+ elsif not Expander_Active then
return Typ;
-- Else build the actual subtype
@@ -10086,42 +10089,21 @@ package body Sem_Util is
Atyp := Defining_Identifier (Decl);
- -- If Build_Actual_Subtype generated a new declaration then use it
-
- if Atyp /= Typ then
-
- -- The actual subtype is an Itype, so analyze the declaration,
- -- but do not attach it to the tree, to get the type defined.
-
- Set_Parent (Decl, N);
- Set_Is_Itype (Atyp);
- Analyze (Decl, Suppress => All_Checks);
- Set_Associated_Node_For_Itype (Atyp, N);
- if Expander_Active then
- Set_Has_Delayed_Freeze (Atyp, False);
-
- -- We need to freeze the actual subtype immediately. This is
- -- needed because otherwise this Itype will not get frozen
- -- at all; it is always safe to freeze on creation because
- -- any associated types must be frozen at this point.
+ -- The actual subtype is an Itype, so analyze the declaration
+ -- after attaching it to the tree, to get the type defined.
- -- On the other hand, if we are performing preanalysis on
- -- a conjured-up copy of a name (see calls to
- -- Preanalyze_Range in sem_ch5.adb) then we don't want
- -- to freeze Atyp, now or ever. In this case, the tree
- -- we eventually pass to the back end should contain no
- -- references to Atyp (and a freeze node would contain
- -- such a reference). That's why Expander_Active is tested.
+ Set_Parent (Decl, N);
+ Set_Is_Itype (Atyp);
+ Analyze (Decl, Suppress => All_Checks);
+ Set_Associated_Node_For_Itype (Atyp, N);
- Freeze_Itype (Atyp, N);
- end if;
- return Atyp;
-
- -- Otherwise we did not build a declaration, so return original
+ -- We need to freeze the actual subtype immediately. This is
+ -- needed because otherwise this Itype will not get frozen
+ -- at all; it is always safe to freeze on creation because
+ -- any associated types must be frozen at this point.
- else
- return Typ;
- end if;
+ Freeze_Itype (Atyp, N);
+ return Atyp;
end if;
-- For all remaining cases, the actual subtype is the same as
