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
|
c
c File: argstest.f
c Copyright: (c) 2001 The Regents of the University of California
c Revision: @(#) $Revision: 4434 $
c Date: $Date: 2005-03-17 09:05:29 -0800 (Thu, 17 Mar 2005) $
c Description:Exercise the FORTRAN interface
c
c
subroutine starttest(number)
implicit none
integer*4 number
integer*8 tracker
call synch_RegOut_getInstance_f(tracker)
call synch_RegOut_startPart_f(tracker, number)
call synch_RegOut_deleteRef_f(tracker)
end
subroutine reporttest(test, number)
implicit none
integer*4 number
integer*8 tracker
logical test
call synch_RegOut_getInstance_f(tracker)
if (test) then
call synch_RegOut_endPart_f(tracker, number, 0)
else
call synch_RegOut_endPart_f(tracker, number, 1)
endif
call synch_RegOut_deleteRef_f(tracker)
number = number + 1
end
subroutine teststring(test)
implicit none
integer*8 obj
integer*4 test
logical retval
character*80 in, inout, out, sreturn
character ch1, ch2
call Strings_Cstring__create_f(obj)
sreturn = 'Not three'
call starttest(test)
call Strings_Cstring_returnback_f(obj, .true., sreturn)
call reporttest(sreturn .eq. 'Three', test)
retval = .false.
call starttest(test)
call Strings_Cstring_passin_f(obj, 'Three', retval)
call reporttest(retval, test)
in = 'Three'
call starttest(test)
call Strings_Cstring_passin_f(obj, in, retval)
call reporttest(retval, test)
call starttest(test)
call Strings_Cstring_passin_f(obj, 'Four', retval)
call reporttest(.not. retval, test)
out = 'Not three'
call starttest(test)
call Strings_Cstring_passout_f(obj, .true., out, retval)
call reporttest(retval .and. out .eq. 'Three', test)
inout = 'Three'
call starttest(test)
call Strings_Cstring_passinout_f(obj, inout, retval)
call reporttest(retval .and. inout .eq. 'threes', test)
call starttest(test)
call Strings_Cstring_passeverywhere_f(obj,
$ 'Three', out, inout, sreturn)
call reporttest(sreturn .eq. 'Three' .and.
$ out .eq. 'Three' .and. inout .eq. 'Three',
$ test)
call starttest(test)
call Strings_Cstring_mixedarguments_f(obj, 'Test', 'z',
$ 'Test', 'z', retval)
call reporttest(retval, test)
call starttest(test)
call Strings_Cstring_mixedarguments_f(obj, 'Not', 'A',
$ 'Equal', 'a', retval)
call reporttest(.not. retval, test)
ch1 = 'z'
ch2 = 'z'
call starttest(test)
call Strings_Cstring_mixedarguments_f(obj, 'Test', ch1,
$ 'Test', ch1, retval)
call reporttest(retval, test)
call starttest(test)
call Strings_Cstring_mixedarguments_f(obj, 'Test', ch1,
$ 'Test', ch2, retval)
call reporttest(retval, test)
ch2 = 'A'
call starttest(test)
call Strings_Cstring_mixedarguments_f(obj, 'Not', ch1,
$ 'Equal', ch2, retval)
call reporttest(.not. retval, test)
call Strings_Cstring_deleteRef_f(obj)
end
program stringstest
integer*4 test
integer*8 tracker
test = 1
call synch_RegOut_getInstance_f(tracker)
call synch_RegOut_setExpectations_f(tracker, 12)
call synch_RegOut_writeComment_f(tracker,
$ 'String tests')
call teststring(test)
call synch_RegOut_close_f(tracker)
call synch_RegOut_deleteRef_f(tracker)
end
|
