[gcc r10-9298] Fix internal error on extension with interface at -O2

[gcc r10-9298] Fix internal error on extension with interface at -O2

[Eric Botcazou]

https://gcc.gnu.org/g:beebe1908fa7695615ff5237c6e9e2e46e866b14

commit r10-9298-gbeebe1908fa7695615ff5237c6e9e2e46e866b14
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Mon Jan 25 11:27:29 2021 +0100

    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.

Diff:
---
 gcc/ada/gcc-interface/trans.c        | 24 ++++++++++++++----------
 gcc/ada/gcc-interface/utils.c        | 12 ++++++------
 gcc/testsuite/gnat.dg/thunk2.adb     | 11 +++++++++++
 gcc/testsuite/gnat.dg/thunk2.ads     | 12 ++++++++++++
 gcc/testsuite/gnat.dg/thunk2_pkg.ads | 11 +++++++++++
 5 files changed, 54 insertions(+), 16 deletions(-)

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 0e8e04a9ca4..7ecf321c250 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -11188,7 +11188,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)
@@ -11199,6 +11199,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;
 
@@ -11206,7 +11211,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;
@@ -11336,6 +11340,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:
 
@@ -11348,17 +11358,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);
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 87726cbd475..9124d737f77 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3416,6 +3416,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));
@@ -3461,8 +3467,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.  */
@@ -3478,10 +3482,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.  */
diff --git a/gcc/testsuite/gnat.dg/thunk2.adb b/gcc/testsuite/gnat.dg/thunk2.adb
new file mode 100644
index 00000000000..96ed883bfab
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/thunk2.adb
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/thunk2.ads b/gcc/testsuite/gnat.dg/thunk2.ads
new file mode 100644
index 00000000000..05dc45bc74b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/thunk2.ads
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/thunk2_pkg.ads b/gcc/testsuite/gnat.dg/thunk2_pkg.ads
new file mode 100644
index 00000000000..75799892ed8
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/thunk2_pkg.ads
@@ -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;