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