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
|
;
; Tomas Hillberg, 28 Aug. 2019. Under GNU GPL v2+
;
; Preliminatry test suite for function ROUTINE_FILEPATH
;
; testing internal call within a procedure
pro TH_PRO1234, ref, cumul_errors, test=test
name = ROUTINE_NAME()
nb_errors = 0
if ( ROUTINE_FILEPATH() NE ref ) then ERRORS_ADD, nb_errors, 'PROC with ROUTINE_FILEPATH()'
if ( ROUTINE_FILEPATH(/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'PROC with ROUTINE_FILEPATH(/EITHER)'
if ( ROUTINE_FILEPATH(/IS_FUNC) NE '' ) then ERRORS_ADD, nb_errors, 'PROC with ROUTINE_FILEPATH(/IS_FUNC)'
BANNER_FOR_TESTSUITE, name, nb_errors, /short
ERRORS_CUMUL, cumul_errors, nb_errors
if KEYWORD_set(test) then STOP
end
; testing internal call within a function
function TH_FUNC1234, ref, cumul_errors, test=test
name = ROUTINE_NAME()
nb_errors=0
if ( ROUTINE_FILEPATH(/IS_FUNC) NE ref ) then ERRORS_ADD, nb_errors, 'FUNC with ROUTINE_FILEPATH(/IS_FUNC)'
if ( ROUTINE_FILEPATH(/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'FUNC with ROUTINE_FILEPATH(/EITHER)'
if ( ROUTINE_FILEPATH() NE '' ) then ERRORS_ADD, nb_errors, 'FUNC with ROUTINE_FILEPATH()'
BANNER_FOR_TESTSUITE, name, nb_errors, /short
ERRORS_CUMUL, cumul_errors, nb_errors
if KEYWORD_set(test) then STOP
return, 1
end
; testing internal call within a procedure
pro TH_STRUCT::PROC1, ref, cumul_errors, test=test
name = ROUTINE_NAME()
nb_errors = 0
if ( ROUTINE_FILEPATH() NE ref ) then ERRORS_ADD, nb_errors, 'STRUCT::PROC with ROUTINE_FILEPATH()'
if ( ROUTINE_FILEPATH(/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'STRUCT::PROC with ROUTINE_FILEPATH(/EITHER)'
if ( ROUTINE_FILEPATH(/IS_FUNC) NE '' ) then ERRORS_ADD, nb_errors, 'STRUCT::PROC with ROUTINE_FILEPATH(/IS_FUNC)'
BANNER_FOR_TESTSUITE, name, nb_errors, /short
ERRORS_CUMUL, cumul_errors, nb_errors
if KEYWORD_set(test) then STOP
end
; testing internal call within a function
function TH_STRUCT::FUNC1, ref, cumul_errors, test=test
name = ROUTINE_NAME()
nb_errors=0
if ( ROUTINE_FILEPATH(/IS_FUNC) NE ref ) then ERRORS_ADD, nb_errors, 'STRUCT::FUNC with ROUTINE_FILEPATH(/IS_FUNC)'
if ( ROUTINE_FILEPATH(/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'STRUCT::FUNC with ROUTINE_FILEPATH(/EITHER)'
if ( ROUTINE_FILEPATH() NE '' ) then ERRORS_ADD, nb_errors, 'STRUCT::FUNC with ROUTINE_FILEPATH()'
BANNER_FOR_TESTSUITE, name, nb_errors, /short
ERRORS_CUMUL, cumul_errors, nb_errors
if KEYWORD_set(test) then STOP
return, 1
end
pro TEST_ROUTINE_FILEPATH, help=help, verbose=verbose, short=short, $
debug=debug, test=test, no_exit=no_exit
if KEYWORD_SET(help) then begin
print, 'pro TEST_ROUTINE_FILEPATH, help=help, verbose=verbose, short=short, $'
print, ' debug=debug, test=test, no_exit=no_exit'
return
endif
name = ROUTINE_NAME()
cumul_errors = 0
ref = ROUTINE_DIR() + 'test_routine_filepath.pro'
; simple check that the ref makes sense, i.e. we should be able to read "this" script
if ( FILE_TEST( ref, /READ ) ne 1 ) then ERRORS_ADD, nb_errors, 'FILE_TEST(ref)'
TH_PRO1234, ref, cumul_errors, test=test
dummy = TH_FUNC1234( ref, cumul_errors, test=test )
; testing external calls for a procedure
if ( ROUTINE_FILEPATH('TH_PRO1234') NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(proc)'
if ( ROUTINE_FILEPATH('TH_PRO1234',/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(proc,/EITHER)'
if ( ROUTINE_FILEPATH('TH_PRO1234',/IS_FUNC) NE '' ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(proc,/IS_FUNC)'
; testing external calls for a function
if ( ROUTINE_FILEPATH('TH_FUNC1234',/IS_FUNC) NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(func,/IS_FUNC)'
if ( ROUTINE_FILEPATH('TH_FUNC1234',/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(func,/EITHER)'
if ( ROUTINE_FILEPATH('TH_FUNC1234') NE '' ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(func)'
dummy = CREATE_STRUCT( NAME='TH_STRUCT', ['an_int'], 1 )
th_obj = OBJ_NEW('TH_STRUCT')
th_obj->PROC1, ref, cumul_errors, test=test
dummy = th_obj->FUNC1( ref, cumul_errors, test=test )
; testing external calls for a procedure
if ( ROUTINE_FILEPATH('TH_STRUCT::PROC1') NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(struct::proc)'
if ( ROUTINE_FILEPATH('TH_STRUCT::PROC1',/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(struct::proc,/EITHER)'
if ( ROUTINE_FILEPATH('TH_STRUCT::PROC1',/IS_FUNC) NE '' ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(struct::proc,/IS_FUNC)'
; testing external calls for a function
if ( ROUTINE_FILEPATH('TH_STRUCT::FUNC1',/IS_FUNC) NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(struct::func,/IS_FUNC)'
if ( ROUTINE_FILEPATH('TH_STRUCT::FUNC1',/EITHER) NE ref ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(struct::func,/EITHER)'
if ( ROUTINE_FILEPATH('TH_STRUCT::FUNC1') NE '' ) then ERRORS_ADD, nb_errors, 'ROUTINE_FILEPATH(struct::func)'
OBJ_DESTROY, th_obj
BANNER_FOR_TESTSUITE, name, cumul_errors, short=short
if (cumul_errors NE 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1
if KEYWORD_SET(test) then STOP
end
|
