From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 25 May 2026 20:40:20 +0000 (+0200)
Subject: ada: Reject structural instantiation in generic formal part
X-Git-Url: http://git.ipfire.org/gitweb/index.cgi?a=commitdiff_plain;h=4b6b4e9d3bde8ea71d65a4ae83ac522c8396b919;p=thirdparty%2Fgcc.git

ada: Reject structural instantiation in generic formal part

The structural instance would amount to a formal package in this context,
and that's totally unsupported by the current implementation.

gcc/ada/ChangeLog:

	* sem_ch3.adb (Analyze_Private_Extension_Declaration): Be prepared
	for Find_Type_Of_Subtype_Indic returning no type.
	* sem_ch4.adb (Process_Generic_Instantiation): Give an error if the
	generic instantation is referenced in a generic formal part.
	* sem_ch12.adb (Analyze_Formal_Derived_Type): Return early in every
	case of serious errors.
---

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 600e3f055b1..914df9d8d48 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3220,8 +3220,7 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      if Subtype_Mark (Def) in Empty | Error then
-         pragma Assert (Serious_Errors_Detected > 0);
+      if Serious_Errors_Detected > 0 then
          --  avoid passing bad argument to Entity
          return;
       end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 18bcf5181fa..180bd30c0df 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5578,6 +5578,11 @@ package body Sem_Ch3 is
       end if;
 
       Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
+      if No (Parent_Type) then
+         pragma Assert (Serious_Errors_Detected > 0);
+         goto Leave;
+      end if;
+
       Parent_Base := Base_Type (Parent_Type);
 
       if Parent_Type = Any_Type or else Etype (Parent_Type) = Any_Type then
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 1ea77679ef3..6e7828b9977 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3068,8 +3068,42 @@ package body Sem_Ch4 is
          Act_List : List_Id;
          Expr     : Node_Id;
          Inst_Id  : Entity_Id;
+         Par      : Node_Id;
+         Prev_Par : Node_Id;
 
       begin
+         Prev_Par := N;
+         Par := Parent (N);
+
+         --  A structural instance cannot be used as a formal package with the
+         --  current implementation of structural instantiation.
+
+         while Present (Par) loop
+            if Nkind (Par) in N_Generic_Declaration
+              and then Is_List_Member (Prev_Par)
+              and then
+                Generic_Formal_Declarations (Par) = List_Containing (Prev_Par)
+            then
+               Error_Msg_N
+                 ("structural instantiation cannot be used in generic formal"
+                  & " part", N);
+               Rewrite (N,
+                 Make_Raise_Program_Error (Sloc (N),
+                   Reason => PE_Explicit_Raise));
+               Analyze (N);
+               return;
+
+            else
+               --  Prevent the search from going too far
+
+               exit when Is_Statement (Par)
+                 or else Is_Body_Or_Package_Declaration (Par);
+            end if;
+
+            Prev_Par := Par;
+            Par := Parent (Par);
+         end loop;
+
          Act_List := New_List;
          Expr := First (Expressions (N));
          while Present (Expr) loop