[Patch, fortran] PR121384 - Wrongly initialized associate array descriptor when the target is wrapped in parenthesis

From d6c863bb0c17ff02cd78353b9f340c18d4e83873 Mon Sep 17 00:00:00 2001
From: Paul Thomas <[email protected]>
Date: Sun, 16 Aug 2026 15:31:31 +0100
Subject: [PATCH] Fortran: Fix wrongly initialized associate-name descriptor
 [PR121384]

The fix posted in comment #1 of the PR turned out to be completely wrong
because it missed the invalid error, which is now checked in the second
testcase, associate_84.f90.

Instead, the fix required the the removal of the bad code in
resolve_assoc_var,converting an expression contained in paretheses to be
the target expression. As it happens, trans-stmt(trans_associate_var) is
perfectly capable of converting the parentheses expressions correctly.

This verges on being an 'obvious' fix.

2026-08-16  Paul Thomas  <[email protected]>

gcc/fortran
	PR fortran/121384
	* resolve.cc (resolve_assoc_var): Delete symbol 'parentheses'
	and do not use the expression contained in parentheses as a
	target. Use the latter expression as an alternative to variable
	expressions for some error checking.

gcc/testsuite
	PR fortran/121384
	* gfortran.dg/associate_83.f90: New test.
	* gfortran.dg/associate_84.f90: New test.
---
 gcc/fortran/resolve.cc                     | 36 ++++++++----------
 gcc/testsuite/gfortran.dg/associate_83.f90 | 36 ++++++++++++++++++
 gcc/testsuite/gfortran.dg/associate_84.f90 | 43 ++++++++++++++++++++++
 3 files changed, 94 insertions(+), 21 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/associate_83.f90
 create mode 100644 gcc/testsuite/gfortran.dg/associate_84.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 484397da5f8..00262c321f4 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10579,7 +10579,6 @@ static void
 resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 {
   gfc_expr* target;
-  bool parentheses = false;
 
   gcc_assert (sym->assoc);
   gcc_assert (sym->attr.flavor == FL_VARIABLE);
@@ -10609,16 +10608,6 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
     return;
   gcc_assert (!sym->assoc->dangling);
 
-  if (target->expr_type == EXPR_OP
-      && target->value.op.op == INTRINSIC_PARENTHESES
-      && target->value.op.op1->expr_type == EXPR_VARIABLE)
-    {
-      sym->assoc->target = gfc_copy_expr (target->value.op.op1);
-      gfc_free_expr (target);
-      target = sym->assoc->target;
-      parentheses = true;
-    }
-
   if (resolve_target && !gfc_resolve_expr (target))
     return;
 
@@ -10639,12 +10628,15 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
     }
 
   /* For variable targets, we get some attributes from the target.  */
-  if (target->expr_type == EXPR_VARIABLE)
+  if (target->expr_type == EXPR_VARIABLE
+      || (target->expr_type == EXPR_OP
+	  && target->value.op.op == INTRINSIC_PARENTHESES
+	  && target->value.op.op1->expr_type == EXPR_VARIABLE))
     {
       gfc_symbol *tsym, *dsym;
 
-      gcc_assert (target->symtree);
-      tsym = target->symtree->n.sym;
+      tsym = target->expr_type == EXPR_VARIABLE ? target->symtree->n.sym :
+				  target->value.op.op1->symtree->n.sym;
 
       if (gfc_expr_attr (target).proc_pointer)
 	{
@@ -10680,13 +10672,16 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	    }
 	}
 
