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     integer :: n = 666
  36   end type dt0
  37   type :: dt1
  38     integer, pointer :: ip1(:)
  39   end type dt1
  40   type :: dt2
  41     procedure(s0), pointer, nopass :: pps0
  42   end type dt2
  43   type :: dt3
  44     procedure(s1), pointer, nopass :: pps1
  45   end type dt3
  46   type :: dt4
  47     real, allocatable :: ra0
  48   end type dt4
  49   integer :: j
  50   type(dt0) :: dt0x
  51   type(dt1) :: dt1x
  52   type(dt2) :: dt2x
  53   type(dt3) :: dt3x
  54   type(dt4) :: dt4x
  55   integer, pointer :: ip0, ip1(:), ip2(:,:)
  56   integer, allocatable :: ia0, ia1(:), ia2(:,:)
  57   real, pointer :: rp0, rp1(:)
  58   integer, parameter :: ip0r = rank(null(mold=ip0))
  59   integer, parameter :: ip1r = rank(null(mold=ip1))
  60   integer, parameter :: ip2r = rank(null(mold=ip2))
  61   integer, parameter :: eight = ip0r + ip1r + ip2r + 5
  62   real(kind=eight) :: r8check
  63   logical, pointer :: lp
  64   ip0 => null() ! ok
  65   ip1 => null() ! ok
  66   ip2 => null() ! ok
  67   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  68   ip0 => null(mold=1)
  69   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  70   ip0 => null(mold=j)
  71   dt0x = dt0(null())
  72   dt0x = dt0(ip0=null())
  73   dt0x = dt0(ip0=null(ip0))
  74   dt0x = dt0(ip0=null(mold=ip0))
  75   !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
  76   dt0x = dt0(ip0=null(mold=rp0))
  77   !ERROR: A NULL pointer may not be used as the value for component 'n'
  78   dt0x = dt0(null(), null())
  79   !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
  80   dt1x = dt1(ip1=null(mold=rp1))
  81   dt2x = dt2(pps0=null())
  82   dt2x = dt2(pps0=null(mold=dt2x%pps0))
  83   !ERROR: Procedure pointer 'pps0' associated with result of reference to function 'null' that is an incompatible procedure pointer: distinct numbers of dummy arguments
  84   dt2x = dt2(pps0=null(mold=dt3x%pps1))
  85   !ERROR: Procedure pointer 'pps1' associated with result of reference to function 'null' that is an incompatible procedure pointer: distinct numbers of dummy arguments
  86   dt3x = dt3(pps1=null(mold=dt2x%pps0))
  87   dt3x = dt3(pps1=null(mold=dt3x%pps1))
  88   dt4x = dt4(null()) ! ok
  89   !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'ra0'
  90   dt4x = dt4(null(rp0))
  91   !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'ra0'
  92   !ERROR: Rank-1 array value is not compatible with scalar component 'ra0'
  93   dt4x = dt4(null(rp1))
  94   !ERROR: A NULL procedure pointer may not be used as the value for component 'ra0'
  95   dt4x = dt4(null(dt2x%pps0))
  96   call canbenull(null(), null()) ! fine
  97   call canbenull(null(mold=ip0), null(mold=rp0)) ! fine
  98   !ERROR: Null pointer argument requires an explicit interface
  99   call implicit(null())
 100   !ERROR: Null pointer argument requires an explicit interface
 101   call implicit(null(mold=ip0))
 102   !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument
 103   print *, sin(null(rp0))
 104   !ERROR: A NULL() pointer is not allowed for 'source=' intrinsic argument
 105   print *, transfer(null(rp0),ip0)
 106   !ERROR: NULL() may not be used as an expression in this context
 107   select case(null(ip0))
 108   end select
 109   !ERROR: NULL() may not be used as an expression in this context
 110   if (null(lp)) then
 111   end if
 112 end subroutine test