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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
;
; Alain C., 22 June 2012
;
; More systematic tests on EXECUTE
;
pro PRO_MY_PRO, x, y
;
y=x+5
;
end
;
function FUNC_MY_FUNC, x
;
return, x+5
;
end
;
; ---------------------
; old (corrected) bug
;
pro TEST_BUG_3441031, cumul_errors, test=test
;;
errors=0
;
; this caused a segfault, we don't care of the result
;
res=EXECUTE("a = STRJOIN(STRSPLIT((['a'])[1],'a'),'a')")
;
if (res EQ 1) then ERRORS_ADD, errors, 'Case STRJOIN'
;
BANNER_FOR_TESTSUITE, 'TEST_BUG_3441031', errors, /short
ERRORS_CUMUL, cumul_errors, errors
if KEYWORD_set(test) then STOP
;
end
;
; ---------------------
; another old (corrected) bug
;
; by Sylwester Arabas <slayoo@igf.fuw.edu.pl>
pro TEST_EXECUTE_OLD, cumul_errors, test=test
;
errors=0
;
res=EXECUTE('print, EXECUTE([''''])')
;
txt='EXECUTE should not accept array arguments'
if (res EQ 1) then ERRORS_ADD, errors, txt
;
BANNER_FOR_TESTSUITE, 'TEST_EXECUTE_OLD', errors, /short
ERRORS_CUMUL, cumul_errors, errors
if KEYWORD_set(test) then STOP
;
end
;
; --------------------
;
; All the tests in this procedure should fail
; (EXECUTE() should return 0)
;
pro TEST_EXECUTE_MISSING, cumul_errors, help=help, test=test, $
verbose=verbose
;
if KEYWORD_SET(help) then begin
print, 'pro TEST_EXECUTE_MISSING, cumul_errors, help=help, test=test, $'
print, ' verbose=verbose'
return
endif
;
errors = 0
;
status=EXECUTE('z=MY_UNKNOW_FUNCTION()')
if (status EQ 1) then ERRORS_ADD, errors, 'function without param'
;
status=EXECUTE('z=MY_UNKNOW_FUNCTION(1, 2)')
if (status EQ 1) then ERRORS_ADD, errors, 'function with param'
;
status=EXECUTE('MY_UNKNOW_PROCEDURE')
if (status EQ 1) then ERRORS_ADD, errors, 'procedure without param'
;
status=EXECUTE('MY_UNKNOW_PROCEDURE, findgen(10)')
if (status EQ 1) then ERRORS_ADD, errors, 'procedure with param'
;
; ----- final ----
;
BANNER_FOR_TESTSUITE, 'TEST_EXECUTE_MISSING', errors, /short
ERRORS_CUMUL, cumul_errors, errors
if KEYWORD_set(test) then STOP
;
end
;
; --------------------
;
pro TEST_BASIC_EXECUTE, cumul_errors, help=help, test=test, $
verbose=verbose
;
if KEYWORD_SET(help) then begin
print, 'pro TEST_BASIC_EXECUTE, cumul_errors, help=help, test=test, $'
print, ' verbose=verbose'
return
endif
;
errors = 0
tolerance=1e-5
;
; internal intrinsic function, single value
com='a=COS(!pi)'
expected=-1.
status=EXECUTE(com)
;
if (status NE 1) then ERRORS_ADD, errors, 'Cos Status'
if (ABS(a-expected) GT tolerance) then ERRORS_ADD, errors, 'Cos value'
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
; internal intrinsic function, array
;
com='a=COS(REPLICATE(!pi,10))'
expected=REPLICATE(-1.,10)
status=EXECUTE(com)
;
if (status NE 1) then ERRORS_ADD, errors, 'Cos Status (arr)'
if (TOTAL(ABS(a-expected)) GT tolerance) then $
ERRORS_ADD, errors, 'Cos Value (arr)'
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
; internal intrinsic procedure (better idea welcome !)
;
; REMOVED AS MAY STOP OR CRASH TESTS!
;com='plot, SIN(!pi*findgen(100)/10.)'
;status=EXECUTE(com)
;
;if (status NE 1) then ERRORS_ADD, errors, 'Sin Status'
;
; external function, single element
;
com='a=FUNC_MY_FUNC(12.)'
expected=17.
status=EXECUTE(com)
;
if (status NE 1) then ERRORS_ADD, errors, 'FUNC_MY_FUNC Status'
if (ABS(a-expected) GT tolerance) then $
ERRORS_ADD, errors, 'FUNC_MY_FUNC valeur 12'
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
; external function, value 2D array
;
com='a=FUNC_MY_FUNC(REPLICATE(-5,12,3))'
expected=REPLICATE(0.,12,3)
status=EXECUTE(com)
;
if (status NE 1) then ERRORS_ADD, errors, 'FUNC_MY_FUNC Status (arr)'
if (TOTAL(ABS(a-expected)) GT tolerance) then $
ERRORS_ADD, errors, 'FUNC_MY_FUNC valeur (arr)'
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
; external function, named' 2D array
;
input=REPLICATE(-5,12,3)
com='a=FUNC_MY_FUNC(input)'
expected=input+5.
status=EXECUTE(com)
;
if (status NE 1) then ERRORS_ADD, errors, 'FUNC_MY_FUNC Status (input)'
if (TOTAL(ABS(a-expected)) GT tolerance) then $
ERRORS_ADD, errors, 'FUNC_MY_FUNC valeur (input)'
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
; ----- final ----
;
BANNER_FOR_TESTSUITE, 'TEST_BASIC_EXECUTE', errors, /short
ERRORS_CUMUL, cumul_errors, errors
if KEYWORD_set(test) then STOP
;
end
;
; ----------------------------------------------------
;
pro TEST_EXECUTE, help=help, test=test, no_exit=no_exit, verbose=verbose
;
if KEYWORD_SET(help) then begin
print, 'pro TEST_EXECUTE, help=help, test=test, no_exit=no_exit, verbose=verbose'
return
endif;
;
TEST_BUG_3441031, cumul_errors
TEST_EXECUTE_OLD, cumul_errors
;
TEST_BASIC_EXECUTE, cumul_errors, test=test, verbose=verbose
;
TEST_EXECUTE_MISSING, cumul_errors
;
; ----------------- final message ----------
;
BANNER_FOR_TESTSUITE, 'TEST_EXECUTE', cumul_errors
;
if (cumul_errors GT 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1
;
if KEYWORD_SET(test) then STOP
;
end
|
