Hello All, The attached patch passes regression testing on FC44/x86_64. OK for mainline and backporting to 16-branch?
No LLMs were used or abused by this patch. Cheers Paul
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
