[gcc r14-12732] fortran: [PR103367] Followup patch to fix related test cases

Jerry DeLisle via Gcc-cvs <[email protected]>
Newsgroups gmane.comp.gcc.cvs
Message-ID <[email protected]>
https://gcc.gnu.org/g:4b39571b19683d58fcc6a959bee190b7bb0f7798

commit r14-12732-g4b39571b19683d58fcc6a959bee190b7bb0f7798
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.
            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.
    
    (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 c5b822ed0135..2da336fe50f6 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1953,16 +1953,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 6ea0b6866a2d..2e2231035565 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -3764,7 +3764,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 eceea31c9343..36fd7edcad97 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6626,7 +6626,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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.