[PATCH] Fortran: fix passing a procedure pointer to c_funloc [PR124652]
Harald Anlauf <[email protected]>
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <[email protected]> |
Dear all, the attached almost obvious patch fixes actually two issues: - when C_FUNLOC is applied to a procedure pointer instead of a procedure, and the procedure pointer is a dummy, we need to dereference it; - a procedure pointer dummy with intent(out) was clobbered, but the clobber was using the dereferenced pointer, which did fail in gimple at -O1 and higher (and is actually detecting wrong code). The solution is to not clobber (and we have a couple of similar exceptions). Regtested on x86_64-pc-linux-gnu. OK for mainline? As the above issues can be naughty, is it OK to backport to 15-branch? Thanks, Harald
pr124652.diff
(text/x-patch, 5.3 KB)
From b76f5b9108d8ac1dfaa54817d42fae292451ff02 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Wed, 1 Apr 2026 22:28:02 +0200 Subject: [PATCH] Fortran: fix passing a procedure pointer to c_funloc [PR124652] PR fortran/124652 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): Do not clobber a procedure pointer intent(out) argument. * trans-intrinsic.cc (conv_isocbinding_function): When passing to C_FUNLOC a procedure pointer that is a dummy, dereference it. gcc/testsuite/ChangeLog: * gfortran.dg/c_funloc_tests_10.f90: New test. --- gcc/fortran/trans-expr.cc | 1 + gcc/fortran/trans-intrinsic.cc | 3 + .../gfortran.dg/c_funloc_tests_10.f90 | 86 +++++++++++++++++++ 3 files changed, 90 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/c_funloc_tests_10.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 52918961584..3945d9eaa67 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7549,6 +7549,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && !e->ts.u.derived->attr.alloc_comp && !e->ts.u.derived->attr.pdt_type && !gfc_is_finalizable (e->ts.u.derived, NULL))) + && e->ts.type != BT_PROCEDURE && !sym->attr.elemental) { tree var; diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 578851e1b0b..dbf645886f5 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -9901,6 +9901,9 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr) else if (expr->value.function.isym->id == GFC_ISYM_C_FUNLOC) { gfc_conv_expr_reference (se, arg->expr); + if (arg->expr->symtree->n.sym->attr.proc_pointer + && arg->expr->symtree->n.sym->attr.dummy) + se->expr = build_fold_indirect_ref_loc (input_location, se->expr); /* The code below is necessary to create a reference from the calling subprogram to the argument of C_FUNLOC() in the call graph. Please see PR 117303 for more details. */ diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_10.f90 b/gcc/testsuite/gfortran.dg/c_funloc_tests_10.f90 new file mode 100644 index 00000000000..f320c8e3aea --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_10.f90 @@ -0,0 +1,86 @@ +! { dg-do run } +! +! PR fortran/124652 - passing a procedure pointer to c_funloc +! +! Contributed by Damian Rouson + +program proc_ptr_demo + use iso_c_binding + implicit none + + ! Define an interface for the type of procedure we are pointing to + abstract interface + function compute_interface(x) result(res) bind(c) + use iso_c_binding + real(c_float), intent(in), value :: x + real(c_float) :: res + end function compute_interface + end interface + + ! Procedure pointers + procedure(compute_interface), pointer :: original_ptr => null() + procedure(compute_interface), pointer :: restored_ptr => null() + type(c_funptr) :: c_address + real(c_float) :: expect + + expect = square_it (5.0) + ! Point to our actual function + original_ptr => square_it + if (original_ptr (5.0) /= expect) stop 1 + + ! Convert pointers "inline" + c_address = c_funloc (square_it) + call c_f_procpointer(c_address, restored_ptr) + if (.not. associated (original_ptr, restored_ptr)) stop 2 + if (restored_ptr (5.0) /= expect) stop 3 + + c_address = c_funloc (original_ptr) + call c_f_procpointer (c_address, restored_ptr) + if (.not. associated (original_ptr, restored_ptr)) stop 4 + if (restored_ptr (5.0) /= expect) stop 5 + + ! Call contained subroutines to perform the C conversion logic + call round_trip_conversion_proc (square_it, restored_ptr) + if (.not. associated (original_ptr, restored_ptr)) stop 6 + if (restored_ptr (5.0) /= expect) stop 7 + + call round_trip_conversion_proc (original_ptr, restored_ptr) + if (.not. associated (original_ptr, restored_ptr)) stop 8 + if (restored_ptr (5.0) /= expect) stop 9 + + ! The following used to fail + call round_trip_conversion_ptr (square_it, restored_ptr) + if (.not. associated (original_ptr, restored_ptr)) stop 10 + if (restored_ptr (5.0) /= expect) stop 11 + + call round_trip_conversion_ptr (original_ptr, restored_ptr) + if (.not. associated (original_ptr, restored_ptr)) stop 12 + if (restored_ptr (5.0) /= expect) stop 13 + +contains + + subroutine round_trip_conversion_proc (proc_in, fptr_out) + procedure(compute_interface) :: proc_in + procedure(compute_interface), pointer, intent(out) :: fptr_out + type(c_funptr) :: c_address +! print *, proc_in(1.0) + c_address = c_funloc (proc_in) + call c_f_procpointer (c_address, fptr_out) + end subroutine round_trip_conversion_proc + + subroutine round_trip_conversion_ptr (fptr_in, fptr_out) + procedure(compute_interface), pointer, intent(in) :: fptr_in + procedure(compute_interface), pointer, intent(out) :: fptr_out + type(c_funptr) :: c_address_s +! print *, fptr_in(2.0) + c_address_s = c_funloc (fptr_in) + call c_f_procpointer (c_address_s, fptr_out) + end subroutine round_trip_conversion_ptr + + function square_it (x) result(res) bind(c) + real(c_float), intent(in), value :: x + real(c_float) :: res + res = x * x + end function square_it + +end program -- 2.51.0