Fortran: Fix same_type_as

A test for CLASS(*) + assumed rank was missing; adding a test to
unlimited_polymorphic_1.f03 showed an ICE as backend_decl wasn't
set. While gfc_get_symbol_decl would fix it, the code also assumed
that the class(*) was a variable and could not be a subobject of
a derived type.

	PR fortran/71703
	PR fortran/84007

gcc/fortran/ChangeLog:

	* trans-intrinsic.c (gfc_conv_same_type_as): Fix handling
	of UNLIMITED_POLY.
	* trans.h (gfc_vtpr_hash_get): Renamed prototype to ...
	(gfc_vptr_hash_get): ... this to match function name.

gcc/testsuite/ChangeLog:

	* gfortran.dg/c-interop/c535b-1.f90: Remove wrong comment.
	* gfortran.dg/unlimited_polymorphic_1.f03: Extend.
	* gfortran.dg/unlimited_polymorphic_32.f90: New test.

2 files changed, 29 insertions, 15 deletions

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 900a1a2..2a2829c 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9126,21 +9126,14 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
   a = expr->value.function.actual->expr;
   b = expr->value.function.actual->next->expr;
 
-  if (UNLIMITED_POLY (a))
+  bool unlimited_poly_a = UNLIMITED_POLY (a);
+  bool unlimited_poly_b = UNLIMITED_POLY (b);
+  if (unlimited_poly_a)
     {
-      tmp = gfc_class_vptr_get (a->symtree->n.sym->backend_decl);
-      conda = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-			       tmp, build_int_cst (TREE_TYPE (tmp), 0));
-    }
-
-  if (UNLIMITED_POLY (b))
-    {
-      tmp = gfc_class_vptr_get (b->symtree->n.sym->backend_decl);
-      condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-			       tmp, build_int_cst (TREE_TYPE (tmp), 0));
+      se1.want_pointer = 1;
+      gfc_add_vptr_component (a);
     }
-
-  if (a->ts.type == BT_CLASS)
+  else if (a->ts.type == BT_CLASS)
     {
       gfc_add_vptr_component (a);
       gfc_add_hash_component (a);
@@ -9149,7 +9142,12 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
     a = gfc_get_int_expr (gfc_default_integer_kind, NULL,
 			  a->ts.u.derived->hash_value);
 
-  if (b->ts.type == BT_CLASS)
+  if (unlimited_poly_b)
+    {
+      se2.want_pointer = 1;
+      gfc_add_vptr_component (b);
+    }
+  else if (b->ts.type == BT_CLASS)
     {
       gfc_add_vptr_component (b);
       gfc_add_hash_component (b);
@@ -9161,6 +9159,22 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
   gfc_conv_expr (&se1, a);
   gfc_conv_expr (&se2, b);
 
+  if (unlimited_poly_a)
+    {
+      conda = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+			       se1.expr,
+			       build_int_cst (TREE_TYPE (se1.expr), 0));
+      se1.expr = gfc_vptr_hash_get (se1.expr);
+    }
+
+  if (unlimited_poly_b)
+    {
+      condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+			       se2.expr,
+			       build_int_cst (TREE_TYPE (se2.expr), 0));
+      se2.expr = gfc_vptr_hash_get (se2.expr);
+    }
+
   tmp = fold_build2_loc (input_location, EQ_EXPR,
 			 logical_type_node, se1.expr,
 			 fold_convert (TREE_TYPE (se1.expr), se2.expr));
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 53f0f86..fa3e865 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -438,7 +438,7 @@ tree gfc_class_vtab_def_init_get (tree);
 tree gfc_class_vtab_copy_get (tree);
 tree gfc_class_vtab_final_get (tree);
 /* Get an accessor to the vtab's * field, when a vptr handle is present.  */
-tree gfc_vtpr_hash_get (tree);
+tree gfc_vptr_hash_get (tree);
 tree gfc_vptr_size_get (tree);
 tree gfc_vptr_extends_get (tree);
 tree gfc_vptr_def_init_get (tree);