diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-03-14 20:23:06 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-03-15 20:22:29 +0100 |
| commit | 901edd99b44976b3c2b13a7d525d9e315540186a (patch) | |
| tree | d8f6485d1c8aa049cd067745f44adca793b9b2a5 /gcc/fortran/interface.cc | |
| parent | be20dcc359bcc4677c5b9ce011d3cd7b4ce94a64 (diff) | |
| download | gcc-901edd99b44976b3c2b13a7d525d9e315540186a.zip gcc-901edd99b44976b3c2b13a7d525d9e315540186a.tar.gz gcc-901edd99b44976b3c2b13a7d525d9e315540186a.tar.bz2 | |
Fortran: rank checking with explicit-/assumed-size arrays and CLASS [PR58331]
gcc/fortran/ChangeLog:
PR fortran/58331
* interface.cc (compare_parameter): Adjust check of array dummy
arguments to handle the case of CLASS variables.
gcc/testsuite/ChangeLog:
PR fortran/58331
* gfortran.dg/class_dummy_10.f90: New test.
Co-authored-by: Tobias Burnus <tobias@codesourcery.com>
Diffstat (limited to 'gcc/fortran/interface.cc')
| -rw-r--r-- | gcc/fortran/interface.cc | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index dafe417..db79b10 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -2349,6 +2349,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, char err[200]; gfc_component *ppc; bool codimension = false; + gfc_array_spec *formal_as; /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding procs c_f_pointer or c_f_procpointer, and we need to accept most @@ -2540,6 +2541,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } + formal_as = (formal->ts.type == BT_CLASS + ? CLASS_DATA (formal)->as : formal->as); + if (codimension && formal->attr.allocatable) { gfc_ref *last = NULL; @@ -2650,10 +2654,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (symbol_rank (formal) == actual->rank || symbol_rank (formal) == -1) return true; - rank_check = where != NULL && !is_elemental && formal->as - && (formal->as->type == AS_ASSUMED_SHAPE - || formal->as->type == AS_DEFERRED) - && actual->expr_type != EXPR_NULL; + rank_check = where != NULL && !is_elemental && formal_as + && (formal_as->type == AS_ASSUMED_SHAPE + || formal_as->type == AS_DEFERRED) + && actual->expr_type != EXPR_NULL; /* Skip rank checks for NO_ARG_CHECK. */ if (formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) @@ -2662,14 +2666,20 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, /* Scalar & coindexed, see: F2008, Section 12.5.2.4. */ if (rank_check || ranks_must_agree || (formal->attr.pointer && actual->expr_type != EXPR_NULL) - || (actual->rank != 0 && !(is_elemental || formal->attr.dimension)) + || (actual->rank != 0 + && !(is_elemental || formal->attr.dimension + || (formal->ts.type == BT_CLASS + && CLASS_DATA (formal)->attr.dimension))) || (actual->rank == 0 && ((formal->ts.type == BT_CLASS && CLASS_DATA (formal)->as->type == AS_ASSUMED_SHAPE) || (formal->ts.type != BT_CLASS && formal->as->type == AS_ASSUMED_SHAPE)) && actual->expr_type != EXPR_NULL) - || (actual->rank == 0 && formal->attr.dimension + || (actual->rank == 0 + && (formal->attr.dimension + || (formal->ts.type == BT_CLASS + && CLASS_DATA (formal)->attr.dimension)) && gfc_is_coindexed (actual)) /* Assumed-rank actual argument; F2018 C838. */ || actual->rank == -1) @@ -2690,7 +2700,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, } return false; } - else if (actual->rank != 0 && (is_elemental || formal->attr.dimension)) + else if (actual->rank != 0 + && (is_elemental || formal->attr.dimension + || (formal->ts.type == BT_CLASS + && CLASS_DATA (formal)->attr.dimension))) return true; /* At this point, we are considering a scalar passed to an array. This |