xref: /llvm-project/flang/test/Semantics/null01.f90 (revision 2414a90730d87c20d9ff8d7951ed24e3328124ed)
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
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    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
141end subroutine test
142
143module 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
166end
167