[flang] Better C_LOC and C_ASSOCIATED in flang/module

[klausler]

Summary

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.

[klausler]

ping

[PeteSteinfeld]

I don't understand these changes very well, but it all builds and tests correctly.

flang/module/__fortran_builtins.f90

module __Fortran_builtins
 
   type :: __builtin_lock_type
     integer(kind=int64) :: __count
   end type
 
   type :: __builtin_team_type
     integer(kind=int64) :: __id
   end type
+
+  procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
 end module

flang/module/iso_c_binding.f90

 !===-- module/iso_c_binding.f90 --------------------------------------------===!
 !
 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 ! See https://llvm.org/LICENSE.txt for license information.
 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 !
 !===------------------------------------------------------------------------===!
 
 ! See Fortran 2018, clause 18.2
 
 module iso_c_binding
 
   use __Fortran_builtins, only: &
     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)
 
   ! Table 18.2 (in clause 18.3.1)
   ! TODO: Specialize (via macros?) for alternative targets
   integer, parameter :: &
     c_int8_t = 1, &
#endif
   character(kind=c_char, len=1), parameter :: c_alert = achar(7)
   character(kind=c_char, len=1), parameter :: c_backspace = achar(8)
   character(kind=c_char, len=1), parameter :: c_form_feed = achar(12)
   character(kind=c_char, len=1), parameter :: c_new_line = achar(10)
   character(kind=c_char, len=1), parameter :: c_carriage_return = achar(13)
   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
     external :: x
     c_funloc = c_funptr(loc(x))
   end function c_funloc
 
   ! TODO c_f_procpointer
 
 end module iso_c_binding