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);
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);
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:
--- /dev/null
+! { 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