Hi all,
A number of test cases, which are variations on the original reported problems
on this PR, arrived on bugzilla. While working on there bugs I noticed some
failures that I had originally seen on this one. This prompted me to get
digging. The result after several iterations is the attached patch.
Regression tested on x86_64.
OK for mainline? and later we need to backport to fix the holes.
Regards,
Jerry
---
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.
not
* 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.
---From ef05aae9fd868870fd427f53731676642d45b29d Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 6 Jul 2026 18:30:05 -0700
Subject: [PATCH] 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.
not
* 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.
---
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(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr103367_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/pr103367_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/pr103367_4.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 9fb152074db..946fa86a822 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 da517f8394f..d167036b808 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 d1153f5565c..11cf2ba2e86 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6683,7 +6683,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 00000000000..6a3c4f6357b
--- /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 00000000000..6c83e88b28d
--- /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 00000000000..e0c052692cd
--- /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
--
2.54.0
