https://gcc.gnu.org/g:3d2783673d370a259d8a415c2a859079d5ca8e07
commit r16-3616-g3d2783673d370a259d8a415c2a859079d5ca8e07 Author: Paul Thomas <[email protected]> Date: Sat Sep 6 17:39:25 2025 +0100 Fortran: Implement correct form of PDT constructors [PR84119] 2025-09-06 Paul Thomas <[email protected]> gcc/fortran PR fortran/84119 * resolve.cc (reset_array_ref_to_scalar): New function using chunk broken out from gfc_resolve_ref. (gfc_resolve_ref): Call the new function, the first time for PDT type parameters and the second time for LEN inquiry refs. gcc/testsuite/ PR fortran/84119 * gfortran.dg/pdt_20.f03: Modify to deal with scalar type parm. Diff: --- gcc/fortran/resolve.cc | 66 ++++++++++++++++++++++++------------ gcc/testsuite/gfortran.dg/pdt_20.f03 | 2 +- 2 files changed, 45 insertions(+), 23 deletions(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index d51301aec44f..1a7c9dddb15b 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5872,12 +5872,46 @@ gfc_resolve_substring_charlen (gfc_expr *e) } +/* Convert an array reference to an array element so that PDT KIND and LEN + or inquiry references are always scalar. */ + +static void +reset_array_ref_to_scalar (gfc_expr *expr, gfc_ref *array_ref) +{ + gfc_expr *unity = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); + int dim; + + array_ref->u.ar.type = AR_ELEMENT; + expr->rank = 0; + /* Suppress the runtime bounds check. */ + expr->no_bounds_check = 1; + for (dim = 0; dim < array_ref->u.ar.dimen; dim++) + { + array_ref->u.ar.dimen_type[dim] = DIMEN_ELEMENT; + if (array_ref->u.ar.start[dim]) + gfc_free_expr (array_ref->u.ar.start[dim]); + + if (array_ref->u.ar.as && array_ref->u.ar.as->lower[dim]) + array_ref->u.ar.start[dim] + = gfc_copy_expr (array_ref->u.ar.as->lower[dim]); + else + array_ref->u.ar.start[dim] = gfc_copy_expr (unity); + + if (array_ref->u.ar.end[dim]) + gfc_free_expr (array_ref->u.ar.end[dim]); + if (array_ref->u.ar.stride[dim]) + gfc_free_expr (array_ref->u.ar.stride[dim]); + } + gfc_free_expr (unity); +} + + /* Resolve subtype references. */ bool gfc_resolve_ref (gfc_expr *expr) { - int current_part_dimension, n_components, seen_part_dimension, dim; + int current_part_dimension, n_components, seen_part_dimension; gfc_ref *ref, **prev, *array_ref; bool equal_length; gfc_symbol *last_pdt = NULL; @@ -6022,6 +6056,14 @@ gfc_resolve_ref (gfc_expr *expr) last_pdt = NULL; } + /* The F08 standard requires(See R425, R431, R435, and in particular + Note 6.7) that a PDT parameter reference be a scalar even if + the designator is an array." */ + if (array_ref && last_pdt && last_pdt->attr.pdt_type + && (ref->u.c.component->attr.pdt_kind + || ref->u.c.component->attr.pdt_len)) + reset_array_ref_to_scalar (expr, array_ref); + n_components++; break; @@ -6034,27 +6076,7 @@ gfc_resolve_ref (gfc_expr *expr) if (ref->u.i == INQUIRY_LEN && array_ref && ((expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->length) || expr->ts.type == BT_INTEGER)) - { - array_ref->u.ar.type = AR_ELEMENT; - expr->rank = 0; - /* INQUIRY_LEN is not evaluated from the rest of the expr - but directly from the string length. This means that setting - the array indices to one does not matter but might trigger - a runtime bounds error. Suppress the check. */ - expr->no_bounds_check = 1; - for (dim = 0; dim < array_ref->u.ar.dimen; dim++) - { - array_ref->u.ar.dimen_type[dim] = DIMEN_ELEMENT; - if (array_ref->u.ar.start[dim]) - gfc_free_expr (array_ref->u.ar.start[dim]); - array_ref->u.ar.start[dim] - = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); - if (array_ref->u.ar.end[dim]) - gfc_free_expr (array_ref->u.ar.end[dim]); - if (array_ref->u.ar.stride[dim]) - gfc_free_expr (array_ref->u.ar.stride[dim]); - } - } + reset_array_ref_to_scalar (expr, array_ref); break; } diff --git a/gcc/testsuite/gfortran.dg/pdt_20.f03 b/gcc/testsuite/gfortran.dg/pdt_20.f03 index b712ed59dbb0..3aa9b2e086b8 100644 --- a/gcc/testsuite/gfortran.dg/pdt_20.f03 +++ b/gcc/testsuite/gfortran.dg/pdt_20.f03 @@ -16,5 +16,5 @@ program p allocate (t2(3) :: x) ! Used to segfault in trans-array.c. if (x%b .ne. 3) STOP 1 if (x%b .ne. size (x%r, 1)) STOP 2 - if (any (x%r%a .ne. 1)) STOP 3 + if (x%r%a .ne. 1) STOP 3 end
