From: tkoenig Date: Tue, 29 Jan 2019 22:40:26 +0000 (+0000) Subject: 2019-01-29 Thomas Koenig X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=659d7fd3b22f95824cc7d953c2633d3a5c6ab354;p=thirdparty%2Fgcc.git 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@268372 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c1d252606523..5b30ac62b702 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 99011e723709..a07e658db881 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 749ac361178b..45e3c7f917b8 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 000000000000..541f07659604 --- /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 000000000000..6db515bdf16e --- /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