From a74d1bf6af0aaeb693cdbddf924c9af53f92b549 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 9 Jul 2019 07:54:05 +0000 Subject: [PATCH] [Ada] Spurious error when instance of generic is used as formal package This patch removes a spurious bug on the use of the current instance of a generic package G as the actual in a nested instantiation of a generic unit GU that has a formal package whose generic_package name is G. This is only legal if G has no generic formal part, and the formal package declaration is declared with a box or without a formal_paxkage_actual part. 2019-07-09 Ed Schonberg gcc/ada/ * sem_ch12.adb (Instantiate_Formal_Package): Handle properly the case where the actual for a formal package in an instance is the current instance of an enclosing generic package. (Check_Formal_Packages): If the formal package declaration is box-initialized or lacks associations altogether, no internal instance was created to verify conformance, and there is no validating package to remove from tree. gcc/testsuite/ * gnat.dg/generic_inst5.adb, gnat.dg/generic_inst6.adb, gnat.dg/generic_inst6_g1-c.adb, gnat.dg/generic_inst6_g1-c.ads, gnat.dg/generic_inst6_g1.ads, gnat.dg/generic_inst6_i1.ads, gnat.dg/generic_inst6_i2.ads, gnat.dg/generic_inst6_x.ads: New testcases. From-SVN: r273275 --- gcc/ada/ChangeLog | 10 +++++++ gcc/ada/sem_ch12.adb | 30 ++++++++++++++++++-- gcc/testsuite/ChangeLog | 8 ++++++ gcc/testsuite/gnat.dg/generic_inst5.adb | 20 +++++++++++++ gcc/testsuite/gnat.dg/generic_inst6.adb | 9 ++++++ gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb | 6 ++++ gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads | 3 ++ gcc/testsuite/gnat.dg/generic_inst6_g1.ads | 3 ++ gcc/testsuite/gnat.dg/generic_inst6_i1.ads | 2 ++ gcc/testsuite/gnat.dg/generic_inst6_i2.ads | 2 ++ gcc/testsuite/gnat.dg/generic_inst6_x.ads | 7 +++++ 11 files changed, 97 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/generic_inst5.adb create mode 100644 gcc/testsuite/gnat.dg/generic_inst6.adb create mode 100644 gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb create mode 100644 gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads create mode 100644 gcc/testsuite/gnat.dg/generic_inst6_g1.ads create mode 100644 gcc/testsuite/gnat.dg/generic_inst6_i1.ads create mode 100644 gcc/testsuite/gnat.dg/generic_inst6_i2.ads create mode 100644 gcc/testsuite/gnat.dg/generic_inst6_x.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b74910d2e1f..c80c9e46f23 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2019-07-09 Ed Schonberg + + * sem_ch12.adb (Instantiate_Formal_Package): Handle properly the + case where the actual for a formal package in an instance is the + current instance of an enclosing generic package. + (Check_Formal_Packages): If the formal package declaration is + box-initialized or lacks associations altogether, no internal + instance was created to verify conformance, and there is no + validating package to remove from tree. + 2019-07-09 Yannick Moy * freeze.adb (Build_Renamed_Body): Do not set body to inline in diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 0df4d96c9a2..9afa095c2a6 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6657,9 +6657,11 @@ package body Sem_Ch12 is Formal_Decl := Parent (Associated_Formal_Package (E)); -- Nothing to check if the formal has a box or an others_clause - -- (necessarily with a box). + -- (necessarily with a box), or no associations altogether - if Box_Present (Formal_Decl) then + if Box_Present (Formal_Decl) + or else No (Generic_Associations (Formal_Decl)) + then null; elsif Nkind (First (Generic_Associations (Formal_Decl))) = @@ -10309,8 +10311,11 @@ package body Sem_Ch12 is begin Analyze (Actual); + -- The actual must be a package instance, or else a current instance + -- such as a parent generic within the body of a generic child. + if not Is_Entity_Name (Actual) - or else Ekind (Entity (Actual)) /= E_Package + or else not Ekind_In (Entity (Actual), E_Package, E_Generic_Package) then Error_Msg_N ("expect package instance to instantiate formal", Actual); @@ -10354,6 +10359,14 @@ package body Sem_Ch12 is then null; + -- If this is the current instance of an enclosing generic, that + -- unit is the generic package we need. + + elsif In_Open_Scopes (Actual_Pack) + and then Ekind (Actual_Pack) = E_Generic_Package + then + null; + else Error_Msg_NE ("actual parameter must be instance of&", Actual, Gen_Parent); @@ -10487,6 +10500,17 @@ package body Sem_Ch12 is Next_Entity (Actual_Ent); end loop; + + -- No conformance to check if the generic has no formal parameters + -- and the formal package has no generic associations. + + if Is_Empty_List (Formals) + and then + (Box_Present (Formal) + or else No (Generic_Associations (Formal))) + then + return Decls; + end if; end; -- If the formal is not declared with a box, reanalyze it as an diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2941e438c43..af4a009af7c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-07-09 Ed Schonberg + + * gnat.dg/generic_inst5.adb, gnat.dg/generic_inst6.adb, + gnat.dg/generic_inst6_g1-c.adb, gnat.dg/generic_inst6_g1-c.ads, + gnat.dg/generic_inst6_g1.ads, gnat.dg/generic_inst6_i1.ads, + gnat.dg/generic_inst6_i2.ads, gnat.dg/generic_inst6_x.ads: New + testcases. + 2019-07-08 Martin Sebor PR middle-end/71924 diff --git a/gcc/testsuite/gnat.dg/generic_inst5.adb b/gcc/testsuite/gnat.dg/generic_inst5.adb new file mode 100644 index 00000000000..25e92f08200 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst5.adb @@ -0,0 +1,20 @@ +-- { dg-do compile } + +procedure Generic_Inst5 is + generic + package G1 is + end G1; + + generic + with package I1 is new G1; + package G2 is + end G2; + + package body G1 is + package I2 is new G2 (I1 => G1); + end G1; + + package I1 is new G1; +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/generic_inst6.adb b/gcc/testsuite/gnat.dg/generic_inst6.adb new file mode 100644 index 00000000000..780fae9c65e --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6.adb @@ -0,0 +1,9 @@ +-- { dg-do run } +with Text_IO; use Text_IO; +with Generic_Inst6_I2; +procedure Generic_Inst6 is +begin + if Generic_Inst6_I2.Check /= 49 then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb b/gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb new file mode 100644 index 00000000000..ed671f126d0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6_g1-c.adb @@ -0,0 +1,6 @@ +with Generic_Inst6_X; +package body Generic_Inst6_G1.C is + package N is new Generic_Inst6_X + (Generic_Inst6_G1, Generic_Inst6_G1); + function Check return Integer is (N.Result); +end; diff --git a/gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads b/gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads new file mode 100644 index 00000000000..c00d19d4152 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6_g1-c.ads @@ -0,0 +1,3 @@ +generic package Generic_Inst6_G1.C is + function Check return Integer; +end; diff --git a/gcc/testsuite/gnat.dg/generic_inst6_g1.ads b/gcc/testsuite/gnat.dg/generic_inst6_g1.ads new file mode 100644 index 00000000000..9beeb213534 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6_g1.ads @@ -0,0 +1,3 @@ +generic package Generic_Inst6_G1 is + Val : Integer := 7; + end; diff --git a/gcc/testsuite/gnat.dg/generic_inst6_i1.ads b/gcc/testsuite/gnat.dg/generic_inst6_i1.ads new file mode 100644 index 00000000000..016dfb7ace6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6_i1.ads @@ -0,0 +1,2 @@ +with Generic_Inst6_G1; +package Generic_Inst6_I1 is new Generic_Inst6_G1; diff --git a/gcc/testsuite/gnat.dg/generic_inst6_i2.ads b/gcc/testsuite/gnat.dg/generic_inst6_i2.ads new file mode 100644 index 00000000000..03abe22e145 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6_i2.ads @@ -0,0 +1,2 @@ +with Generic_Inst6_I1, Generic_Inst6_G1.C; +package Generic_Inst6_I2 is new Generic_Inst6_I1.C; diff --git a/gcc/testsuite/gnat.dg/generic_inst6_x.ads b/gcc/testsuite/gnat.dg/generic_inst6_x.ads new file mode 100644 index 00000000000..657dc414a82 --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst6_x.ads @@ -0,0 +1,7 @@ +with Generic_Inst6_G1; +generic + with package G2 is new Generic_Inst6_G1 (<>); + with package G3 is new Generic_Inst6_G1 (<>); +package Generic_Inst6_X is + Result : Integer := G2.Val * G3.Val; +end; -- 2.30.2