-      sym->attr.asynchronous = tsym->attr.asynchronous;
-      sym->attr.volatile_ = tsym->attr.volatile_;
+      if (target->expr_type == EXPR_VARIABLE)
+	{
+	  sym->attr.asynchronous = tsym->attr.asynchronous;
+	  sym->attr.volatile_ = tsym->attr.volatile_;
 
-      sym->attr.target = tsym->attr.target
-			 || gfc_expr_attr (target).pointer;
-      if (is_subref_array (target))
-	sym->attr.subref_array_pointer = 1;
+	  sym->attr.target = tsym->attr.target
+			     || gfc_expr_attr (target).pointer;
+	  if (is_subref_array (target))
+	    sym->attr.subref_array_pointer = 1;
+	}
     }
   else if (target->ts.type == BT_PROCEDURE)
     {
@@ -10773,7 +10768,6 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 
   /* See if this is a valid association-to-variable.  */
   sym->assoc->variable = ((target->expr_type == EXPR_VARIABLE
-			   && !parentheses
 			   && !gfc_has_vector_subscript (target))
 			  || gfc_is_ptr_fcn (target));
 
diff --git a/gcc/testsuite/gfortran.dg/associate_83.f90 b/gcc/testsuite/gfortran.dg/associate_83.f90
new file mode 100644
index 00000000000..16087c561f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_83.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Test the fix for PR121384
+! Contributed by Mikael Morin  <[email protected]>
+program test
+  implicit none
+  type :: t
+    integer :: i,j
+  end type
+  type(t) :: a(5)
+  class(t), allocatable :: c(:)
+  a = [ t(2,3), t(5,7), t(11,13), t(17,19), t(23,29) ]
+  associate (x => (a%i))
+    if (rank(x) /= 1) error stop 11
+    if (any(shape(x) /= [5])) error stop 12
+    if (any(x /= [2,5,11,17,23])) error stop 13
+  end associate
+  associate (x => (a%j))
+    if (rank(x) /= 1) error stop 21
+    if (any(shape(x) /= [5])) error stop 22
+    if (any(x /= [3,7,13,19,29])) error stop 23
+  end associate
+
+! Check the class variants
+  c = a
+  associate (x => (c%i))
+    if (rank(x) /= 1) error stop 31
+    if (any(shape(x) /= [5])) error stop 32
+    if (any(x /= [2,5,11,17,23])) error stop 33
+  end associate
+  associate (x => (c%j))
+    if (rank(x) /= 1) error stop 41
+    if (any(shape(x) /= [5])) error stop 42
+    if (any(x /= [3,7,13,19,29])) error stop 43
+  end associate
+  if (allocated (c)) deallocate (c)
+end program
diff --git a/gcc/testsuite/gfortran.dg/associate_84.f90 b/gcc/testsuite/gfortran.dg/associate_84.f90
new file mode 100644
index 00000000000..e59258e678a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_84.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! Test the a missed invalid code found while fixing PR121384
+! Contributed by Mikael Morin  <[email protected]>
+program test
+  implicit none
+  type :: t
+    integer :: i,j
+  end type
+  type(t) :: a(5)
+  class(t), allocatable :: c(:)
+  a = [ t(2,3), t(5,7), t(11,13), t(17,19), t(23,29) ]
+  associate (x => (a%i))
+    if (rank(x) /= 1) error stop 11
+    if (any(shape(x) /= [5])) error stop 12
+    if (any(x /= [2,5,11,17,23])) error stop 13
+    x(1) = 3 ! { dg-error "cannot be used in a variable definition context" }
+  end associate
+  if  (a(1)%i /= 2) print *,a(1)%i
+  associate (x => (a%j))
+    if (rank(x) /= 1) error stop 21
+    if (any(shape(x) /= [5])) error stop 22
+    if (any(x /= [3,7,13,19,29])) error stop 23
+    x(1) = 4 ! { dg-error "cannot be used in a variable definition context" }
+  end associate
+  if  (a(1)%j /= 3) stop 24
+
+! Check the class variants
+  c = a
+  associate (x => (c%i))
+    if (rank(x) /= 1) error stop 31
+    if (any(shape(x) /= [5])) error stop 32
+    if (any(x /= [2,5,11,17,23])) error stop 33
+    x(1) = 3 ! { dg-error "cannot be used in a variable definition context" }
+  end associate
+  if  (c(1)%i /= 2) stop 34
+  associate (x => (c%j))
+    if (rank(x) /= 1) error stop 41
+    if (any(shape(x) /= [5])) error stop 42
+    if (any(x /= [3,7,13,19,29])) error stop 43
+    x(1) = 4 ! { dg-error "cannot be used in a variable definition context" }
+  end associate
+  if  (c(1)%j /= 3) stop 44
+end program
-- 
2.55.0