From 5af5f1de35772754e844c391ab5bfa90ad231077 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 29 Jan 2019 22:40:26 +0000 Subject: [PATCH] re PR fortran/57048 (Handling of C_PTR and C_FUNPTR leads to reject valid) 2019-01-29 Thomas Koenig PR fortran/57048 * interface.c (gfc_compare_types): If a derived type and an integer both have a derived type, and they are identical, this is a C binding type and compares equal. 2019-01-29 Thomas Koenig PR fortran/57048 * gfortran.dg/c_funptr_1.f90: New file. * gfortran.dg/c_funptr_1_mod.f90: New file. From-SVN: r268372 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/interface.c | 10 ++++++ gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/c_funptr_1.f90 | 38 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/c_funptr_1_mod.f90 | 16 +++++++++ 5 files changed, 77 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/c_funptr_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/c_funptr_1_mod.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c1d25260652..5b30ac62b70 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2019-01-29 Thomas Koenig + + PR fortran/57048 + * interface.c (gfc_compare_types): If a derived type and an + integer both have a derived type, and they are identical, + this is a C binding type and compares equal. + 2019-01-26 Harald Anlauf PR fortran/57553 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 99011e72370..a07e658db88 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -692,6 +692,16 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) if (ts1->type == BT_VOID || ts2->type == BT_VOID) return true; + /* Special case for our C interop types. FIXME: There should be a + better way of doing this. When ISO C binding is cleared up, + this can probably be removed. See PR 57048. */ + + if (((ts1->type == BT_INTEGER && ts2->type == BT_DERIVED) + || (ts1->type == BT_DERIVED && ts2->type == BT_INTEGER)) + && ts1->u.derived && ts2->u.derived + && ts1->u.derived == ts2->u.derived) + return true; + /* The _data component is not always present, therefore check for its presence before assuming, that its derived->attr is available. When the _data component is not present, then nevertheless the diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 749ac361178..45e3c7f917b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-01-29 Thomas Koenig + + PR fortran/57048 + * gfortran.dg/c_funptr_1.f90: New file. + * gfortran.dg/c_funptr_1_mod.f90: New file. + 2019-01-29 Jakub Jelinek PR c++/66676 diff --git a/gcc/testsuite/gfortran.dg/c_funptr_1.f90 b/gcc/testsuite/gfortran.dg/c_funptr_1.f90 new file mode 100644 index 00000000000..541f0765960 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_funptr_1.f90 @@ -0,0 +1,38 @@ +! { dg-do preprocess } +! { dg-additional-options "-cpp" } +! PR 57048 - this used not to compile. Original test case by Angelo +! Graziosi. Only works if compiled c_funptr_1_mod.f90, hence the +! do-nothing directive above. +module procs + + implicit none + private + + public WndProc + +contains + function WndProc() + integer :: WndProc + + WndProc = 0 + end function WndProc +end module procs + +function WinMain() + use, intrinsic :: iso_c_binding, only: C_INT,c_sizeof,c_funloc + use win32_types + use procs + implicit none + + integer :: WinMain + + type(WNDCLASSEX_T) :: WndClass + + WndClass%cbSize = int(c_sizeof(Wndclass),C_INT) + WndClass%lpfnWndProc = c_funloc(WndProc) + + WinMain = 0 +end function WinMain + +program main +end diff --git a/gcc/testsuite/gfortran.dg/c_funptr_1_mod.f90 b/gcc/testsuite/gfortran.dg/c_funptr_1_mod.f90 new file mode 100644 index 00000000000..6db515bdf16 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_funptr_1_mod.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-additional-sources c_funptr_1.f90 } +! Additional module to go with c_funptr_1.f90 +module win32_types + use, intrinsic :: iso_c_binding, only: C_INT,C_FUNPTR + implicit none + private + + public WNDCLASSEX_T + type, bind(C) :: WNDCLASSEX_T + integer(C_INT) :: cbSize + type(C_FUNPTR) :: lpfnWndProc + + end type WNDCLASSEX_T + +end module win32_types -- 2.30.2