|
3324
|
1 # Some global definitions. |
|
|
2 |
|
3898
|
3 if ![info exists OCTAVE ] then { |
|
|
4 set OCTAVE [pwd] |
|
|
5 set tail [string last /test/ $OCTAVE] |
|
|
6 if { $tail < 0 } { |
|
|
7 error "run test from in the test directory" |
|
|
8 exit 1; |
|
|
9 } |
|
|
10 set OCTAVE [string replace $OCTAVE $tail end /src/octave] |
|
|
11 } |
|
|
12 |
|
|
13 if ![info exists OCTAVE_SCRIPT_PATH ] then { |
|
|
14 set OSPATH "[pwd]" |
|
|
15 set tail [string last /test/ $OSPATH] |
|
|
16 if { $tail < 0 } { |
|
|
17 error "run test from in the test directory" |
|
|
18 exit 1; |
|
|
19 } |
|
|
20 set OSPATH "-p '[string replace $OSPATH $tail end /scripts//]:[string replace $OSPATH $tail end /src]'" |
|
|
21 } else { |
|
|
22 set OSPATH "-p $OCTAVE_SCRIPT_PATH" |
|
|
23 } |
|
|
24 |
|
3324
|
25 if ![info exists prompt] then { |
|
|
26 set prompt "octave:\[0-9\]*> " |
|
|
27 } |
|
|
28 |
|
|
29 if ![info exists nl] then { |
|
|
30 set nl "(\[\r\n\])*" |
|
|
31 } |
|
|
32 |
|
|
33 if ![info exists d] then { |
|
|
34 set d "\[0-9\]*" |
|
|
35 } |
|
|
36 |
|
|
37 if ![info exists dp] then { |
|
|
38 set dp "\.*" |
|
|
39 } |
|
|
40 |
|
|
41 if ![info exists resync] then { |
|
|
42 set resync ".*$prompt$" |
|
|
43 } |
|
|
44 |
|
|
45 # octave_version -- extract and print the version number of octave |
|
|
46 |
|
|
47 proc octave_version {} { |
|
|
48 global OCTAVE |
|
|
49 set tmp [exec $OCTAVE -v] |
|
|
50 regexp "version.*$" $tmp version |
|
|
51 clone_output "[which $OCTAVE] $version\n" |
|
|
52 unset tmp |
|
|
53 unset version |
|
|
54 } |
|
|
55 |
|
|
56 # octave_load -- loads the program |
|
|
57 |
|
|
58 proc octave_load { arg } { } |
|
|
59 |
|
|
60 # octave_exit -- quit and cleanup |
|
|
61 |
|
|
62 proc octave_exit { } { } |
|
|
63 |
|
|
64 # Start Octave for an interactive test. |
|
|
65 |
|
|
66 proc octave_interactive_start { } { |
|
|
67 global OCTAVE |
|
3898
|
68 global OSPATH |
|
3324
|
69 global prompt |
|
|
70 global nl |
|
|
71 global resync |
|
|
72 global spawn_id |
|
|
73 global verbose |
|
|
74 global timeout |
|
|
75 |
|
|
76 if { $verbose > 1 } { |
|
|
77 send_user "starting $OCTAVE\n" |
|
|
78 } |
|
|
79 |
|
|
80 # It might take a long time to start Octave, but we shouldn't leave |
|
|
81 # the timeout period at a minute for the real tests. |
|
|
82 |
|
|
83 set timeout 60 |
|
5347
|
84 spawn $OCTAVE -f -q -H $OSPATH |
|
3324
|
85 |
|
|
86 set timeout 5 |
|
|
87 expect { |
|
|
88 -re "No such file.*" { error "Can't start $OCTAVE"; exit 1 } |
|
|
89 -re "$resync" { } |
|
|
90 timeout { error "Failed to spawn $OCTAVE (timeout)"; exit 1 } |
|
|
91 } |
|
|
92 |
|
|
93 # Expectations that are checked before and after those explicitly |
|
|
94 # specified in each expect block. Note that `$test' is a purely local |
|
|
95 # variable. Leaving one of these empty will screw us. |
|
|
96 |
|
|
97 # expect_before { |
|
|
98 # } |
|
|
99 |
|
|
100 expect_after { |
|
|
101 -re "usage:.*$prompt$" { fail "$test (usage)" } |
|
|
102 -re "warning:.*$prompt$" { fail "$test (warning)" } |
|
|
103 -re "parse error:.*$prompt$" { fail "$test (parse error)" } |
|
|
104 -re "error:.*$prompt$" { fail "$test (error)" } |
|
|
105 timeout { fail "$test (timeout)" } |
|
|
106 } |
|
|
107 |
|
|
108 # Always turn off paging! |
|
|
109 |
|
|
110 send "page_screen_output = \"false\";\n" |
|
|
111 expect { |
|
|
112 -re "$resync" { } |
|
|
113 } |
|
|
114 } |
|
|
115 |
|
|
116 # Stop an interactive Octave session. |
|
|
117 |
|
|
118 proc octave_interactive_stop { } { |
|
|
119 |
|
|
120 send "quit\n" |
|
|
121 expect { |
|
|
122 -re ".*$" { } |
|
|
123 } |
|
|
124 } |
|
|
125 |
|
|
126 # Start Octave for a single non-interactive test. |
|
|
127 |
|
|
128 proc octave_start { src_file } { |
|
|
129 global OCTAVE |
|
3898
|
130 global OSPATH |
|
3324
|
131 global oct_output |
|
|
132 |
|
|
133 # Can't seem to get 2>&1 to work without using /bin/sh -c ""... |
|
|
134 |
|
5347
|
135 send_log "EXEC: $OCTAVE -f -q -H $OSPATH $src_file\n" |
|
|
136 catch "exec /bin/sh -c \"$OCTAVE -f -q -H $OSPATH $src_file 2>&1\"" oct_output |
|
3324
|
137 } |
|
|
138 |
|
|
139 # do_test -- run a test given by the file $src_code. |
|
|
140 |
|
|
141 proc do_test { src_code } { |
|
|
142 global OCTAVE |
|
|
143 global srcdir |
|
|
144 global subdir |
|
|
145 global spawn_id |
|
|
146 global verbose |
|
|
147 global timeout |
|
|
148 global prog_output |
|
|
149 global oct_output |
|
|
150 |
|
|
151 if { $verbose > 1 } { |
|
|
152 send_user "starting $OCTAVE\n" |
|
|
153 } |
|
|
154 |
|
|
155 # Reset some variables |
|
|
156 |
|
|
157 set oct_output "" |
|
|
158 |
|
|
159 set pass_message $subdir/$src_code |
|
|
160 set fail_message $subdir/$src_code |
|
|
161 |
|
|
162 set pass no |
|
|
163 |
|
|
164 # Since we are starting up a fresh Octave for nearly every test, use a |
|
|
165 # fairly large timeout value. |
|
|
166 |
|
|
167 set timeout 60 |
|
|
168 |
|
|
169 # Run the test |
|
|
170 |
|
|
171 octave_start $srcdir/$subdir/$src_code |
|
|
172 |
|
|
173 # Check for expected output. |
|
|
174 |
|
|
175 if { $verbose > 1 } { |
|
|
176 send_user "\nChecking:\n$oct_output\nto see if it matches:\n$prog_output\n" |
|
|
177 } else { |
|
|
178 send_log "\nOctave Output:\n$oct_output\n" |
|
|
179 } |
|
|
180 |
|
|
181 if [regexp $prog_output $oct_output] then { |
|
|
182 if { $verbose > 1 } { |
|
|
183 send_user "Yes, it matches.\n\n" |
|
|
184 } |
|
|
185 set pass yes |
|
|
186 } else { |
|
|
187 if { $verbose > 1 } { |
|
|
188 send_user "Nope, it does not match.\n\n" |
|
|
189 } |
|
|
190 } |
|
|
191 |
|
|
192 if [string match $pass "yes"] then { |
|
|
193 pass $pass_message |
|
|
194 } else { |
|
|
195 fail $fail_message |
|
|
196 } |
|
|
197 |
|
|
198 uplevel { |
|
|
199 if [info exists errorInfo] then { |
|
|
200 unset errorInfo |
|
|
201 } |
|
|
202 } |
|
|
203 } |
