flang/test/Semantics/null01.f90

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