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 600e3f055b1b95b87d1579da524d1525583529e5..914df9d8d489ab863153d7c0f3035c59e35c08f8 100644 (file)
--- 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 18bcf5181fae75eb7acf95e3a2ec7a6c1f785f3d..180bd30c0df5a5136b8275fd8d24129579f46e8d 100644 (file)
--- 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 1ea77679ef315a6410a06cf34039cc3af3c42c87..6e7828b9977451e6b477e315aa93cba33382d383 100644 (file)
--- 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