https://gcc.gnu.org/g:e8d83da8777f43d5ad58ef17aebfcea095214dbd
commit r17-5549-ge8d83da8777f43d5ad58ef17aebfcea095214dbd Author: Jerry DeLisle <[email protected]> Date: Tue Aug 11 13:05:22 2026 -0700 fortran: [PR126798] ICE for ASSOCIATE selector returning a procedure pointer F2023:C1105 requires an ASSOCIATE selector to be neither a designator of a procedure pointer nor a function reference returning one. The check in resolve_assoc_var was gated on EXPR_VARIABLE, so a function reference never reached it: the associate name took the type of the function's result interface and the pointer value was then converted into it, gimplifying to c = (real(kind=4)) _1; This is not new in 17. Every release from 13 on produces the same invalid GIMPLE; it surfaces as an ICE only where verify_gimple runs, so release-branch builds (--enable-checking=release) compile it silently and -fchecking reproduces the diagnostic there. Hoist the check and add an EXPR_FUNCTION arm keyed on the function result symbol. Calling a procedure pointer stays valid: there the resolved symbol is the pointer itself and its result symbol is itself, so the result is taken from the interface instead. gcc/fortran/ChangeLog: PR fortran/126798 * resolve.cc (resolve_assoc_var): Move the procedure pointer check out of the EXPR_VARIABLE branch and diagnose a function reference whose result is a procedure pointer. gcc/testsuite/ChangeLog: PR fortran/126798 * gfortran.dg/associate_85.f90: New test. Diff: --- gcc/fortran/resolve.cc | 41 +++++++++++++--- gcc/testsuite/gfortran.dg/associate_85.f90 | 79 ++++++++++++++++++++++++++++++ 2 files changed, 113 insertions(+), 7 deletions(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ac8ce029749a..ab565345fd41 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10724,6 +10724,40 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) } } + /* F2023:C1105 - the selector shall be neither a procedure pointer + designator nor a function reference returning a procedure pointer. + Note that calling a procedure pointer is fine; what matters here is + whether the function result is itself a procedure pointer. */ + if (target->expr_type == EXPR_VARIABLE + && gfc_expr_attr (target).proc_pointer) + { + gfc_error ("Associating entity %qs at %L is a procedure pointer", + target->symtree->n.sym->name, &target->where); + return; + } + + if (target->expr_type == EXPR_FUNCTION) + { + gfc_symbol *fsym = target->value.function.esym; + gfc_symbol *result = NULL; + + if (fsym && fsym->attr.proc_pointer) + /* Called through a procedure pointer, whose own result symbol is + itself; the result is described by the interface instead. */ + result = fsym->ts.interface ? fsym->ts.interface->result : NULL; + else if (fsym) + result = fsym->result; + else if (target->symtree && target->symtree->n.sym->ts.interface) + result = target->symtree->n.sym->ts.interface->result; + + if (result && result->attr.proc_pointer) + { + gfc_error ("Selector at %L returns a procedure pointer", + &target->where); + return; + } + } + /* For variable targets, we get some attributes from the target. */ if (target->expr_type == EXPR_VARIABLE || (target->expr_type == EXPR_OP @@ -10735,13 +10769,6 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) tsym = target->expr_type == EXPR_VARIABLE ? target->symtree->n.sym : target->value.op.op1->symtree->n.sym; - if (gfc_expr_attr (target).proc_pointer) - { - gfc_error ("Associating entity %qs at %L is a procedure pointer", - tsym->name, &target->where); - return; - } - if (tsym->attr.flavor == FL_PROCEDURE && tsym->generic && (dsym = gfc_find_dt_in_generic (tsym)) != NULL && dsym->attr.flavor == FL_DERIVED) diff --git a/gcc/testsuite/gfortran.dg/associate_85.f90 b/gcc/testsuite/gfortran.dg/associate_85.f90 new file mode 100644 index 000000000000..20a5e31a33f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_85.f90 @@ -0,0 +1,79 @@ +! { dg-do compile } +! +! PR fortran/126798 +! +! F2023:C1105 - a selector shall be neither a designator of a procedure +! pointer nor a function reference that returns a procedure pointer. +! The function-reference case used to ICE in verify_gimple, or be accepted +! silently when the result had an integer interface. +! +! Calling a procedure pointer is of course still permitted; only a result +! that is itself a procedure pointer is rejected. + +module m + abstract interface + function ifc_ptr () result (r) + procedure(real), pointer :: r + end function + real function ifc_real () + end function + end interface +contains + function getp () result (r) + procedure(real), pointer :: r + r => null () + end function + function getp_int () result (r) + procedure(integer), pointer :: r + r => null () + end function + function getp_sub () result (r) + procedure(), pointer :: r + r => null () + end function +end module + +program associate_85 + use m + implicit none + type t + procedure(real), pointer, nopass :: ppc => null () + end type + type(t) :: x + procedure(real), pointer :: pp => null () + procedure(ifc_ptr), pointer :: qp => null () + procedure(ifc_real), pointer :: qr => null () + + ! Procedure pointer designators. + associate (a => pp) ! { dg-error "is a procedure pointer" } + end associate + + associate (b => x%ppc) ! { dg-error "is a procedure pointer" } + end associate + + ! Function references returning a procedure pointer. + associate (c => getp ()) ! { dg-error "returns a procedure pointer" } + end associate + + associate (d => getp_int ()) ! { dg-error "returns a procedure pointer" } + end associate + + associate (e => getp_sub ()) ! { dg-error "returns a procedure pointer" } + end associate + + associate (f => qp ()) ! { dg-error "returns a procedure pointer" } + end associate + + ! Legal: calling a procedure pointer yields its result, not a pointer. + associate (g => pp ()) + print *, g + end associate + + associate (h => qr ()) + print *, h + end associate + + associate (i => x%ppc ()) + print *, i + end associate +end program
