[Ada] Hang on expansion of library-level instantiation

This patch fixes an issue whereby instantiation of a generic at the
library-level may cause a hang or crash during compilation due to
inappropriate expansion of generic actuals.

2019-07-04  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* sem_ch12.adb (Perform_Appropriate_Analysis): Added for
	selecting which type of analysis based on wheither the
	instantiation is a generic at the library-level. In which case
	expansion during analysis.
	(Preanalyze_Actuals): Modify calls to Analyze to use the new
	routine.

gcc/testsuite/

	* gnat.dg/generic_inst4.adb, gnat.dg/generic_inst4_gen.ads,
	gnat.dg/generic_inst4_inst.ads, gnat.dg/generic_inst4_typ.ads:
	New testcase.

From-SVN: r273054

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c60ab6dec793f079bad0c5add54db0a4781e50af..597e3311506f526621c08881d3255789546c9706 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-07-04  Justin Squirek  <squirek@adacore.com>
+
+       * sem_ch12.adb (Perform_Appropriate_Analysis): Added for
+       selecting which type of analysis based on wheither the
+       instantiation is a generic at the library-level. In which case
+       expansion during analysis.
+       (Preanalyze_Actuals): Modify calls to Analyze to use the new
+       routine.
+
 2019-07-04  Ed Schonberg  <schonberg@adacore.com>
 
        * exp_unst.adb: Handle conditional expressions.

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 42feab07ae3230ebb7e54186dcee263ab0c5961d..43beb8303481b528d533ead2edbeab9d36ecaa1a 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -14103,6 +14103,29 @@ package body Sem_Ch12 is
    ------------------------
 
    procedure Preanalyze_Actuals (N : Node_Id; Inst : Entity_Id := Empty) is
+
+      procedure Perform_Appropriate_Analysis (N : Node_Id);
+      --  Determine if the actuals we are analyzing come from a generic
+      --  instantiation that is a library unit and dispatch accordingly.
+
+      ----------------------------------
+      -- Perform_Appropriate_Analysis --
+      ----------------------------------
+
+      procedure Perform_Appropriate_Analysis (N : Node_Id) is
+      begin
+         --  When we have a library instantiation we cannot allow any expansion
+         --  to occur, since there may be no place to put it. Instead, in that
+         --  case we perform a preanalysis of the actual.
+
+         if Present (Inst) and then Is_Compilation_Unit (Inst) then
+            Preanalyze (N);
+
+         else
+            Analyze (N);
+         end if;
+      end Perform_Appropriate_Analysis;
+
       Assoc : Node_Id;
       Act   : Node_Id;
       Errs  : constant Nat := Serious_Errors_Detected;
@@ -14113,6 +14136,8 @@ package body Sem_Ch12 is
       Vis : Boolean := False;
       --  Saved visibility status of the current homograph
 
+   --  Start of processing for Preanalyze_Actuals
+
    begin
       Assoc := First (Generic_Associations (N));
 
@@ -14154,10 +14179,10 @@ package body Sem_Ch12 is
                null;
 
             elsif Nkind (Act) = N_Attribute_Reference then
-               Analyze (Prefix (Act));
+               Perform_Appropriate_Analysis (Prefix (Act));
 
             elsif Nkind (Act) = N_Explicit_Dereference then
-               Analyze (Prefix (Act));
+               Perform_Appropriate_Analysis (Prefix (Act));
 
             elsif Nkind (Act) = N_Allocator then
                declare
@@ -14165,7 +14190,7 @@ package body Sem_Ch12 is
 
                begin
                   if Nkind (Expr) = N_Subtype_Indication then
-                     Analyze (Subtype_Mark (Expr));
+                     Perform_Appropriate_Analysis (Subtype_Mark (Expr));
 
                      --  Analyze separately each discriminant constraint, when
                      --  given with a named association.
@@ -14177,9 +14202,10 @@ package body Sem_Ch12 is
                         Constr := First (Constraints (Constraint (Expr)));
                         while Present (Constr) loop
                            if Nkind (Constr) = N_Discriminant_Association then
-                              Analyze (Expression (Constr));
+                              Perform_Appropriate_Analysis
+                                (Expression (Constr));
                            else
-                              Analyze (Constr);
+                              Perform_Appropriate_Analysis (Constr);
                            end if;
 
                            Next (Constr);
@@ -14187,12 +14213,12 @@ package body Sem_Ch12 is
                      end;
 
                   else
-                     Analyze (Expr);
+                     Perform_Appropriate_Analysis (Expr);
                   end if;
                end;
 
             elsif Nkind (Act) /= N_Operator_Symbol then
-               Analyze (Act);
+               Perform_Appropriate_Analysis (Act);
 
                --  Within a package instance, mark actuals that are limited
                --  views, so their use can be moved to the body of the
@@ -14213,7 +14239,7 @@ package body Sem_Ch12 is
                --  warnings complaining about the generic being unreferenced,
                --  before abandoning the instantiation.
 
-               Analyze (Name (N));
+               Perform_Appropriate_Analysis (Name (N));
 
                if Is_Entity_Name (Name (N))
                  and then Etype (Name (N)) /= Any_Type

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 714748238dae40dd37a9927460b5f7c4ded9b13a..cf953b5af8c479cf6192d2364e78cf67e363f399 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-07-04  Justin Squirek  <squirek@adacore.com>
+
+       * gnat.dg/generic_inst4.adb, gnat.dg/generic_inst4_gen.ads,
+       gnat.dg/generic_inst4_inst.ads, gnat.dg/generic_inst4_typ.ads:
+       New testcase.
+
 2019-07-04  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/dimensions2.adb, gnat.dg/dimensions2_phys.ads,

diff --git a/gcc/testsuite/gnat.dg/generic_inst4.adb b/gcc/testsuite/gnat.dg/generic_inst4.adb
new file mode 100644 (file)
index 0000000..c1b2496
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst4.adb
@@ -0,0 +1,7 @@
+--  { dg-do compile }
+
+with Generic_Inst4_Inst;
+procedure Generic_Inst4 is
+begin
+   null;
+end;

diff --git a/gcc/testsuite/gnat.dg/generic_inst4_gen.ads b/gcc/testsuite/gnat.dg/generic_inst4_gen.ads
new file mode 100644 (file)
index 0000000..a1c039e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst4_gen.ads
@@ -0,0 +1,3 @@
+generic
+  Param : String;
+package Generic_Inst4_Gen is end;

diff --git a/gcc/testsuite/gnat.dg/generic_inst4_inst.ads b/gcc/testsuite/gnat.dg/generic_inst4_inst.ads
new file mode 100644 (file)
index 0000000..1660d67
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst4_inst.ads
@@ -0,0 +1,5 @@
+with Generic_Inst4_Gen;
+with Generic_Inst4_Typ; use Generic_Inst4_Typ;
+package Generic_Inst4_Inst is new Generic_Inst4_Gen (
+   Param => "SHARING;" & --  ERROR
+     Generic_Inst4_Typ.New_Int'image (Generic_Inst4_Typ.T'size/8));

diff --git a/gcc/testsuite/gnat.dg/generic_inst4_typ.ads b/gcc/testsuite/gnat.dg/generic_inst4_typ.ads
new file mode 100644 (file)
index 0000000..5f80029
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst4_typ.ads
@@ -0,0 +1,7 @@
+package Generic_Inst4_Typ is
+   subtype New_Int is Natural;
+   type T is
+      record
+         X : Integer;
+      end record;
+end;