flang/test/Semantics/null01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   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     subroutine optionalAllocatable(x)
  16       integer, intent(in), allocatable, optional :: x
  17     end
  18     function f0()
  19       real :: f0
  20     end function
  21     function f1(x)
  22       real :: f1
  23       real, intent(inout) :: x
  24     end function
  25     function f2(p)
  26       import s0
  27       real :: f1
  28       procedure(s0), pointer, intent(inout) :: p
  29     end function
  30     function f3()
  31       import s1
  32       procedure(s1), pointer :: f3
  33     end function
  34   end interface
  35   external implicit
  36   type :: dt0
  37     integer, pointer :: ip0
  38     integer :: n = 666
  39   end type dt0
  40   type :: dt1
  41     integer, pointer :: ip1(:)
  42   end type dt1
  43   type :: dt2
  44     procedure(s0), pointer, nopass :: pps0
  45   end type dt2
  46   type :: dt3
  47     procedure(s1), pointer, nopass :: pps1
  48   end type dt3
  49   type :: dt4
  50     real, allocatable :: ra0
  51   end type dt4
  52   type, extends(dt4) :: dt5
  53   end type dt5
  54   integer :: j
  55   type(dt0) :: dt0x
  56   type(dt1) :: dt1x
  57   type(dt2) :: dt2x
  58   type(dt3) :: dt3x
  59   type(dt4) :: dt4x
  60   integer, pointer :: ip0, ip1(:), ip2(:,:)
  61   integer, allocatable :: ia0, ia1(:), ia2(:,:)
  62   real, pointer :: rp0, rp1(:)
  63   integer, parameter :: ip0r = rank(null(mold=ip0))
  64   integer, parameter :: ip1r = rank(null(mold=ip1))
  65   integer, parameter :: ip2r = rank(null(mold=ip2))
  66   integer, parameter :: eight = ip0r + ip1r + ip2r + 5
  67   real(kind=eight) :: r8check
  68   logical, pointer :: lp
  69   type(dt4), pointer :: dt4p
  70   type(dt5), pointer :: dt5p
  71   ip0 => null() ! ok
  72   ip0 => null(null()) ! ok
  73   ip0 => null(null(null())) ! ok
  74   ip1 => null() ! ok
  75   ip1 => null(null()) ! ok
  76   ip1 => null(null(null())) ! ok
  77   ip2 => null() ! ok
  78   ip2 => null(null()) ! ok
  79   ip2 => null(null(null())) ! ok
  80   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  81   ip0 => null(mold=1)
  82   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  83   ip0 => null(null(mold=1))
  84   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  85   ip0 => null(mold=j)
  86   !ERROR: MOLD= argument to NULL() must be a pointer or allocatable
  87   ip0 => null(mold=null(mold=j))
  88   dt0x = dt0(null())
  89   dt0x = dt0(ip0=null())
  90   dt0x = dt0(ip0=null(ip0))
  91   dt0x = dt0(ip0=null(mold=ip0))
  92   !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
  93   dt0x = dt0(ip0=null(mold=rp0))
  94   !ERROR: A NULL pointer may not be used as the value for component 'n'
  95   dt0x = dt0(null(), null())
  96   !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'
  97   dt1x = dt1(ip1=null(mold=rp1))
  98   dt2x = dt2(pps0=null())
  99   dt2x = dt2(pps0=null(mold=dt2x%pps0))
 100   !ERROR: Procedure pointer 'pps0' associated with result of reference to function 'null' that is an incompatible procedure pointer: distinct numbers of dummy arguments
 101   dt2x = dt2(pps0=null(mold=dt3x%pps1))
 102   !ERROR: Procedure pointer 'pps1' associated with result of reference to function 'null' that is an incompatible procedure pointer: distinct numbers of dummy arguments
 103   dt3x = dt3(pps1=null(mold=dt2x%pps0))
 104   dt3x = dt3(pps1=null(mold=dt3x%pps1))
 105   dt4x = dt4(null()) ! ok
 106   !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'ra0'
 107   dt4x = dt4(null(rp0))
 108   !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'ra0'
 109   !ERROR: Rank-1 array value is not compatible with scalar component 'ra0'
 110   dt4x = dt4(null(rp1))
 111   !ERROR: A NULL procedure pointer may not be used as the value for component 'ra0'
 112   dt4x = dt4(null(dt2x%pps0))
 113   call canbenull(null(), null()) ! fine
 114   call canbenull(null(mold=ip0), null(mold=rp0)) ! fine
 115   call optionalAllocatable(null(mold=ip0)) ! fine
 116   !ERROR: Null pointer argument requires an explicit interface
 117   call implicit(null())
 118   !ERROR: Null pointer argument requires an explicit interface
 119   call implicit(null(mold=ip0))
 120   !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument
 121   print *, sin(null(rp0))
 122   !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument
 123   print *, kind(null())
 124   print *, kind(null(rp0)) ! ok
 125   !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument
 126   print *, extends_type_of(null(), null())
 127   print *, extends_type_of(null(dt5p), null(dt4p)) ! ok
 128   !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument
 129   print *, same_type_as(null(), null())
 130   print *, same_type_as(null(dt5p), null(dt4p)) ! ok
 131   !ERROR: A NULL() pointer is not allowed for 'source=' intrinsic argument
 132   print *, transfer(null(rp0),ip0)
 133   !WARNING: Source of TRANSFER contains allocatable or pointer component %ra0
 134   print *, transfer(dt4(null()),[0])
 135   !ERROR: NULL() may not be used as an expression in this context
 136   select case(null(ip0))
 137   end select
 138   !ERROR: NULL() may not be used as an expression in this context
 139   if (null(lp)) then
 140   end if
 141 end subroutine test
 142
 143 module m
 144   type :: pdt(n)
 145     integer, len :: n
 146   end type
 147  contains
 148   subroutine s1(x)
 149     character(*), pointer, intent(in) :: x
 150   end
 151   subroutine s2(x)
 152     type(pdt(*)), pointer, intent(in) :: x
 153   end
 154   subroutine s3(ar)
 155     real, pointer :: ar(..)
 156   end
 157   subroutine test(ar)
 158     real, pointer :: ar(..)
 159     !ERROR: Actual argument associated with dummy argument 'x=' is a NULL() pointer without a MOLD= to provide a character length
 160     call s1(null())
 161     !ERROR: Actual argument associated with dummy argument 'x=' is a NULL() pointer without a MOLD= to provide a value for the assumed type parameter 'n'
 162     call s2(null())
 163     !ERROR: MOLD= argument to NULL() must not be assumed-rank
 164     call s3(null(ar))
 165   end
 166 end