diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2025-05-05 20:05:22 -0700 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2025-05-06 10:04:17 -0700 |
| commit | d0571638a6bad932b226ada98b167fa47a47d838 (patch) | |
| tree | 146666448bb50dd667fb197f7f1817c5ca39be17 | |
| parent | 86627faec10da53d7532805019e5296fcf15ac09 (diff) | |
| download | gcc-d0571638a6bad932b226ada98b167fa47a47d838.zip gcc-d0571638a6bad932b226ada98b167fa47a47d838.tar.gz gcc-d0571638a6bad932b226ada98b167fa47a47d838.tar.bz2 | |
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.
| -rw-r--r-- | gcc/fortran/check.cc | 42 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr120049_a.f90 | 15 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr120049_b.f90 | 8 |
3 files changed, 49 insertions, 16 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 299c216..f02a2a3 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 0000000..c404a4d --- /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 0000000..127db98 --- /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 |