[Bug ada/124507] New: Implicit_Dereference causes bogus Program_Error

[liam at liampwll dot com via Gcc-bugs]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=124507

            Bug ID: 124507
           Summary: Implicit_Dereference causes bogus Program_Error
           Product: gcc
           Version: 15.2.1
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
          Assignee: unassigned at gcc dot gnu.org
          Reporter: liam at liampwll dot com
                CC: dkm at gcc dot gnu.org
  Target Milestone: ---

I don't have a clue what causes this bug so I'll refer you to the code at the
end of this message rather than trying to explain the bug. This bug comes from
my own static analysis tool which is not ready to be shared publicly yet,
however I can share a larger part of the below pointer system if required.

Since this is a standalone project rather than a library I don't mind just
setting up the build system to apply the workaround as a preprocessing step, so
if there's no interest in fixing this then that's fine. I suspect this is a bug
that no one else is ever likely to hit as I am doing very questionable things
with generics here.

With assertions enabled the below code produces the following:

| 15.2.1 20260309 (x86_64-pc-linux-gnu) GCC error:                         |
| in build_component_ref, at ada/gcc-interface/utils2.cc:2314              |
| Error detected at example.adb:60:29                                      |

With assertions disabled the below code produces a bogus Program_Error:

raised PROGRAM_ERROR : example.adb:60 explicit raise
0x405433 Example at example.adb:60
0x4073ab Main at b__example.adb:249

I have also seen the following error in the full program where this is from
which I suspect is the same bug presenting in a different way:

| 15.2.1 20260309 (x86_64-pc-linux-gnu) Assert_Failure sem_res.adb:11493   |

Lastly you can see a workaround for a different name resolution bug in the
code, but I have not dug into the RM enough to confirm that this is really a
bug yet.

Reproducer follows:

pragma Ada_2022;

procedure Example is

   package P is
      type Root is tagged null record;

      type Access_Root_Class is access Root'Class;

      type Root_Ref is tagged record
         Block : Access_Root_Class;
      end record;

      function Create (Value : Root'Class) return Root_Ref
      is (Block => new Root'Class'(Value));
   end P;

   use P;

   generic
      type T (<>) is abstract new Root with private;
      type Parent_Ref is new Root_Ref with private;
   package Pointers is
      type Ref is new Parent_Ref with null record;

      not overriding
      function Create (Value : T) return Ref
      is (Parent_Ref'(Create (Value)) with null record);

      type Reference_Type (Data : access T) is limited null record
      with Implicit_Dereference => Data;

      function Get (This : Ref) return Reference_Type
      is (Data => T (This.Block.all)'Access);

      package Workaround is
         function Create (Value : T) return Ref
         is (Parent_Ref'(Create (Value)) with null record);

         function Get (This : Ref) return Reference_Type
         is (Data => T (This.Block.all)'Access);
      end Workaround;
   end Pointers;

   type Derived_A is abstract new Root with null record;

   type Derived_B is new Derived_A with record
      X : Integer;
   end record;

   package A_Pointers is new Pointers (Derived_A, Root_Ref);
   package B_Pointers is new Pointers (Derived_B, A_Pointers.Ref);

   --  X : B_Pointers.Ref :=
   --    B_Pointers.Create (Derived_B'(Derived_A with X => 123));
   X : B_Pointers.Ref :=
     B_Pointers.Workaround.Create (Derived_B'(Derived_A with X => 123));

   --  Y : Integer := X.Get.Data.X;
   Y : Integer := B_Pointers.Get (X).Data.X;
   --  Y : Integer := B_Pointers.Workaround.Get (X).Data.X;
begin
   null;
end Example;