maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[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
This commit is contained in:
peter klausler 2021-01-14 12:49:27 -08:00
parent b3a5abcb36
commit a75840a09c
2 changed files with 31 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/module/__fortran_builtins.f90
View File

@ -29,4 +29,6 @@ module __Fortran_builtins
type :: __builtin_team_type
integer(kind=int64) :: __id
end type
procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
end module

40
flang/module/iso_c_binding.f90
View File

@ -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