From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Tue, 29 Jan 2019 22:40:26 +0000 (+0000)
Subject: re PR fortran/57048 (Handling of C_PTR and C_FUNPTR leads to reject valid)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5af5f1de35772754e844c391ab5bfa90ad231077;p=gcc.git

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 c1d25260652..5b30ac62b70 100644
--- 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 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  <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
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