+2019-07-09 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <moy@adacore.com>
* freeze.adb (Build_Renamed_Body): Do not set body to inline in
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))) =
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);
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);
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
+2019-07-09 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <msebor@redhat.com>
PR middle-end/71924
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+generic package Generic_Inst6_G1.C is
+ function Check return Integer;
+end;
--- /dev/null
+generic package Generic_Inst6_G1 is
+ Val : Integer := 7;
+ end;
--- /dev/null
+with Generic_Inst6_G1;
+package Generic_Inst6_I1 is new Generic_Inst6_G1;
--- /dev/null
+with Generic_Inst6_I1, Generic_Inst6_G1.C;
+package Generic_Inst6_I2 is new Generic_Inst6_I1.C;
--- /dev/null
+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;