re PR fortran/57048 (Handling of C_PTR and C_FUNPTR leads to reject valid)

2019-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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  <tkoenig@gcc.gnu.org>

	PR fortran/57048
	* gfortran.dg/c_funptr_1.f90: New file.
	* gfortran.dg/c_funptr_1_mod.f90: New file.

From-SVN: r268372

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c1d252606523d33e3aae3ba43010c8d7d62c6d2d..5b30ac62b7029b937689cd2cd09945038b9c7115 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       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  <anlauf@gmx.de>
 
        PR fortran/57553

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 99011e723709b4745bc09df952fc12b981ab9d91..a07e658db881c71e7b53f32bf59c7db3e14371ea 100644 (file)
--- 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 749ac361178bbbd7096aeae9050a8d4199dd3d95..45e3c7f917b8991d1b876f2d0ad4535d15e86db5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       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  <jakub@redhat.com>
 
        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 (file)
index 0000000..541f076
--- /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 (file)
index 0000000..6db515b
--- /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