[PATCH] Fortran [PR103367] Followup patch to fix related test cases

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