From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch12.adb | 3 +--
gcc/ada/sem_ch3.adb | 5 +++++
gcc/ada/sem_ch4.adb | 34 ++++++++++++++++++++++++++++++++++
3 files changed, 40 insertions(+), 2 deletions(-)
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
--
2.53.0
