[Ada] Fix spurious type mismatch failure on nested instantiations
This fixes a spurious type mismatch failure reported between formal and actual of a call to a subprogram that comes from the instantiation of a child generic unit that itself contains an instantiation of a slibling child generic unit, when the parent is itself a generic unit with private part. The regression was introduced by a recent change made to clear the Is_Generic_Actual_Type on the implicit full view built when a generic package is instantiated on a private type. 2019-09-19 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * sem_ch12.adb (Restore_Private_Views): Comment out new code that clear the Is_Generic_Actual_Type also on the full view. gcc/testsuite/ * gnat.dg/generic_inst13.adb, gnat.dg/generic_inst13_pkg-nested_g.ads, gnat.dg/generic_inst13_pkg-ops_g.ads, gnat.dg/generic_inst13_pkg.ads: New testcase. From-SVN: r275935
This commit is contained in:
parent
682c09ceba
commit
4af04d04c4
|
@ -1,3 +1,8 @@
|
|||
2019-09-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sem_ch12.adb (Restore_Private_Views): Comment out new code
|
||||
that clear the Is_Generic_Actual_Type also on the full view.
|
||||
|
||||
2019-09-19 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Rewrite_As_Renaming): Return False if there are
|
||||
|
|
|
@ -14638,9 +14638,17 @@ package body Sem_Ch12 is
|
|||
else
|
||||
Set_Is_Generic_Actual_Type (E, False);
|
||||
|
||||
if Is_Private_Type (E) and then Present (Full_View (E)) then
|
||||
Set_Is_Generic_Actual_Type (Full_View (E), False);
|
||||
end if;
|
||||
-- It might seem reasonable to clear the Is_Generic_Actual_Type
|
||||
-- flag also on the Full_View if the type is private, since it
|
||||
-- was set also on this Full_View. However, this flag is relied
|
||||
-- upon by Covers to spot "types exported from instantiations"
|
||||
-- which are implicit Full_Views built for instantiations made
|
||||
-- on private types and we get type mismatches if we do it when
|
||||
-- the block exchanging the declarations below triggers ???
|
||||
|
||||
-- if Is_Private_Type (E) and then Present (Full_View (E)) then
|
||||
-- Set_Is_Generic_Actual_Type (Full_View (E), False);
|
||||
-- end if;
|
||||
end if;
|
||||
|
||||
-- An unusual case of aliasing: the actual may also be directly
|
||||
|
|
|
@ -1,3 +1,10 @@
|
|||
2019-09-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/generic_inst13.adb,
|
||||
gnat.dg/generic_inst13_pkg-nested_g.ads,
|
||||
gnat.dg/generic_inst13_pkg-ops_g.ads,
|
||||
gnat.dg/generic_inst13_pkg.ads: New testcase.
|
||||
|
||||
2019-09-19 Bob Duff <duff@adacore.com>
|
||||
|
||||
* gnat.dg/concat3.adb: New testcase.
|
||||
|
|
|
@ -0,0 +1,22 @@
|
|||
-- { dg-do compile }
|
||||
|
||||
with Generic_Inst13_Pkg;
|
||||
with Generic_Inst13_Pkg.Nested_G;
|
||||
|
||||
procedure Generic_Inst13 is
|
||||
|
||||
type Item_T is range 1 .. 16;
|
||||
|
||||
package My_Inst is new Generic_Inst13_Pkg (Item_T);
|
||||
|
||||
package My_Nested is new My_Inst.Nested_G;
|
||||
|
||||
procedure Proc (Left, Right : My_Nested.T) is
|
||||
R : constant My_Nested.List_T := My_Nested."or" (Left, Right);
|
||||
begin
|
||||
null;
|
||||
end;
|
||||
|
||||
begin
|
||||
null;
|
||||
end;
|
|
@ -0,0 +1,14 @@
|
|||
with Generic_Inst13_Pkg.Ops_G;
|
||||
|
||||
generic
|
||||
package Generic_Inst13_Pkg.Nested_G is
|
||||
|
||||
type T is new Generic_Inst13_Pkg.T;
|
||||
|
||||
package My_Operations is new Generic_Inst13_Pkg.Ops_G (T);
|
||||
|
||||
subtype List_T is My_Operations.List_T;
|
||||
|
||||
function "or" (Left, Right : T) return List_T renames My_Operations."or";
|
||||
|
||||
end Generic_Inst13_Pkg.Nested_G;
|
|
@ -0,0 +1,9 @@
|
|||
generic
|
||||
type Data_T is private;
|
||||
package Generic_Inst13_Pkg.Ops_G is
|
||||
|
||||
type List_T is array (Positive range <>) of Data_T;
|
||||
|
||||
function "or" (Left, Right : Data_T) return List_T is ((Left, Right));
|
||||
|
||||
end Generic_Inst13_Pkg.Ops_G;
|
|
@ -0,0 +1,11 @@
|
|||
generic
|
||||
type Component_T is private;
|
||||
package Generic_Inst13_Pkg is
|
||||
|
||||
type T is private;
|
||||
|
||||
private
|
||||
|
||||
type T is array (Boolean) of Component_T;
|
||||
|
||||
end Generic_Inst13_Pkg;
|
Loading…
Reference in New Issue