flang/test/Semantics/c_loc01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2 module m
   3   use iso_c_binding
   4   type haslen(L)
   5     integer, len :: L
   6   end type
   7   integer, target :: targ
   8  contains
   9   subroutine subr
  10   end
  11   subroutine test(assumedType, poly, nclen, n)
  12     type(*), target :: assumedType
  13     class(*), target ::  poly
  14     type(c_ptr) cp
  15     type(c_funptr) cfp
  16     real notATarget
  17     !PORTABILITY: Procedure pointer 'pptr' should not have an ELEMENTAL intrinsic as its interface
  18     procedure(sin), pointer :: pptr
  19     real, target :: arr(3)
  20     type(hasLen(1)), target :: clen
  21     type(hasLen(*)), target :: nclen
  22     integer, intent(in) :: n
  23     character(2), target :: ch
  24     character(1,4), target :: unicode
  25     real :: arr1(purefun1(c_loc(targ))) ! ok
  26     real :: arr2(purefun2(c_funloc(subr))) ! ok
  27     character(:), allocatable, target :: deferred
  28     character(n), pointer :: p2ch
  29     !ERROR: C_LOC() argument must be a data pointer or target
  30     cp = c_loc(notATarget)
  31     !ERROR: C_LOC() argument must be a data pointer or target
  32     cp = c_loc(pptr)
  33     !ERROR: C_LOC() argument must be contiguous
  34     cp = c_loc(arr(1:3:2))
  35     !ERROR: C_LOC() argument may not be a zero-sized array
  36     cp = c_loc(arr(3:1))
  37     !ERROR: C_LOC() argument must have an intrinsic type, assumed type, or non-polymorphic derived type with no non-constant length parameter
  38     cp = c_loc(poly)
  39     cp = c_loc(clen) ! ok
  40     !ERROR: C_LOC() argument must have an intrinsic type, assumed type, or non-polymorphic derived type with no non-constant length parameter
  41     cp = c_loc(nclen)
  42     !ERROR: C_LOC() argument may not be zero-length character
  43     cp = c_loc(ch(2:1))
  44     !WARNING: C_LOC() argument has non-interoperable character length
  45     cp = c_loc(ch)
  46     !WARNING: C_LOC() argument has non-interoperable intrinsic type or kind
  47     cp = c_loc(unicode)
  48     cp = c_loc(ch(1:1)) ! ok
  49     cp = c_loc(deferred) ! ok
  50     cp = c_loc(p2ch) ! ok
  51     !ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
  52     cp = c_ptr(0)
  53     !ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
  54     cfp = c_funptr(0)
  55     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_ptr) and TYPE(c_funptr)
  56     cp = cfp
  57     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_funptr) and TYPE(c_ptr)
  58     cfp = cp
  59   end
  60   pure integer function purefun1(p)
  61     type(c_ptr), intent(in) :: p
  62     purefun1 = 1
  63   end
  64   pure integer function purefun2(p)
  65     type(c_funptr), intent(in) :: p
  66     purefun2 = 1
  67   end
  68 end module