On 5/31/26 3:28 PM, Jerry D wrote:
On 5/31/26 1:28 PM, Harald Anlauf wrote:
Hi Jerry!
Am 31.05.26 um 5:46 AM schrieb Jerry D:
The attached patch regression tested on x86_64.
Are you sure that the reference to F18:15.5.2.4 is correct?
I cannot find your quote there, at least not verbosely.
I am working off drafts here. I will hunt this down in 2023 which is more
current.
I found this in my draft 2023: F23:15.5.2.5, para 2
Furthermore, can you provide a testcase where the new error message
will be tested?
New test case added to exercise two possible errors.
I have attached here a revised patch file. I have rerun regression tests on my
worktree.
If this is OK I will apply to trunk and rerun all of testsuite there before I
commit. I noticed some unrelated gfortran/gomp failures this morning. I dont
know what that is about.
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
