Commit | Line | Data |
---|---|---|
593eb738 HE |
1 | \ Test PForth FILE wordset |
2 | ||
3 | \ To test the ANS File Access word set and extension words | |
4 | ||
5 | \ This program was written by Gerry Jackson in 2006, with contributions from | |
6 | \ others where indicated, and is in the public domain - it can be distributed | |
7 | \ and/or modified in any way but please retain this notice. | |
8 | ||
9 | \ This program is distributed in the hope that it will be useful, | |
10 | \ but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. | |
12 | ||
13 | \ The tests are not claimed to be comprehensive or correct | |
14 | ||
15 | \ ---------------------------------------------------------------------------- | |
16 | \ Version 0.13 S" in interpretation mode tested. | |
17 | \ Added SAVE-INPUT RESTORE-INPUT REFILL in a file, (moved from | |
18 | \ coreexttest.fth). | |
19 | \ Calls to COMPARE replaced with S= (in utilities.fth) | |
20 | \ 0.11 25 April 2015 S\" in interpretation mode test added | |
21 | \ REQUIRED REQUIRE INCLUDE tests added | |
22 | \ Two S" and/or S\" buffers availability tested | |
23 | \ 0.5 1 April 2012 Tests placed in the public domain. | |
24 | \ 0.4 22 March 2009 { and } replaced with T{ and }T | |
25 | \ 0.3 20 April 2007 ANS Forth words changed to upper case. | |
26 | \ Removed directory test from the filenames. | |
27 | \ 0.2 30 Oct 2006 updated following GForth tests to remove | |
28 | \ system dependency on file size, to allow for file | |
29 | \ buffering and to allow for PAD moving around. | |
30 | \ 0.1 Oct 2006 First version released. | |
31 | ||
32 | \ ---------------------------------------------------------------------------- | |
33 | \ The tests are based on John Hayes test program for the core word set | |
34 | \ and requires those files to have been loaded | |
35 | ||
36 | \ Words tested in this file are: | |
37 | \ ( BIN CLOSE-FILE CREATE-FILE DELETE-FILE FILE-POSITION FILE-SIZE | |
38 | \ OPEN-FILE R/O R/W READ-FILE READ-LINE REPOSITION-FILE RESIZE-FILE | |
39 | \ S" S\" SOURCE-ID W/O WRITE-FILE WRITE-LINE | |
40 | \ FILE-STATUS FLUSH-FILE RENAME-FILE SAVE-INPUT RESTORE-INPUT | |
41 | \ REFILL | |
42 | ||
43 | \ Words not tested: | |
44 | \ INCLUDED INCLUDE-FILE (as these will likely have been | |
45 | \ tested in the execution of the test files) | |
46 | \ ---------------------------------------------------------------------------- | |
47 | \ Assumptions, dependencies and notes: | |
48 | \ - tester.fr (or ttester.fs), errorreport.fth and utilities.fth have been | |
49 | \ included prior to this file | |
50 | \ - the Core word set is available and tested | |
51 | \ - These tests create files in the current directory, if all goes | |
52 | \ well these will be deleted. If something fails they may not be | |
53 | \ deleted. If this is a problem ensure you set a suitable | |
54 | \ directory before running this test. There is no ANS standard | |
55 | \ way of doing this. Also be aware of the file names used below | |
56 | \ which are: fatest1.txt, fatest2.txt and fatest3.txt | |
57 | \ ---------------------------------------------------------------------------- | |
58 | ||
59 | include? }T{ t_tools.fth | |
60 | ||
61 | true fp-require-e ! | |
62 | ||
63 | true value verbose | |
64 | ||
65 | : testing | |
66 | verbose IF | |
67 | source >in @ /string ." TESTING: " type cr | |
68 | THEN | |
69 | source nip >in ! | |
70 | ; immediate | |
71 | ||
72 | : -> }T{ ; | |
73 | : s= compare 0= ; | |
74 | : $" state IF postpone s" else ['] s" execute THEN ; immediate | |
75 | ||
8bf2fe25 | 76 | \ FIXME: stubs for missing definitions |
593eb738 HE |
77 | : file-status 2drop 0 -1 ; |
78 | ||
593eb738 HE |
79 | TESTING File Access word set |
80 | ||
81 | DECIMAL | |
82 | ||
83 | TEST{ | |
84 | ||
85 | \ ---------------------------------------------------------------------------- | |
86 | TESTING CREATE-FILE CLOSE-FILE | |
87 | ||
88 | : FN1 S" fatest1.txt" ; | |
89 | VARIABLE FID1 | |
90 | ||
91 | T{ FN1 R/W CREATE-FILE SWAP FID1 ! -> 0 }T | |
92 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
93 | ||
94 | \ ---------------------------------------------------------------------------- | |
95 | TESTING OPEN-FILE W/O WRITE-LINE | |
96 | ||
97 | : LINE1 S" Line 1" ; | |
98 | ||
99 | T{ FN1 W/O OPEN-FILE SWAP FID1 ! -> 0 }T | |
100 | T{ LINE1 FID1 @ WRITE-LINE -> 0 }T | |
101 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
102 | ||
103 | \ ---------------------------------------------------------------------------- | |
104 | TESTING R/O FILE-POSITION (simple) READ-LINE | |
105 | ||
106 | 200 CONSTANT BSIZE | |
107 | CREATE BUF BSIZE ALLOT | |
108 | VARIABLE #CHARS | |
109 | ||
110 | T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T | |
111 | T{ FID1 @ FILE-POSITION -> 0. 0 }T | |
112 | T{ BUF 100 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 SWAP DROP }T | |
113 | T{ BUF #CHARS @ LINE1 S= -> TRUE }T | |
114 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
115 | ||
938d9dba HE |
116 | \ Test with buffer shorter than line. |
117 | T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T | |
118 | T{ FID1 @ FILE-POSITION -> 0. 0 }T | |
119 | T{ BUF 0 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 0 }T | |
120 | T{ BUF 3 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 3 }T | |
121 | T{ BUF #CHARS @ LINE1 DROP 3 S= -> TRUE }T | |
122 | T{ BUF 100 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 NIP 3 - }T | |
123 | T{ BUF #CHARS @ LINE1 3 /STRING S= -> TRUE }T | |
124 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
125 | ||
126 | \ Test with buffer exactly as long as the line. | |
127 | T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T | |
128 | T{ FID1 @ FILE-POSITION -> 0. 0 }T | |
129 | T{ BUF LINE1 NIP FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 NIP }T | |
130 | T{ BUF #CHARS @ LINE1 S= -> TRUE }T | |
131 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
132 | ||
593eb738 HE |
133 | \ ---------------------------------------------------------------------------- |
134 | TESTING S" in interpretation mode (compile mode tested in Core tests) | |
135 | ||
136 | T{ S" abcdef" $" abcdef" S= -> TRUE }T | |
137 | T{ S" " $" " S= -> TRUE }T | |
138 | T{ S" ghi"$" ghi" S= -> TRUE }T | |
139 | ||
140 | \ ---------------------------------------------------------------------------- | |
141 | TESTING R/W WRITE-FILE REPOSITION-FILE READ-FILE FILE-POSITION S" | |
142 | ||
143 | : LINE2 S" Line 2 blah blah blah" ; | |
144 | : RL1 BUF 100 FID1 @ READ-LINE ; | |
145 | 2VARIABLE FP | |
146 | ||
147 | T{ FN1 R/W OPEN-FILE SWAP FID1 ! -> 0 }T | |
148 | T{ FID1 @ FILE-SIZE DROP FID1 @ REPOSITION-FILE -> 0 }T | |
149 | T{ FID1 @ FILE-SIZE -> FID1 @ FILE-POSITION }T | |
150 | T{ LINE2 FID1 @ WRITE-FILE -> 0 }T | |
151 | T{ 10. FID1 @ REPOSITION-FILE -> 0 }T | |
152 | T{ FID1 @ FILE-POSITION -> 10. 0 }T | |
153 | T{ 0. FID1 @ REPOSITION-FILE -> 0 }T | |
154 | T{ RL1 -> LINE1 SWAP DROP TRUE 0 }T | |
155 | T{ RL1 ROT DUP #CHARS ! -> TRUE 0 LINE2 SWAP DROP }T | |
156 | T{ BUF #CHARS @ LINE2 S= -> TRUE }T | |
157 | T{ RL1 -> 0 FALSE 0 }T | |
158 | T{ FID1 @ FILE-POSITION ROT ROT FP 2! -> 0 }T | |
159 | T{ FP 2@ FID1 @ FILE-SIZE DROP D= -> TRUE }T | |
160 | T{ S" " FID1 @ WRITE-LINE -> 0 }T | |
161 | T{ S" " FID1 @ WRITE-LINE -> 0 }T | |
162 | T{ FP 2@ FID1 @ REPOSITION-FILE -> 0 }T | |
163 | T{ RL1 -> 0 TRUE 0 }T | |
164 | T{ RL1 -> 0 TRUE 0 }T | |
165 | T{ RL1 -> 0 FALSE 0 }T | |
166 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
167 | ||
168 | \ ---------------------------------------------------------------------------- | |
169 | TESTING BIN READ-FILE FILE-SIZE | |
170 | ||
171 | : CBUF BUF BSIZE 0 FILL ; | |
172 | : FN2 S" FATEST2.TXT" ; | |
173 | VARIABLE FID2 | |
174 | : SETPAD PAD 50 0 DO I OVER C! CHAR+ LOOP DROP ; | |
175 | ||
176 | SETPAD \ If anything else is defined setpad must be called again | |
177 | \ as pad may move | |
178 | ||
179 | T{ FN2 R/W BIN CREATE-FILE SWAP FID2 ! -> 0 }T | |
180 | T{ PAD 50 FID2 @ WRITE-FILE FID2 @ FLUSH-FILE -> 0 0 }T | |
181 | T{ FID2 @ FILE-SIZE -> 50. 0 }T | |
182 | T{ 0. FID2 @ REPOSITION-FILE -> 0 }T | |
183 | T{ CBUF BUF 29 FID2 @ READ-FILE -> 29 0 }T | |
184 | T{ PAD 29 BUF 29 S= -> TRUE }T | |
185 | T{ PAD 30 BUF 30 S= -> FALSE }T | |
186 | T{ CBUF BUF 29 FID2 @ READ-FILE -> 21 0 }T | |
187 | T{ PAD 29 + 21 BUF 21 S= -> TRUE }T | |
188 | T{ FID2 @ FILE-SIZE DROP FID2 @ FILE-POSITION DROP D= -> TRUE }T | |
189 | T{ BUF 10 FID2 @ READ-FILE -> 0 0 }T | |
190 | T{ FID2 @ CLOSE-FILE -> 0 }T | |
191 | ||
192 | \ ---------------------------------------------------------------------------- | |
193 | TESTING RESIZE-FILE | |
194 | ||
195 | T{ FN2 R/W BIN OPEN-FILE SWAP FID2 ! -> 0 }T | |
196 | T{ 37. FID2 @ RESIZE-FILE -> 0 }T | |
197 | T{ FID2 @ FILE-SIZE -> 37. 0 }T | |
198 | T{ 0. FID2 @ REPOSITION-FILE -> 0 }T | |
199 | T{ CBUF BUF 100 FID2 @ READ-FILE -> 37 0 }T | |
200 | T{ PAD 37 BUF 37 S= -> TRUE }T | |
201 | T{ PAD 38 BUF 38 S= -> FALSE }T | |
202 | T{ 500. FID2 @ RESIZE-FILE -> 0 }T | |
203 | T{ FID2 @ FILE-SIZE -> 500. 0 }T | |
204 | T{ 0. FID2 @ REPOSITION-FILE -> 0 }T | |
205 | T{ CBUF BUF 100 FID2 @ READ-FILE -> 100 0 }T | |
206 | T{ PAD 37 BUF 37 S= -> TRUE }T | |
207 | T{ FID2 @ CLOSE-FILE -> 0 }T | |
208 | ||
209 | \ ---------------------------------------------------------------------------- | |
210 | TESTING DELETE-FILE | |
211 | ||
212 | T{ FN2 DELETE-FILE -> 0 }T | |
213 | T{ FN2 R/W BIN OPEN-FILE SWAP DROP 0= -> FALSE }T | |
214 | T{ FN2 DELETE-FILE 0= -> FALSE }T | |
215 | ||
216 | \ ---------------------------------------------------------------------------- | |
fe6f537b HE |
217 | TESTING multi-line ( comments |
218 | ||
219 | T{ ( 1 2 3 | |
220 | 4 5 6 | |
221 | 7 8 9 ) 11 22 33 -> 11 22 33 }T | |
222 | ||
593eb738 HE |
223 | \ ---------------------------------------------------------------------------- |
224 | TESTING SOURCE-ID (can only test it does not return 0 or -1) | |
225 | ||
226 | T{ SOURCE-ID DUP -1 = SWAP 0= OR -> FALSE }T | |
227 | ||
228 | \ ---------------------------------------------------------------------------- | |
229 | TESTING RENAME-FILE FILE-STATUS FLUSH-FILE | |
230 | ||
231 | : FN3 S" fatest3.txt" ; | |
6f3de396 | 232 | : >END FID1 @ FILE-SIZE DROP FID1 @ REPOSITION-FILE ; |
593eb738 HE |
233 | |
234 | ||
235 | T{ FN3 DELETE-FILE DROP -> }T | |
236 | T{ FN1 FN3 RENAME-FILE 0= -> TRUE }T | |
237 | T{ FN1 FILE-STATUS SWAP DROP 0= -> FALSE }T | |
238 | T{ FN3 FILE-STATUS SWAP DROP 0= -> TRUE }T \ Return value is undefined | |
239 | T{ FN3 R/W OPEN-FILE SWAP FID1 ! -> 0 }T | |
6f3de396 HE |
240 | T{ >END -> 0 }T |
241 | T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T | |
593eb738 | 242 | |
6f3de396 HE |
243 | T{ FID1 @ FLUSH-FILE -> 0 }T \ Can only test FLUSH-FILE doesn't fail |
244 | T{ FID1 @ CLOSE-FILE -> 0 }T | |
593eb738 HE |
245 | |
246 | \ Tidy the test folder | |
247 | T{ fn3 DELETE-FILE DROP -> }T | |
248 | ||
5a305613 HE |
249 | \ ------------------------------------------------------------------------------ |
250 | TESTING REQUIRED REQUIRE INCLUDED | |
251 | \ Tests taken from Forth 2012 RfD | |
252 | ||
253 | T{ 0 S" t_required-helper1.fth" REQUIRED | |
254 | REQUIRE t_required-helper1.fth | |
255 | INCLUDE t_required-helper1.fth | |
256 | -> 2 }T | |
257 | ||
258 | T{ 0 INCLUDE t_required-helper2.fth | |
259 | S" t_required-helper2.fth" REQUIRED | |
260 | REQUIRE t_required-helper2.fth | |
261 | S" t_required-helper2.fth" INCLUDED | |
262 | -> 2 }T | |
263 | ||
593eb738 HE |
264 | \ ---------------------------------------------------------------------------- |
265 | TESTING two buffers available for S" and/or S\" (Forth 2012) | |
266 | ||
267 | : SSQ12 S" abcd" ; : SSQ13 S" 1234" ; | |
268 | T{ S" abcd" S" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T | |
269 | \ nyi T{ S\" abcd" S\" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T | |
270 | \ nyi T{ S" abcd" S\" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T | |
271 | \ nyi T{ S\" abcd" S" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T | |
272 | ||
273 | ||
274 | \ ----------------------------------------------------------------------------- | |
275 | TESTING SAVE-INPUT and RESTORE-INPUT with a file source | |
276 | ||
277 | VARIABLE SIV -1 SIV ! | |
278 | ||
279 | : NEVEREXECUTED | |
280 | CR ." This should never be executed" CR | |
281 | ; | |
282 | ||
283 | T{ 11111 SAVE-INPUT | |
284 | ||
285 | SIV @ | |
286 | ||
287 | [IF] | |
288 | TESTING the -[IF]- part is executed | |
289 | 0 SIV ! | |
290 | RESTORE-INPUT | |
291 | NEVEREXECUTED | |
292 | 33333 | |
293 | [ELSE] | |
294 | ||
295 | TESTING the -[ELSE]- part is executed | |
296 | 22222 | |
297 | ||
298 | [THEN] | |
299 | ||
300 | -> 11111 0 22222 }T \ 0 comes from RESTORE-INPUT | |
301 | ||
302 | TESTING nested SAVE-INPUT, RESTORE-INPUT and REFILL from a file | |
303 | ||
304 | : READ_A_LINE | |
305 | REFILL 0= | |
306 | ABORT" REFILL FAILED" | |
307 | ; | |
308 | ||
309 | VARIABLE SI_INC 0 SI_INC ! | |
310 | ||
311 | : SI1 | |
312 | SI_INC @ >IN +! | |
313 | 15 SI_INC ! | |
314 | ; | |
315 | ||
316 | : S$ S" SAVE-INPUT SI1 RESTORE-INPUT 12345" ; | |
317 | ||
318 | CREATE 2RES -1 , -1 , \ Don't use 2VARIABLE from Double number word set | |
319 | ||
320 | : SI2 | |
321 | READ_A_LINE | |
322 | READ_A_LINE | |
323 | SAVE-INPUT | |
324 | READ_A_LINE | |
325 | READ_A_LINE | |
326 | S$ EVALUATE 2RES 2! | |
327 | RESTORE-INPUT | |
328 | ; | |
329 | ||
330 | \ WARNING: do not delete or insert lines of text after si2 is called | |
331 | \ otherwise the next test will fail | |
332 | ||
333 | T{ SI2 | |
334 | 33333 \ This line should be ignored | |
335 | 2RES 2@ 44444 \ RESTORE-INPUT should return to this line | |
336 | ||
337 | 55555 | |
338 | TESTING the nested results | |
339 | -> 0 0 2345 44444 55555 }T | |
340 | ||
341 | \ End of warning | |
342 | ||
343 | \ ---------------------------------------------------------------------------- | |
344 | ||
345 | \ CR .( End of File-Access word set tests) CR | |
346 | ||
347 | }TEST |