https://gcc.gnu.org/g:47bdd0d174e1823506a7e0dba3bfa84b3dddb14f
commit r17-1144-g47bdd0d174e1823506a7e0dba3bfa84b3dddb14f Author: Jerry DeLisle <[email protected]> Date: Tue May 26 12:00:33 2026 -0700 fortran: wrong generic resolution when actual argument is a procedure pointer When a generic interface has two specific procedures -- one with a procedure-pointer dummy and one with a data-object (e.g. REAL) dummy -- gfortran incorrectly resolved calls where the actual argument was a procedure pointer to the data-object specific, resulting in the pointer address being interpreted as a numeric value (wrong code). The root cause was a missing check in gfc_compare_actual_formal: the two existing checks guard the case where the formal is a proc_pointer or FL_PROCEDURE but the actual is not; however the reverse direction (actual is a proc_pointer but formal is a plain data object) was not checked. F23:15.5.2.5, para 2 forbids this pairing. Assisted by: Claude Sonnet 4.6 gcc/fortran/ChangeLog: PR fortran/125481 * interface.cc (gfc_compare_actual_formal): Add missing check that rejects a procedure-pointer actual argument corresponding to a data-object dummy argument (F23:15.5.2.5, para 2). Restrict to EXPR_VARIABLE to avoid false positives on calls through procedure pointer components. gcc/testsuite/ChangeLog: PR fortran/125481 * gfortran.dg/generic_37.f90: New test. * gfortran.dg/generic_38.f90: New test. Diff: --- gcc/fortran/interface.cc | 18 ++++++++ gcc/testsuite/gfortran.dg/generic_37.f90 | 70 ++++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/generic_38.f90 | 44 ++++++++++++++++++++ 3 files changed, 132 insertions(+) diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 7862783e588d..b8f4087ef498 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -3817,6 +3817,24 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, goto match; } + /* F23:15.5.2.5, para 2: A procedure pointer actual argument cannot correspond + to a data-object dummy argument (reverse of the two checks above). + Only flag EXPR_VARIABLE to avoid false positives on function calls + through procedure pointer components (e.g. o%f(args)). */ + if (!f->sym->attr.proc_pointer + && f->sym->attr.flavor != FL_PROCEDURE + && a->expr->expr_type == EXPR_VARIABLE + && (a->expr->symtree->n.sym->attr.proc_pointer + || gfc_is_proc_ptr_comp (a->expr))) + { + if (where) + gfc_error ("Procedure pointer actual argument at %L cannot " + "be passed to data-object dummy argument %qs", + &a->expr->where, f->sym->name); + ok = false; + goto match; + } + /* Class array variables and expressions store array info in a different place from non-class objects; consolidate the logic to access it here instead of repeating it below. Note that diff --git a/gcc/testsuite/gfortran.dg/generic_37.f90 b/gcc/testsuite/gfortran.dg/generic_37.f90 new file mode 100644 index 000000000000..e6b82d95ca3e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_37.f90 @@ -0,0 +1,70 @@ +! { dg-do run } +! +! PR fortran/125481 +! +! Wrong generic resolution when actual argument is a procedure pointer and +! the generic has two specific procedures -- one with a procedure-pointer +! dummy argument and one with a REAL(8) dummy argument. gfortran was +! selecting the REAL(8) specific (F23:15.5.2.5, para 2 violation). + +module m + implicit none + + abstract interface + pure function init_i (x) result (y) + real (8), intent (in) :: x(:) + real (8), allocatable :: y(:) + end function + end interface + + type :: t + real (8), allocatable :: vals(:) + end type + + interface make_t + module procedure make_t_from_func ! first dummy: procedure pointer + module procedure make_t_constant ! first dummy: real(8) + end interface + +contains + + function make_t_from_func (f, n) result (r) + procedure (init_i), pointer :: f + integer, intent (in) :: n + type (t) :: r + integer :: i + r%vals = f ([(real (i, 8), i = 1, n)]) + end function + + function make_t_constant (c, n) result (r) + real (8), intent (in) :: c + integer, intent (in) :: n + type (t) :: r + integer :: i + r%vals = [(c, i = 1, n)] + end function + + pure function identity (x) result (y) + real (8), intent (in) :: x(:) + real (8), allocatable :: y(:) + y = x + end function + +end module m + +program test + use m + implicit none + procedure (init_i), pointer :: f => identity + type (t) :: x + integer :: i + + x = make_t (f, 4) + do i = 1, 4 + if (abs (x%vals(i) - real (i, 8)) > epsilon (x%vals(i))) STOP 1 + end do + + x = make_t (42.0d0, 4) + if (any (abs (x%vals - 42.0d0) > epsilon (x%vals(1)))) stop 2 + +end program test diff --git a/gcc/testsuite/gfortran.dg/generic_38.f90 b/gcc/testsuite/gfortran.dg/generic_38.f90 new file mode 100644 index 000000000000..93b9ff4ba4b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_38.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! +! PR fortran/125481 +! +! Verify that passing a procedure pointer actual argument to a plain +! data-object dummy argument is rejected with a clear diagnostic +! (F23:15.5.2.5, para 2). + +module m_err + implicit none + + abstract interface + function func_t (x) result (y) + real(8), intent(in) :: x + real(8) :: y + end function + end interface + + type :: t + procedure(func_t), pointer, nopass :: fp => null() + end type + +contains + + subroutine takes_data (x) + real(8), intent(in) :: x + print *, x + end subroutine + +end module m_err + +program test + use m_err + implicit none + procedure(func_t), pointer :: f => null() + type(t) :: obj + + ! Procedure pointer variable passed to a data-object dummy. + call takes_data (f) ! { dg-error "cannot be passed to data-object dummy argument" } + + ! Procedure pointer component passed to a data-object dummy. + call takes_data (obj%fp) ! { dg-error "cannot be passed to data-object dummy argument" } + +end program test
