[flang-commits] [flang] a75840a - [flang] Better C_LOC and C_ASSOCIATED in flang/module

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-01-21T09:41:05-08:00
New Revision: a75840a09c65582e3ec4eb1654bd17386b71397d

URL: https://github.com/llvm/llvm-project/commit/a75840a09c65582e3ec4eb1654bd17386b71397d
DIFF: https://github.com/llvm/llvm-project/commit/a75840a09c65582e3ec4eb1654bd17386b71397d.diff

LOG: [flang] Better C_LOC and C_ASSOCIATED in flang/module

The place-holding implementation of C_LOC just didn't work
when used with our more complete semantic checking, specifically
in the case of a polymorphic argument; convert it to an external
function with an implicit interface.  C_ASSOCIATED needs to be
a generic interface with specific implementations for C_PTR and
C_FUNPTR.

Differential Revision: https://reviews.llvm.org/D94714

Added: 
    

Modified: 
    flang/module/__fortran_builtins.f90
    flang/module/iso_c_binding.f90

Removed: 
    


################################################################################
diff  --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 167bd80d6ad9..852a7a973fac 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -29,4 +29,6 @@
   type :: __builtin_team_type
     integer(kind=int64) :: __id
   end type
+
+  procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
 end module

diff  --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index eed264f531a4..3668daab46ee 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -14,7 +14,8 @@ module iso_c_binding
     c_f_pointer => __builtin_c_f_pointer, &
     c_ptr => __builtin_c_ptr, &
     c_funptr => __builtin_c_funptr, &
-    c_sizeof => sizeof
+    c_sizeof => sizeof, &
+    c_loc => __builtin_c_loc
 
   type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
   type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
@@ -76,25 +77,42 @@ module iso_c_binding
   character(kind=c_char, len=1), parameter :: c_horizontal_tab = achar(9)
   character(kind=c_char, len=1), parameter :: c_vertical_tab =  achar(11)
 
+  interface c_associated
+    module procedure c_associated_c_ptr
+    module procedure c_associated_c_funptr
+  end interface
+  private :: c_associated_c_ptr, c_associated_c_funptr
+
+  ! gfortran extensions
+  integer, parameter :: &
+    c_float128 = 16, &
+    c_float128_complex = c_float128
+
  contains
 
-  logical function c_associated(c_ptr_1, c_ptr_2)
+  logical function c_associated_c_ptr(c_ptr_1, c_ptr_2)
     type(c_ptr), intent(in) :: c_ptr_1
     type(c_ptr), intent(in), optional :: c_ptr_2
     if (c_ptr_1%__address == c_null_ptr%__address) then
-      c_associated = .false.
+      c_associated_c_ptr = .false.
     else if (present(c_ptr_2)) then
-      c_associated = c_ptr_1%__address == c_ptr_2%__address
+      c_associated_c_ptr = c_ptr_1%__address == c_ptr_2%__address
     else
-      c_associated = .true.
+      c_associated_c_ptr = .true.
     end if
-  end function c_associated
+  end function c_associated_c_ptr
 
-  function c_loc(x)
-    type(c_ptr) :: c_loc
-    type(*), dimension(..), intent(in) :: x
-    c_loc = c_ptr(loc(x))
-  end function c_loc
+  logical function c_associated_c_funptr(c_funptr_1, c_funptr_2)
+    type(c_funptr), intent(in) :: c_funptr_1
+    type(c_funptr), intent(in), optional :: c_funptr_2
+    if (c_funptr_1%__address == c_null_ptr%__address) then
+      c_associated_c_funptr = .false.
+    else if (present(c_funptr_2)) then
+      c_associated_c_funptr = c_funptr_1%__address == c_funptr_2%__address
+    else
+      c_associated_c_funptr = .true.
+    end if
+  end function c_associated_c_funptr
 
   function c_funloc(x)
     type(c_funptr) :: c_funloc