flang/test/Semantics/null01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! NULL() intrinsic function error tests
   3
   4 subroutine test
   5   interface
   6     subroutine s0
   7     end subroutine
   8     subroutine s1(j)
   9       integer, intent(in) :: j
  10     end subroutine
  11     subroutine canbenull(x, y)
  12       integer, intent(in), optional :: x
  13       real, intent(in), pointer :: y
  14     end
  15     function f0()
  16       real :: f0
  17     end function
  18     function f1(x)
  19       real :: f1
  20       real, intent(inout) :: x
  21     end function
  22     function f2(p)
  23       import s0
  24       real :: f1
  25       procedure(s0), pointer, intent(inout) :: p
  26     end function
  27     function f3()
  28       import s1
  29       procedure(s1), pointer :: f3
  30     end function
  31   end interface
  32   external implicit
  33   type :: dt0
  34     integer, pointer :: ip0
  35   end type dt0
  36   type :: dt1
  37     integer, pointer :: ip1(:)
  38   end type dt1
  39   type :: dt2
  40     procedure(s0), pointer, nopass :: pps0
  41   end type dt2
  42   type :: dt3
  43     procedure(s1), pointer, nopass :: pps1
  44   end type dt3
  45   integer :: j
  46   type(dt0) :: dt0x
  47   type(dt1) :: dt1x
  48   type(dt2) :: dt2x
  49   type(dt3) :: dt3x
  50   integer, pointer :: ip0, ip1(:), ip2(:,:)
  51   integer, allocatable :: ia0, ia1(:), ia2(:,:)
  52   real, pointer :: rp0, rp1(:)
  53   integer, parameter :: ip0r = rank(null(mold=ip0))
  54   integer, parameter :: ip1r = rank(null(mold=ip1))
  55   integer, parameter :: ip2r = rank(null(mold=ip2))
  56   integer, parameter :: eight = ip0r + ip1r + ip2r + 5
  57   real(kind=eight) :: r8check
  58   ip0 => null() ! ok
  59   ip1 => null() ! ok
  60   ip2 => null() ! ok
  61   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  62   ip0 => null(mold=1)
  63   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  64   ip0 => null(mold=j)
  65   dt0x = dt0(null())
  66   dt0x = dt0(ip0=null())
  67   dt0x = dt0(ip0=null(ip0))
  68   dt0x = dt0(ip0=null(mold=ip0))
  69   !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
  70   dt0x = dt0(ip0=null(mold=rp0))
  71   !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
  72   dt1x = dt1(ip1=null(mold=rp1))
  73   dt2x = dt2(pps0=null())
  74   dt2x = dt2(pps0=null(mold=dt2x%pps0))
  75   !ERROR: Procedure pointer 'pps0' associated with result of reference to function 'null' that is an incompatible procedure pointer
  76   dt2x = dt2(pps0=null(mold=dt3x%pps1))
  77   !ERROR: Procedure pointer 'pps1' associated with result of reference to function 'null' that is an incompatible procedure pointer
  78   dt3x = dt3(pps1=null(mold=dt2x%pps0))
  79   dt3x = dt3(pps1=null(mold=dt3x%pps1))
  80   call canbenull(null(), null()) ! fine
  81   call canbenull(null(mold=ip0), null(mold=rp0)) ! fine
  82   !ERROR: Null pointer argument requires an explicit interface
  83   call implicit(null())
  84   !ERROR: Null pointer argument requires an explicit interface
  85   call implicit(null(mold=ip0))
  86 end subroutine test