blob: d2e9981353d7d3a41e4c227bd6064311b682d36c (
plain)
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
|
! Program to test the PRESENT intrinsic
program intrinsic_present
implicit none
integer a
integer, pointer :: b
integer, dimension(10) :: c
integer, pointer, dimension(:) :: d
if (testvar()) call abort ()
if (.not. testvar(a)) call abort ()
if (testptr()) call abort ()
if (.not. testptr(b)) call abort ()
if (testarray()) call abort ()
if (.not. testarray(c)) call abort ()
if (testparray()) call abort ()
if (.not. testparray(d)) call abort ()
contains
logical function testvar (p)
integer, optional :: p
testvar = present(p)
end function
logical function testptr (p)
integer, pointer, optional :: p
testptr = present(p)
end function
logical function testarray (p)
integer, dimension (10), optional :: p
testarray = present(p)
end function
logical function testparray (p)
integer, pointer, dimension(:), optional :: p
testparray = present(p)
end function
end program
|
