https://gcc.gnu.org/g:ae22dab993a717e8c7da11faac5c3f5d208cab85
commit r17-5107-gae22dab993a717e8c7da11faac5c3f5d208cab85 Author: Paul Thomas <[email protected]> Date: Tue Oct 13 10:39:18 2026 +0100 Fortran: [PDT] (1/16) Parameterized derived type errors [PR82173] 2026-10-13 Paul Thomas <[email protected]> gcc/fortran PR fortran/82173 * expr.cc (find_inquiry_ref): Instead of calling gfc_pdt_find_ component_copy_initializer directly, build a KIND expression and call gfc_simplify_len. * gfortran.h : Add prototype for gfc_simplify_len. * simplify.cc (gfc_simplify_len): Simplify the logic for access to the original code by detecting a pdt_string and a variable string length. Reduce the verbosity of the code by storing the variable name. If the pdt_string does not have a length that is a variable, insert the parameter expressions to a copy of the string length. Return if this then simplifies to a constant expression. gcc/testsuite/ PR fortran/82173 * gfortran.dg/pdt_bug1.f90: New test. Diff: --- gcc/fortran/expr.cc | 17 ++++++++-------- gcc/fortran/gfortran.h | 1 + gcc/fortran/simplify.cc | 37 ++++++++++++++++++++++------------ gcc/testsuite/gfortran.dg/pdt_bug1.f90 | 15 ++++++++++++++ 4 files changed, 49 insertions(+), 21 deletions(-) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 68663fe35d19..48711f7fe7ab 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -2050,15 +2050,16 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) else if (tmp->expr_type == EXPR_CONSTANT) *newp = gfc_get_int_expr (gfc_default_integer_kind, NULL, tmp->value.character.length); - else if (gfc_init_expr_flag - && tmp->ts.u.cl->length->symtree->n.sym->attr.pdt_len) - *newp = gfc_pdt_find_component_copy_initializer (tmp->symtree->n - .sym, - tmp->ts.u.cl - ->length->symtree - ->n.sym->name); else - goto cleanup; + { + gfc_expr *kind_expr; + kind_expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, + tmp->ts.kind); + *newp = gfc_simplify_len (tmp, kind_expr); + if (*newp) + break; + goto cleanup; + } break; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4e41133d5fcf..c62ae5565557 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -4493,6 +4493,7 @@ gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); bool gfc_is_constant_array_expr (gfc_expr *); bool gfc_is_size_zero_array (gfc_expr *); void gfc_convert_mpz_to_unsigned (mpz_t, int, bool sign = true); +gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *); /* trans-array.cc */ diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index f0b36c066876..2a0bef67217e 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -5060,20 +5060,15 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) component the last _data ref needs to be stripped and a ref to the _len component added. */ return gfc_get_len_component (e->symtree->n.sym->assoc->target, k); - else if (e->symtree->n.sym->ts.type == BT_DERIVED - && e->ref && e->ref->type == REF_COMPONENT - && e->ref->u.c.component->attr.pdt_string - && e->ref->u.c.component->ts.type == BT_CHARACTER - && e->ref->u.c.component->ts.u.cl->length) + else if (gfc_expr_attr (e).pdt_string + && e->ts.u.cl->length->expr_type == EXPR_VARIABLE) { + const char *name = e->ts.u.cl->length->symtree->name; if (gfc_init_expr_flag) { gfc_expr* tmp; tmp = gfc_pdt_find_component_copy_initializer (e->symtree->n.sym, - e->ref->u.c - .component->ts.u.cl - ->length->symtree - ->name); + name); if (tmp) return tmp; } @@ -5082,14 +5077,30 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) gfc_expr *len_expr = gfc_copy_expr (e); gfc_free_ref_list (len_expr->ref); len_expr->ref = NULL; - gfc_find_component (len_expr->symtree->n.sym->ts.u.derived, e->ref - ->u.c.component->ts.u.cl->length->symtree - ->name, - false, true, &len_expr->ref); + gfc_find_component (len_expr->symtree->n.sym->ts.u.derived, + name, false, true, &len_expr->ref); len_expr->ts = len_expr->ref->u.c.component->ts; return len_expr; } } + else if (gfc_expr_attr (e).pdt_string) + { + gfc_actual_arglist *parms; + gfc_expr *len_expr; + + len_expr = gfc_copy_expr (e->ts.u.cl->length); + parms = e->param_list ? e->param_list : + e->symtree->n.sym->param_list; + if (parms) + gfc_insert_parameter_exprs (len_expr, parms); + + if (e->ts.u.cl->length->expr_type != EXPR_VARIABLE + && gfc_simplify_expr (len_expr, 0) + && gfc_is_constant_expr (len_expr)) + return len_expr; + + gfc_free_expr (len_expr); + } } else if (e->expr_type == EXPR_ARRAY && e->ts.type == BT_CHARACTER && e->ts.u.cl diff --git a/gcc/testsuite/gfortran.dg/pdt_bug1.f90 b/gcc/testsuite/gfortran.dg/pdt_bug1.f90 new file mode 100644 index 000000000000..ca9292ed6554 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_bug1.f90 @@ -0,0 +1,15 @@ +! { dg-do run } +! Used to ICE at line 10 in simplify.cc(gfc_simplify_len). +! See attachment to PR82173 comment 10 - reproducers/bug1-simplify_len_ice.f90 +program r6 + type :: t(n) + integer, len :: n = 2 + character(len=2*n) :: c1 + character(len=n*n - 1) :: c2 + end type + type(t(3)) :: p + if (len (p%c1) /= 6) stop 1 +! Add a slightly more complicated version and use LEN in a different context. + p%c2 = repeat ('X', len (p%c2)) + if (p%c2 /= 'XXXXXXXX') stop 2 +end program
