Hello world,
let the regression hunt continue!
the attached patch fixes a long-time regression where a c_funptr from a
module could not be found.
The solution is a bit of a hack, but so is our whole implementation of
the C interop stuff.
Regression-tested. OK for trunk?
Regards
Thomas
2019-01-28 Thomas Koenig <[email protected]>
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-28 Thomas Koenig <[email protected]>
PR fortran/57048
* gfortran.dg/c_funptr_1.f90: New file.
* gfortran.dg/c_funptr_1_mod.f90: New file.
Index: interface.c
===================================================================
--- interface.c (Revision 268104)
+++ interface.c (Arbeitskopie)
@@ -692,6 +692,15 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec
if (ts1->type == BT_VOID || ts2->type == BT_VOID)
return true;
+ /* Special case for our C interop types. There should be a better
+ way of doing this... */
+
+ 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
! { 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
! { 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
