Fortran: Pass unlimited polymorphic argument to assumed type [PR103366].

2022-01-10  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/103366
	* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Allow unlimited
	polymorphic actual argument passed to assumed type formal.

gcc/testsuite/
	PR fortran/103366
	* gfortran.dg/pr103366.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 381915e2a766658b1d83bbf36ca3915a1e845380..2e15a7e874cc35c836c76da26dcb7c43d8c67383 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -50,10 +50,10 @@ static tree
 gfc_get_character_len (tree type)
 {
   tree len;
-  
+
   gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE
              && TYPE_STRING_FLAG (type));
-  
+
   len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
   len = (len) ? (len) : (integer_zero_node);
   return fold_convert (gfc_charlen_type_node, len);
@@ -67,10 +67,10 @@ tree
 gfc_get_character_len_in_bytes (tree type)
 {
   tree tmp, len;
-  
+
   gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE
              && TYPE_STRING_FLAG (type));
-  
+
   tmp = TYPE_SIZE_UNIT (TREE_TYPE (type));
   tmp = (tmp && !integer_zerop (tmp))
     ? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE);
@@ -5630,6 +5630,16 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
          itype = CFI_type_other;  // FIXME: Or CFI_type_cptr ?
          break;
        case BT_CLASS:
+         if (UNLIMITED_POLY (e) && fsym->ts.type == BT_ASSUMED)
+           {
+             // F2017: 7.3.2.2: "An entity that is declared using the TYPE(*)
+             // type specifier is assumed-type and is an unlimited polymorphic
+             //  entity." The actual argument _data component is passed.
+             itype = CFI_type_other;  // FIXME: Or CFI_type_cptr ?
+             break;
+           }
+         else
+           gcc_unreachable ();
        case BT_PROCEDURE:
        case BT_HOLLERITH:
        case BT_UNION:

diff --git a/gcc/testsuite/gfortran.dg/pr103366.f90 b/gcc/testsuite/gfortran.dg/pr103366.f90
new file mode 100644 (file)
index 0000000..d5d25de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103366.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! Test the fix for PR103366.
+!
+! Contributed by Gerhardt Steinmetz  <gscfq@t-online.de>
+!
+program p
+  call u([1])
+contains
+   subroutine s(x) bind(c)
+      type(*) :: x(..)
+   end
+   subroutine u(x)
+      class(*) :: x(..)
+      call s(x)         ! Used to ICE here
+   end
+end