https://gcc.gnu.org/g:5e2d7563a8db0e1362d8b42faff8fc6eadda6f56
commit r16-9248-g5e2d7563a8db0e1362d8b42faff8fc6eadda6f56 Author: Jerry DeLisle <[email protected]> Date: Mon Jul 6 18:30:05 2026 -0700 fortran: [PR103367] Followup patch to fix related test cases PR fortran/103367 gcc/fortran/ChangeLog: * expr.cc (simplify_const_ref): Hoist the call to remove_subobject_ref up a level. * primary.cc (gfc_match_rvalue): Don't copy the value expr if the type is an EXPR_VARIABLE. * trans-array.cc (gfc_conv_array_initializer): Only copy the expr value if it does not have a ref. gcc/testsuite/ChangeLog: * gfortran.dg/pr103367_2.f90: New test. * gfortran.dg/pr103367_3.f90: New test. * gfortran.dg/pr103367_4.f90: New test. (cherry picked from commit b1eb6e08939a01a18724d35da3dd0098cb993ab9) Diff: --- gcc/fortran/expr.cc | 24 +++++++++++++++------ gcc/fortran/primary.cc | 3 ++- gcc/fortran/trans-array.cc | 3 ++- gcc/testsuite/gfortran.dg/pr103367_2.f90 | 37 ++++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr103367_3.f90 | 11 ++++++++++ gcc/testsuite/gfortran.dg/pr103367_4.f90 | 14 ++++++++++++ 6 files changed, 83 insertions(+), 9 deletions(-) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 791474b15242..bada29c46a88 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -2162,16 +2162,26 @@ simplify_const_ref (gfc_expr *p) switch (p->ref->type) { case REF_ARRAY: - switch (p->ref->u.ar.type) + /* <type/kind spec>, parameter :: x(<int>) = scalar_expr + will generate this. */ + if (p->expr_type != EXPR_ARRAY) { - case AR_ELEMENT: - /* <type/kind spec>, parameter :: x(<int>) = scalar_expr - will generate this. */ - if (p->expr_type != EXPR_ARRAY) + if (p->ref->u.ar.type == AR_ELEMENT) { - remove_subobject_ref (p, NULL); - break; + int dim; + for (dim = 0; dim < p->ref->u.ar.dimen; dim++) + if (!p->ref->u.ar.start[dim] + || p->ref->u.ar.start[dim]->expr_type != EXPR_CONSTANT) + return true; } + + remove_subobject_ref (p, NULL); + break; + } + + switch (p->ref->u.ar.type) + { + case AR_ELEMENT: if (!find_array_element (p->value.constructor, &p->ref->u.ar, &cons)) return false; diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index da517f8394fe..d167036b8086 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -4025,7 +4025,8 @@ gfc_match_rvalue (gfc_expr **result) end up here. Unfortunately, sym->value->expr_type is set to EXPR_CONSTANT, and so the if () branch would be followed without the !sym->as check. */ - if (sym->value && sym->value->expr_type != EXPR_ARRAY && !sym->as) + if (sym->value && sym->value->expr_type != EXPR_ARRAY + && sym->value->expr_type != EXPR_VARIABLE && !sym->as) e = gfc_copy_expr (sym->value); else { diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 5c26ec82d3e8..a21ee4ac7a2e 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -7155,7 +7155,8 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) if (expr->expr_type == EXPR_VARIABLE && expr->symtree->n.sym->attr.flavor == FL_PARAMETER - && expr->symtree->n.sym->value) + && expr->symtree->n.sym->value + && !expr->ref) expr = expr->symtree->n.sym->value; /* After parameter substitution the expression should be a constant, array diff --git a/gcc/testsuite/gfortran.dg/pr103367_2.f90 b/gcc/testsuite/gfortran.dg/pr103367_2.f90 new file mode 100644 index 000000000000..6a3c4f6357b7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103367_2.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } +subroutine s1 + type t + integer :: a(1,2) = 3 + end type + type(t), parameter :: x(1) = t(4) + integer, parameter :: y(1,2) = (x(1)%a(m,1)) ! { dg-error "does not reduce to a constant expression" } + print *, y +end + +subroutine s2 + type t + integer :: a(2) = 3! + end type + type(t), parameter :: x(1) = t(4) + integer, parameter :: y = x(1)%a(m) ! { dg-error "non-constant initialization expression" } + print *, y +end + +subroutine s3 + type t + integer :: a(1,2) = 3 + end type + type(t), parameter :: x(1) = t(4) + integer, parameter :: y(1,2) = (x(b)%a) ! { dg-error "does not reduce to a constant expression" } + print *, y +end + +subroutine s4 + type t + integer :: a(1,2) = 3 + end type + type(t), parameter :: x(1) = t(4) + integer :: y(1,2) = x(b)%a ! { dg-error "does not reduce to a constant expression" } + print *, y +end +! { dg-prune-output "Legacy Extension: REAL array index" } diff --git a/gcc/testsuite/gfortran.dg/pr103367_3.f90 b/gcc/testsuite/gfortran.dg/pr103367_3.f90 new file mode 100644 index 000000000000..6c83e88b28db --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103367_3.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! PR103367 Test case from the PR, previously segfaulted. +program p + type t + integer :: a(1,2) = 3 + end type + type(t), parameter :: x(1) = t(4) + integer, parameter :: y(2) = x(1)%a(1,:) + if (any (y /= [4, 4])) stop 1 +end + diff --git a/gcc/testsuite/gfortran.dg/pr103367_4.f90 b/gcc/testsuite/gfortran.dg/pr103367_4.f90 new file mode 100644 index 000000000000..e0c052692cd1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103367_4.f90 @@ -0,0 +1,14 @@ +! { dg-do run } +! PR103367, this test previously +! Test case from the PR segfaulted at compile time. +program p + type inner + integer :: n = 3 + end type + type outer + type(inner) :: a(2) = inner(1) + end type + type(outer), parameter :: x(1) = outer(inner(4)) + integer, parameter :: y(2) = x(1)%a%n + if (any (y /= [4, 4])) stop 1 +end
