[gcc r12-6419] Fortran: Pass unlimited polymorphic argument to assumed type [PR103366].

[Paul Thomas]

https://gcc.gnu.org/g:828474fafd2ed33430172fe227f9da7d6fb98723

commit r12-6419-g828474fafd2ed33430172fe227f9da7d6fb98723
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Mon Jan 10 16:54:53 2022 +0000

    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:
---
 gcc/fortran/trans-expr.c               | 18 ++++++++++++++----
 gcc/testsuite/gfortran.dg/pr103366.f90 | 17 +++++++++++++++++
 2 files changed, 31 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 381915e2a76..2e15a7e874c 100644
--- 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
index 00000000000..d5d25dece09
--- /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