From: Justin Squirek Date: Thu, 4 Jul 2019 08:05:55 +0000 (+0000) Subject: [Ada] Hang on expansion of library-level instantiation X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7273107b948b81edc084b33e8e8fd4f3b4115f72;p=gcc.git [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 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 c60ab6dec79..597e3311506 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-07-04 Justin Squirek + + * 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 * exp_unst.adb: Handle conditional expressions. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 42feab07ae3..43beb830348 100644 --- 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 714748238da..cf953b5af8c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-07-04 Justin Squirek + + * 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 * 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 index 00000000000..c1b2496f0f4 --- /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 index 00000000000..a1c039ef916 --- /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 index 00000000000..1660d67e825 --- /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 index 00000000000..5f80029aebc --- /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;