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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
c
c File: exceptionclient.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:Simple F77 exception test client
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 reportexc(exc)
implicit none
integer*8 exc
character*(100) msg
character*(1024) trace
call sidl_SIDLException_getNote_f(exc, msg)
write (6, 100) msg
call sidl_SIDLException_getTrace_f(exc, trace)
write (6, 110) trace
100 format (1x, a100)
110 format (1x, a1024)
end
subroutine testnone(fib, test)
implicit none
integer*8 fib
integer*4 test
integer*8 retval
integer*8 exc
call starttest(test)
call ExceptionTest_Fib_getFib_f (fib, 10, 25, 200, 0, retval,
$ exc)
if (exc .eq. 0) then
call reporttest(.true., test)
write (6, 100) retval
else
call reporttest(.false., test)
call reportexc(exc)
call sidl_SIDLException_deleteRef_f (exc)
endif
100 format ('fib= ', I4)
end
subroutine testneg(fib, test)
implicit none
integer*8 fib
integer*4 test
integer*8 retval
integer*8 exc
logical isone
call starttest(test)
call ExceptionTest_Fib_getFib_f (fib, -1, 10, 10, 0, retval,
$ exc)
if (exc .eq. 0) then
call reporttest(.false., test)
write (6, 100) retval
else
call sidl_SIDLException_isType_f (exc,
$ 'ExceptionTest.NegativeValueException', isone)
if (isone .eqv. .true.) then
call reporttest(.true., test)
else
call reporttest(.false., test)
endif
call reportexc(exc)
call sidl_SIDLException_deleteRef_f (exc)
endif
100 format ('fib= ', I4)
end
subroutine testdeep(fib, test)
implicit none
integer*8 fib
integer*4 test
integer*8 retval
integer*8 exc
logical isone
call starttest(test)
call ExceptionTest_Fib_getFib_f (fib, 10, 1, 100, 0, retval,
$ exc)
if (exc .eq. 0) then
call reporttest(.false., test)
write (6, 100) retval
else
call sidl_SIDLException_isType_f (exc,
$ 'ExceptionTest.TooDeepException', isone)
if (isone .eqv. .true.) then
call reporttest(.true., test)
else
call reporttest(.false., test)
endif
call reportexc(exc)
call sidl_SIDLException_deleteRef_f (exc)
endif
100 format ('fib= ', I4)
end
subroutine testbig(fib, test)
implicit none
integer*8 fib
integer*4 test
integer*8 retval
integer*8 exc
logical isone
call starttest(test)
call ExceptionTest_Fib_getFib_f (fib, 10, 100, 1, 0, retval,
$ exc)
if (exc .eq. 0) then
call reporttest(.false., test)
write (6, 100) retval
else
call sidl_SIDLException_isType_f (exc,
$ 'ExceptionTest.TooBigException', isone)
if (isone .eqv. .true.) then
call reporttest(.true., test)
else
call reporttest(.false., test)
endif
call reportexc(exc)
call sidl_SIDLException_deleteRef_f (exc)
endif
100 format ('fib= ', I4)
end
program exceptionclient
implicit none
integer*4 test
integer*8 fib
integer*8 retval, tracker
call synch_RegOut_getInstance_f(tracker)
call synch_RegOut_setExpectations_f(tracker, 4)
call ExceptionTest_Fib__create_f (fib)
test = 1
call synch_RegOut_writeComment_f(tracker,
$ 'No Exception test')
call testnone(fib, test)
call synch_RegOut_writeComment_f(tracker,
$ 'Negative Value Exception test')
call testneg(fib, test)
call synch_RegOut_writeComment_f(tracker,
$ 'Too Deep Exception test')
call testdeep(fib, test)
call synch_RegOut_writeComment_f(tracker,
$ 'Too Big Exception test')
call testbig(fib, test)
call ExceptionTest_Fib_deleteRef_f (fib)
call synch_RegOut_close_f(tracker)
call synch_RegOut_deleteRef_f(tracker)
end
|
