From 5098e7077bfcace3e80144e63c81be94546ced16 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Wed, 22 Sep 2021 07:49:17 -0700 Subject: Fortran: diagnostic for argument w/type parameters for assumed-type dummy 2021-09-22 Sandra Loosemore PR fortran/101319 gcc/fortran/ * interface.c (gfc_compare_actual_formal): Extend existing assumed-type diagnostic to also check for argument with type parameters. gcc/testsuite/ * gfortran.dg/c-interop/assumed-type-dummy.f90: Remove xfail. --- gcc/fortran/interface.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f9a7c9c..dae4b95 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3183,21 +3183,21 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, is_elemental, where)) return false; - /* TS 29113, 6.3p2. */ + /* TS 29113, 6.3p2; F2018 15.5.2.4. */ if (f->sym->ts.type == BT_ASSUMED && (a->expr->ts.type == BT_DERIVED || (a->expr->ts.type == BT_CLASS && CLASS_DATA (a->expr)))) { - gfc_namespace *f2k_derived; - - f2k_derived = a->expr->ts.type == BT_DERIVED - ? a->expr->ts.u.derived->f2k_derived - : CLASS_DATA (a->expr)->ts.u.derived->f2k_derived; - - if (f2k_derived - && (f2k_derived->finalizers || f2k_derived->tb_sym_root)) + gfc_symbol *derived = (a->expr->ts.type == BT_DERIVED + ? a->expr->ts.u.derived + : CLASS_DATA (a->expr)->ts.u.derived); + gfc_namespace *f2k_derived = derived->f2k_derived; + if (derived->attr.pdt_type + || (f2k_derived + && (f2k_derived->finalizers || f2k_derived->tb_sym_root))) { - gfc_error ("Actual argument at %L to assumed-type dummy is of " + gfc_error ("Actual argument at %L to assumed-type dummy " + "has type parameters or is of " "derived type with type-bound or FINAL procedures", &a->expr->where); return false; -- cgit v1.1