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