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
|
! Program to test STATEMENT function
program st_fuction
call simple_case
call with_function_call
call with_character_dummy
call with_derived_type_dummy
call with_pointer_dummy
call multiple_eval
contains
subroutine simple_case
integer st1, st2
integer c(10, 10)
st1 (i, j) = i + j
st2 (i, j) = c(i, j)
if (st1 (1, 2) .ne. 3) call abort
c = 3
if (st2 (1, 2) .ne. 3 .or. st2 (2, 3) .ne. 3) call abort
end subroutine
subroutine with_function_call
integer fun, st3
st3 (i, j) = fun (i) + fun (j)
if (st3 (fun (2), 4) .ne. 16) call abort
end subroutine
subroutine with_character_dummy
character (len=4) s1, s2, st4
character (len=10) st5, s0
st4 (i, j) = "0123456789"(i:j)
st5 (s1, s2) = s1 // s2
if (st4 (1, 4) .ne. "0123" ) call abort
if (st5 ("01", "02") .ne. "01 02 ") call abort ! { dg-warning "Character length of actual argument shorter" }
end subroutine
subroutine with_derived_type_dummy
type person
integer age
character (len=50) name
end type person
type (person) me, p, tom
type (person) st6
st6 (p) = p
me%age = 5
me%name = "Tom"
tom = st6 (me)
if (tom%age .ne. 5) call abort
if (tom%name .gt. "Tom") call abort
end subroutine
subroutine with_pointer_dummy
character(len=4), pointer:: p, p1
character(len=4), target:: i
character(len=6) a
a (p) = p // '10'
p1 => i
i = '1234'
if (a (p1) .ne. '123410') call abort
end subroutine
subroutine multiple_eval
integer st7, fun2, fun
st7(i) = i + fun(i)
if (st7(fun2(10)) .ne. 3) call abort
end subroutine
end
! This functon returns the argument passed on the previous call.
integer function fun2 (i)
integer i
integer, save :: val = 1
fun2 = val
val = i
end function
integer function fun (i)
integer i
fun = i * 2
end function
|
