Attached patch fixes this by checking for BT_VOID and EXPR_FUNCTION.
Thank you for guidance from Steve in the PR and Vincent for
identifying the problem.
Two test case files added to the testsuite.
Regression tested on x86_64.
OK for mainline?
Since this breakage impacts gtk-fortran I would also like to backport to
14 and 15.
Best regards,
Jerry
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Mon May 5 20:05:22 2025 -0700
Fortran: Fix ICE with use of c_associated.
PR fortran/120049
gcc/fortran/ChangeLog:
* check.cc (gfc_check_c_associated): Modify checks to avoid
ICE and allow use, intrinsic :: iso_c_binding from a separate
module file.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr120049_a.f90: New test.
* gfortran.dg/pr120049_b.f90: New test.
commit 4794d04ac2cc755ae6c3c024e45d9b3a768f466f
Author: Jerry DeLisle <jvdeli...@gcc.gnu.org>
Date: Mon May 5 20:05:22 2025 -0700
Fortran: Fix ICE with use of c_associated.
PR fortran/120049
gcc/fortran/ChangeLog:
* check.cc (gfc_check_c_associated): Modify checks to avoid
ICE and allow use, intrinsic :: iso_c_binding from a separate
module file.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr120049_a.f90: New test.
* gfortran.dg/pr120049_b.f90: New test.
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 299c216cf36..f02a2a33897 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5955,30 +5955,40 @@ gfc_check_c_sizeof (gfc_expr *arg)
bool
gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr *c_ptr_2)
{
- if (c_ptr_1->ts.type != BT_DERIVED
- || c_ptr_1->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
- || (c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR
- && c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_FUNPTR))
+ if (c_ptr_1)
{
- gfc_error ("Argument C_PTR_1 at %L to C_ASSOCIATED shall have the "
- "type TYPE(C_PTR) or TYPE(C_FUNPTR)", &c_ptr_1->where);
- return false;
+ if (c_ptr_1->expr_type == EXPR_FUNCTION && c_ptr_1->ts.type == BT_VOID)
+ return true;
+
+ if (c_ptr_1->ts.type != BT_DERIVED
+ || c_ptr_1->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
+ || (c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR
+ && c_ptr_1->ts.u.derived->intmod_sym_id != ISOCBINDING_FUNPTR))
+ {
+ gfc_error ("Argument C_PTR_1 at %L to C_ASSOCIATED shall have the "
+ "type TYPE(C_PTR) or TYPE(C_FUNPTR)", &c_ptr_1->where);
+ return false;
+ }
}
if (!scalar_check (c_ptr_1, 0))
return false;
- if (c_ptr_2
- && (c_ptr_2->ts.type != BT_DERIVED
+ if (c_ptr_2)
+ {
+ if (c_ptr_2->expr_type == EXPR_FUNCTION && c_ptr_2->ts.type == BT_VOID)
+ return true;
+
+ if (c_ptr_2->ts.type != BT_DERIVED
|| c_ptr_2->ts.u.derived->from_intmod != INTMOD_ISO_C_BINDING
|| (c_ptr_1->ts.u.derived->intmod_sym_id
- != c_ptr_2->ts.u.derived->intmod_sym_id)))
- {
- gfc_error ("Argument C_PTR_2 at %L to C_ASSOCIATED shall have the "
- "same type as C_PTR_1: %s instead of %s", &c_ptr_1->where,
- gfc_typename (&c_ptr_1->ts),
- gfc_typename (&c_ptr_2->ts));
- return false;
+ != c_ptr_2->ts.u.derived->intmod_sym_id))
+ {
+ gfc_error ("Argument C_PTR_2 at %L to C_ASSOCIATED shall have the "
+ "same type as C_PTR_1: %s instead of %s", &c_ptr_1->where,
+ gfc_typename (&c_ptr_1->ts), gfc_typename (&c_ptr_2->ts));
+ return false;
+ }
}
if (c_ptr_2 && !scalar_check (c_ptr_2, 1))
diff --git a/gcc/testsuite/gfortran.dg/pr120049_a.f90 b/gcc/testsuite/gfortran.dg/pr120049_a.f90
new file mode 100644
index 00000000000..c404a4dedd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_a.f90
@@ -0,0 +1,15 @@
+! { dg-do preprocess }
+! { dg-additional-options "-cpp" }
+!
+! Test the fix for PR86248
+program tests_gtk_sup
+ use gtk_sup
+ implicit none
+ type(c_ptr), target :: val
+ if (c_associated(val, c_loc(val))) then
+ stop 1
+ endif
+ if (c_associated(c_loc(val), val)) then
+ stop 2
+ endif
+end program tests_gtk_sup
diff --git a/gcc/testsuite/gfortran.dg/pr120049_b.f90 b/gcc/testsuite/gfortran.dg/pr120049_b.f90
new file mode 100644
index 00000000000..127db984077
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_b.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! { dg-additional-sources pr120049_a.f90 }
+!
+! Module for pr120049.f90
+!
+module gtk_sup
+ use, intrinsic :: iso_c_binding
+end module gtk_sup
