https://gcc.gnu.org/g:37950565de34d53cbdeb6ff33cc4792a2a7a0696
commit r16-8108-g37950565de34d53cbdeb6ff33cc4792a2a7a0696 Author: Paul Thomas <[email protected]> Date: Mon Mar 16 08:20:20 2026 +0000 Fortran: Regression in gfc_convert_to_structure_constructor [PR93832] 2026-03-16 Paul Thomas <[email protected]> Steve Kargl <[email protected]> gcc/fortran PR fortran/93832 * array.cc (resolve_array_bound): Emit error and return false if bound expression is derived type or class. * primary.cc (gfc_convert_to_structure_constructor): Do not dereference NULL in character component test. Define 'shorter' and use it help cure one of several whitespace issues. gcc/testsuite/ PR fortran/93832 * gfortran.dg/pr93832.f90: New test. Diff: --- gcc/fortran/array.cc | 7 +++++++ gcc/fortran/primary.cc | 33 ++++++++++++++++--------------- gcc/testsuite/gfortran.dg/pr93832.f90 | 37 +++++++++++++++++++++++++++++++++++ 3 files changed, 61 insertions(+), 16 deletions(-) diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc index 87b37c8a5ddb..705ff17439bc 100644 --- a/gcc/fortran/array.cc +++ b/gcc/fortran/array.cc @@ -471,6 +471,13 @@ resolve_array_bound (gfc_expr *e, int check_constant) if (e == NULL) return true; + if (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS) + { + gfc_error ("Derived type or class expression for array bound at %L", + &e->where); + return false; + } + if (!gfc_resolve_expr (e) || !gfc_specification_expr (e)) return false; diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 9251f88d6d6a..2ca2c4744bbc 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -3604,6 +3604,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c && this_comp->ts.u.cl && this_comp->ts.u.cl->length && this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT && this_comp->ts.u.cl->length->ts.type == BT_INTEGER + && actual->expr && actual->expr->ts.type == BT_CHARACTER && actual->expr->expr_type == EXPR_CONSTANT) { @@ -3668,27 +3669,27 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c goto cleanup; } - /* If not explicitly a parent constructor, gather up the components - and build one. */ - if (comp && comp == sym->components - && sym->attr.extension - && comp_tail->val - && (!gfc_bt_struct (comp_tail->val->ts.type) - || - comp_tail->val->ts.u.derived != this_comp->ts.u.derived)) - { - bool m; + /* If not explicitly a parent constructor, gather up the components + and build one. */ + if (comp && comp == sym->components + && sym->attr.extension + && comp_tail->val + && (!gfc_bt_struct (comp_tail->val->ts.type) + || comp_tail->val->ts.u.derived != this_comp->ts.u.derived)) + { + bool m; gfc_actual_arglist *arg_null = NULL; actual->expr = comp_tail->val; comp_tail->val = NULL; +#define shorter gfc_convert_to_structure_constructor + m = shorter (NULL, comp->ts.u.derived, &comp_tail->val, + comp->ts.u.derived->attr.zero_comp ? &arg_null : + &actual, true); +#undef shorter - m = gfc_convert_to_structure_constructor (NULL, - comp->ts.u.derived, &comp_tail->val, - comp->ts.u.derived->attr.zero_comp - ? &arg_null : &actual, true); - if (!m) - goto cleanup; + if (!m) + goto cleanup; if (comp->ts.u.derived->attr.zero_comp) { diff --git a/gcc/testsuite/gfortran.dg/pr93832.f90 b/gcc/testsuite/gfortran.dg/pr93832.f90 new file mode 100644 index 000000000000..ca8b4abaa9f6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93832.f90 @@ -0,0 +1,37 @@ +module m +contains + subroutine comment0 + type t + character :: a + integer :: b + integer :: c(t(1)) ! { dg-error "No initializer for component .b." } + end type + type(t) :: z = t('a', 2, [3]) ! { dg-error "Bad array spec of component .c." } + end + + subroutine comment3a + type t + character :: a + integer :: b + integer :: c(t(1, "rubbish")) ! { dg-error "No initializer for component .c." } + end type + type(t) :: z = t('a', 2, [3]) ! { dg-error "Bad array spec of component .c." } + end + + subroutine comment3b + type t + character :: a + integer :: b + integer :: c(t(1, "rubbish", [7])) ! { dg-error "Derived type or class expression" } + end type + type(t) :: z = t('a', 2, [3]) ! { dg-error "Bad array spec of component .c." } + end + + subroutine comment9 + type t + character :: a + integer :: b(t(1)) ! { dg-error "No initializer for component .b." } + end type + type(t) :: x = t('a', 2) + end +end module
