]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix wrong indirect access to bit-packed array in iterated loop
authorEric Botcazou <ebotcazou@adacore.com>
Wed, 2 Jul 2025 13:25:55 +0000 (15:25 +0200)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Tue, 22 Jul 2025 10:10:00 +0000 (12:10 +0200)
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.

gcc/ada/sem_util.adb

index 7757e04b2a1fcbd5aa847920e64871f3c8d6184a..3fced544fb5ff1ee15f92467e6466e680e7800fd 100644 (file)
@@ -9990,16 +9990,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
@@ -10015,42 +10018,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