Re: [PATCH] Fix PR125481 Wrong generic resolution between procedure pointer and variable actuals of same TKR

From dfcb755176cffab06783821bb8abf56c134be1d1 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Tue, 26 May 2026 12:00:33 -0700
Subject: [PATCH] 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.
---
 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(+)
 create mode 100644 gcc/testsuite/gfortran.dg/generic_37.f90
 create mode 100644 gcc/testsuite/gfortran.dg/generic_38.f90

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 7862783e588..b8f4087ef49 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 00000000000..e6b82d95ca3
--- /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 00000000000..93b9ff4ba4b
--- /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
-- 
2.54.0