Fix internal error on extension with interface at -O2

This is a regression present on the mainline, 10 and 9 branches, in the
form of an internal error with the Ada compiler when a covariant-only
thunk is inlined into its caller.

gcc/ada/
	* gcc-interface/trans.c (make_covariant_thunk): Set the DECL_CONTEXT
	of the parameters and do not set TREE_PUBLIC on the thunk.
	(maybe_make_gnu_thunk): Pass the alias to the covariant thunk.
	* gcc-interface/utils.c (finish_subprog_decl): Set the DECL_CONTEXT
	of the parameters here...
	(begin_subprog_body): ...instead of here.

gcc/testsuite/
	* gnat.dg/thunk2.adb, gnat.dg/thunk2.ads: New test.
	* gnat.dg/thunk2_pkg.ads: New helper.
This commit is contained in:
Eric Botcazou 2021-01-25 11:27:29 +01:00
parent c6b0e33feb
commit 5d01fc7c11
5 changed files with 54 additions and 16 deletions

View file

@ -10612,7 +10612,7 @@ make_alias_for_thunk (tree target)
return alias;
}
/* Create the covariant part of the {GNAT,GNU}_THUNK. */
/* Create the local covariant part of {GNAT,GNU}_THUNK. */
static tree
make_covariant_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
@ -10623,6 +10623,11 @@ make_covariant_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
gnu_name, TREE_TYPE (gnu_thunk));
DECL_ARGUMENTS (gnu_cv_thunk) = copy_list (DECL_ARGUMENTS (gnu_thunk));
for (tree param_decl = DECL_ARGUMENTS (gnu_cv_thunk);
param_decl;
param_decl = DECL_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = gnu_cv_thunk;
DECL_RESULT (gnu_cv_thunk) = copy_node (DECL_RESULT (gnu_thunk));
DECL_CONTEXT (DECL_RESULT (gnu_cv_thunk)) = gnu_cv_thunk;
@ -10630,7 +10635,6 @@ make_covariant_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
DECL_CONTEXT (gnu_cv_thunk) = DECL_CONTEXT (gnu_thunk);
TREE_READONLY (gnu_cv_thunk) = TREE_READONLY (gnu_thunk);
TREE_THIS_VOLATILE (gnu_cv_thunk) = TREE_THIS_VOLATILE (gnu_thunk);
TREE_PUBLIC (gnu_cv_thunk) = TREE_PUBLIC (gnu_thunk);
DECL_ARTIFICIAL (gnu_cv_thunk) = 1;
return gnu_cv_thunk;
@ -10760,6 +10764,12 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
cgraph_node *target_node = cgraph_node::get_create (gnu_target);
/* We may also need to create an alias for the target in order to make
the call local, depending on the linkage of the target. */
tree gnu_alias = use_alias_for_thunk_p (gnu_target)
? make_alias_for_thunk (gnu_target)
: gnu_target;
/* If the return type of the target is a controlling type, then we need
both an usual this thunk and a covariant thunk in this order:
@ -10772,17 +10782,11 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
tree gnu_cv_thunk = make_covariant_thunk (gnat_thunk, gnu_thunk);
target_node->create_thunk (gnu_cv_thunk, gnu_target, false,
- fixed_offset, 0, 0,
NULL_TREE, gnu_target);
NULL_TREE, gnu_alias);
gnu_target = gnu_cv_thunk;
gnu_alias = gnu_target = gnu_cv_thunk;
}
/* We may also need to create an alias for the target in order to make
the call local, depending on the linkage of the target. */
tree gnu_alias = use_alias_for_thunk_p (gnu_target)
? make_alias_for_thunk (gnu_target)
: gnu_target;
target_node->create_thunk (gnu_thunk, gnu_target, true,
fixed_offset, virtual_value, indirect_offset,
virtual_offset, gnu_alias);

View file

@ -3521,6 +3521,12 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list,
void
finish_subprog_decl (tree decl, tree asm_name, tree type)
{
/* DECL_ARGUMENTS is set by the caller, but not its context. */
for (tree param_decl = DECL_ARGUMENTS (decl);
param_decl;
param_decl = DECL_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = decl;
tree result_decl
= build_decl (DECL_SOURCE_LOCATION (decl), RESULT_DECL, NULL_TREE,
TREE_TYPE (type));
@ -3566,8 +3572,6 @@ finish_subprog_decl (tree decl, tree asm_name, tree type)
void
begin_subprog_body (tree subprog_decl)
{
tree param_decl;
announce_function (subprog_decl);
/* This function is being defined. */
@ -3583,10 +3587,6 @@ begin_subprog_body (tree subprog_decl)
/* Enter a new binding level and show that all the parameters belong to
this function. */
gnat_pushlevel ();
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = DECL_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl;
}
/* Finish translating the current subprogram and set its BODY. */

View file

@ -0,0 +1,11 @@
-- { dg-do compile }
-- { dg-options "-O2" }
package body Thunk2 is
overriding function Element (Self : Ext; Name : String) return Ext is
begin
return Self;
end;
end Thunk2;

View file

@ -0,0 +1,12 @@
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Thunk2_Pkg; use Thunk2_Pkg;
package Thunk2 is
type Ext is new Root and I with record
S : Unbounded_String;
end record;
overriding function Element (Self : Ext; Name : String) return Ext;
end Thunk2;

View file

@ -0,0 +1,11 @@
package Thunk2_Pkg is
type Root is tagged record
A : Integer;
end record;
type I is interface;
function Element (Self : I; Name : String) return I is abstract;
end Thunk2_Pkg;