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
|
;
; Alain C., 22 June 2012
;
; More systematic tests on EXECUTE, CALL_FUNCTION and CALL_PROCEDURE
;
pro PRO_MY_PRO, x, y
;
y=x+5
;
end
;
function FUNC_MY_FUNC, x
;
return, x+5
;
end
;
; ---------------------
; old temporay bug
;
pro TEST_BUG_3441031
;; this caused a segfault
res=EXECUTE("a = STRJOIN(STRSPLIT((['a'])[1],'a'),'a')")
;
end
;
; another old temporay bug
;
; by Sylwester Arabas <slayoo@igf.fuw.edu.pl>
pro OLD_TEST_EXECUTE
if EXECUTE('print, EXECUTE([''''])') then begin
MESSAGE, 'EXECUTE should not accept array arguments', /conti
EXIT, status=1
endif
;
end
;
; --------------------
;
pro BASIC_EXECUTE, help=help, test=test, no_exit=no_exit, verbose=verbose
;
if KEYWORD_SET(help) then begin
print, 'pro BASIC_EXECUTE, help=help, test=test, no_exit=no_exit, verbose=verbose'
return
endif
;
nb_errors = 0
tolerance=1e-5
;
; internal intrinsic function, single value
com='a=COS(!pi)'
expected=-1.
status=EXECUTE(com)
;
if (status NE 1) then nb_errors=nb_errors+1
if (ABS(a-expected) GT tolerance) then nb_errors=nb_errors+1
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 nb_errors=nb_errors+1
if (TOTAL(ABS(a-expected)) GT tolerance) then nb_errors=nb_errors+1
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
; internal intrinsic procedure (better idea welcome !)
;
com='plot, SIN(!pi*findgen(100)/10.)'
status=EXECUTE(com)
;
if (status NE 1) then nb_errors=nb_errors+1
;
; external function, single element
;
com='a=FUNC_MY_FUNC(12.)'
expected=17.
status=EXECUTE(com)
;
if (status NE 1) then nb_errors=nb_errors+1
if (ABS(a-expected) GT tolerance) then nb_errors=nb_errors+1
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 nb_errors=nb_errors+1
if (TOTAL(ABS(a-expected)) GT tolerance) then nb_errors=nb_errors+1
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 nb_errors=nb_errors+1
if (TOTAL(ABS(a-expected)) GT tolerance) then nb_errors=nb_errors+1
if KEYWORD_SET(verbose) then print, com, status, a, expected
;
;
;
if (nb_errors GT 0) then begin
MESSAGE, STRING(nb_errors)+' Errors founded when testing EXECUTE', /continue
endif else begin
MESSAGE, 'testing EXECUTE: No Errors founded', /continue
endelse
;
if KEYWORD_SET(test) then STOP
;
if (nb_errors GT 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1
;
WDELETE
;
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
OLD_TEST_EXECUTE
;
BASIC_EXECUTE, help=help, test=test, no_exit=no_exit, verbose=verbose
;
end
|
