diff options
| author | Sandra Loosemore <sandra@codesourcery.com> | 2021-09-22 07:49:17 -0700 |
|---|---|---|
| committer | Sandra Loosemore <sandra@codesourcery.com> | 2021-09-22 17:11:08 -0700 |
| commit | 5098e7077bfcace3e80144e63c81be94546ced16 (patch) | |
| tree | 86156567bd1111cba2dbc74ddd8dc7b5c3f9a069 /gcc/fortran/interface.c | |
| parent | 7a40f2e74815a926c5f47416c29efbc17aa1ef43 (diff) | |
| download | gcc-5098e7077bfcace3e80144e63c81be94546ced16.zip gcc-5098e7077bfcace3e80144e63c81be94546ced16.tar.gz gcc-5098e7077bfcace3e80144e63c81be94546ced16.tar.bz2 | |
Fortran: diagnostic for argument w/type parameters for assumed-type dummy
2021-09-22 Sandra Loosemore <sandra@codesourcery.com>
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.
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 20 |
1 files changed, 10 insertions, 10 deletions
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; |