projects / pforth / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Some changes based on feedback.
[pforth] / fth / t_file.fth
CommitLineData
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
59include? }T{ t_tools.fth
60
61true fp-require-e !
62
63true 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
76
77\ FIXME: stubs for missing definition
78: flush-file drop -1 ;
79: resize-file drop 2drop -1 ;
80: rename-file 2drop 2drop -1 ;
81: file-status 2drop 0 -1 ;
82
83
84TESTING File Access word set
85
86DECIMAL
87
88TEST{
89
90\ ----------------------------------------------------------------------------
91TESTING CREATE-FILE CLOSE-FILE
92
93: FN1 S" fatest1.txt" ;
94VARIABLE FID1
95
96T{ FN1 R/W CREATE-FILE SWAP FID1 ! -> 0 }T
97T{ FID1 @ CLOSE-FILE -> 0 }T
98
99\ ----------------------------------------------------------------------------
100TESTING OPEN-FILE W/O WRITE-LINE
101
102: LINE1 S" Line 1" ;
103
104T{ FN1 W/O OPEN-FILE SWAP FID1 ! -> 0 }T
105T{ LINE1 FID1 @ WRITE-LINE -> 0 }T
106T{ FID1 @ CLOSE-FILE -> 0 }T
107
108\ ----------------------------------------------------------------------------
109TESTING R/O FILE-POSITION (simple) READ-LINE
110
111200 CONSTANT BSIZE
112CREATE BUF BSIZE ALLOT
113VARIABLE #CHARS
114
115T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T
116T{ FID1 @ FILE-POSITION -> 0. 0 }T
117T{ BUF 100 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 SWAP DROP }T
118T{ BUF #CHARS @ LINE1 S= -> TRUE }T
119T{ FID1 @ CLOSE-FILE -> 0 }T
120
938d9dba
HE		 121\ Test with buffer shorter than line.
122T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T
123T{ FID1 @ FILE-POSITION -> 0. 0 }T
124T{ BUF 0 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 0 }T
125T{ BUF 3 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 3 }T
126T{ BUF #CHARS @ LINE1 DROP 3 S= -> TRUE }T
127T{ BUF 100 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 NIP 3 - }T
128T{ BUF #CHARS @ LINE1 3 /STRING S= -> TRUE }T
129T{ FID1 @ CLOSE-FILE -> 0 }T
130
131\ Test with buffer exactly as long as the line.
132T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T
133T{ FID1 @ FILE-POSITION -> 0. 0 }T
134T{ BUF LINE1 NIP FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 NIP }T
135T{ BUF #CHARS @ LINE1 S= -> TRUE }T
136T{ FID1 @ CLOSE-FILE -> 0 }T
137
593eb738
HE		 138\ ----------------------------------------------------------------------------
139TESTING S" in interpretation mode (compile mode tested in Core tests)
140
141T{ S" abcdef" $" abcdef" S= -> TRUE }T
142T{ S" " $" " S= -> TRUE }T
143T{ S" ghi"$" ghi" S= -> TRUE }T
144
145\ ----------------------------------------------------------------------------
146TESTING R/W WRITE-FILE REPOSITION-FILE READ-FILE FILE-POSITION S"
147
148: LINE2 S" Line 2 blah blah blah" ;
149: RL1 BUF 100 FID1 @ READ-LINE ;
1502VARIABLE FP
151
152T{ FN1 R/W OPEN-FILE SWAP FID1 ! -> 0 }T
153T{ FID1 @ FILE-SIZE DROP FID1 @ REPOSITION-FILE -> 0 }T
154T{ FID1 @ FILE-SIZE -> FID1 @ FILE-POSITION }T
155T{ LINE2 FID1 @ WRITE-FILE -> 0 }T
156T{ 10. FID1 @ REPOSITION-FILE -> 0 }T
157T{ FID1 @ FILE-POSITION -> 10. 0 }T
158T{ 0. FID1 @ REPOSITION-FILE -> 0 }T
159T{ RL1 -> LINE1 SWAP DROP TRUE 0 }T
160T{ RL1 ROT DUP #CHARS ! -> TRUE 0 LINE2 SWAP DROP }T
161T{ BUF #CHARS @ LINE2 S= -> TRUE }T
162T{ RL1 -> 0 FALSE 0 }T
163T{ FID1 @ FILE-POSITION ROT ROT FP 2! -> 0 }T
164T{ FP 2@ FID1 @ FILE-SIZE DROP D= -> TRUE }T
165T{ S" " FID1 @ WRITE-LINE -> 0 }T
166T{ S" " FID1 @ WRITE-LINE -> 0 }T
167T{ FP 2@ FID1 @ REPOSITION-FILE -> 0 }T
168T{ RL1 -> 0 TRUE 0 }T
169T{ RL1 -> 0 TRUE 0 }T
170T{ RL1 -> 0 FALSE 0 }T
171T{ FID1 @ CLOSE-FILE -> 0 }T
172
173\ ----------------------------------------------------------------------------
174TESTING BIN READ-FILE FILE-SIZE
175
176: CBUF BUF BSIZE 0 FILL ;
177: FN2 S" FATEST2.TXT" ;
178VARIABLE FID2
179: SETPAD PAD 50 0 DO I OVER C! CHAR+ LOOP DROP ;
180
181SETPAD \ If anything else is defined setpad must be called again
182 \ as pad may move
183
184T{ FN2 R/W BIN CREATE-FILE SWAP FID2 ! -> 0 }T
185T{ PAD 50 FID2 @ WRITE-FILE FID2 @ FLUSH-FILE -> 0 0 }T
186T{ FID2 @ FILE-SIZE -> 50. 0 }T
187T{ 0. FID2 @ REPOSITION-FILE -> 0 }T
188T{ CBUF BUF 29 FID2 @ READ-FILE -> 29 0 }T
189T{ PAD 29 BUF 29 S= -> TRUE }T
190T{ PAD 30 BUF 30 S= -> FALSE }T
191T{ CBUF BUF 29 FID2 @ READ-FILE -> 21 0 }T
192T{ PAD 29 + 21 BUF 21 S= -> TRUE }T
193T{ FID2 @ FILE-SIZE DROP FID2 @ FILE-POSITION DROP D= -> TRUE }T
194T{ BUF 10 FID2 @ READ-FILE -> 0 0 }T
195T{ FID2 @ CLOSE-FILE -> 0 }T
196
197\ ----------------------------------------------------------------------------
198TESTING RESIZE-FILE
199
200T{ FN2 R/W BIN OPEN-FILE SWAP FID2 ! -> 0 }T
201T{ 37. FID2 @ RESIZE-FILE -> 0 }T
202T{ FID2 @ FILE-SIZE -> 37. 0 }T
203T{ 0. FID2 @ REPOSITION-FILE -> 0 }T
204T{ CBUF BUF 100 FID2 @ READ-FILE -> 37 0 }T
205T{ PAD 37 BUF 37 S= -> TRUE }T
206T{ PAD 38 BUF 38 S= -> FALSE }T
207T{ 500. FID2 @ RESIZE-FILE -> 0 }T
208T{ FID2 @ FILE-SIZE -> 500. 0 }T
209T{ 0. FID2 @ REPOSITION-FILE -> 0 }T
210T{ CBUF BUF 100 FID2 @ READ-FILE -> 100 0 }T
211T{ PAD 37 BUF 37 S= -> TRUE }T
212T{ FID2 @ CLOSE-FILE -> 0 }T
213
214\ ----------------------------------------------------------------------------
215TESTING DELETE-FILE
216
217T{ FN2 DELETE-FILE -> 0 }T
218T{ FN2 R/W BIN OPEN-FILE SWAP DROP 0= -> FALSE }T
219T{ FN2 DELETE-FILE 0= -> FALSE }T
220
221\ ----------------------------------------------------------------------------
222\ TESTING multi-line ( comments
223\
224\ T{ ( 1 2 3
225\ 4 5 6
226\ 7 8 9 ) 11 22 33 -> 11 22 33 }T
227\
228\ ----------------------------------------------------------------------------
229TESTING SOURCE-ID (can only test it does not return 0 or -1)
230
231T{ SOURCE-ID DUP -1 = SWAP 0= OR -> FALSE }T
232
233\ ----------------------------------------------------------------------------
234TESTING RENAME-FILE FILE-STATUS FLUSH-FILE
235
236: FN3 S" fatest3.txt" ;
237: >END FID1 @ FILE-SIZE .s DROP FID1 @ REPOSITION-FILE ;
238
239
240T{ FN3 DELETE-FILE DROP -> }T
241T{ FN1 FN3 RENAME-FILE 0= -> TRUE }T
242T{ FN1 FILE-STATUS SWAP DROP 0= -> FALSE }T
243T{ FN3 FILE-STATUS SWAP DROP 0= -> TRUE }T \ Return value is undefined
244T{ FN3 R/W OPEN-FILE SWAP FID1 ! -> 0 }T
245\ nyi T{ >END -> 0 }T
246\ nyi T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T
247
248\ nyi T{ FID1 @ FLUSH-FILE -> 0 }T \ Can only test FLUSH-FILE doesn't fail
249\ nyi T{ FID1 @ CLOSE-FILE -> 0 }T
250
251\ Tidy the test folder
252T{ fn3 DELETE-FILE DROP -> }T
253
254\ ----------------------------------------------------------------------------
255TESTING two buffers available for S" and/or S\" (Forth 2012)
256
257: SSQ12 S" abcd" ; : SSQ13 S" 1234" ;
258T{ S" abcd" S" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T
259\ nyi T{ S\" abcd" S\" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T
260\ nyi T{ S" abcd" S\" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T
261\ nyi T{ S\" abcd" S" 1234" SSQ13 S= ROT ROT SSQ12 S= -> TRUE TRUE }T
262
263
264\ -----------------------------------------------------------------------------
265TESTING SAVE-INPUT and RESTORE-INPUT with a file source
266
267VARIABLE SIV -1 SIV !
268
269: NEVEREXECUTED
270 CR ." This should never be executed" CR
271;
272
273T{ 11111 SAVE-INPUT
274
275SIV @
276
277[IF]
278 TESTING the -[IF]- part is executed
279 0 SIV !
280 RESTORE-INPUT
281 NEVEREXECUTED
282 33333
283[ELSE]
284
285 TESTING the -[ELSE]- part is executed
286 22222
287
288[THEN]
289
290 -> 11111 0 22222 }T \ 0 comes from RESTORE-INPUT
291
292TESTING nested SAVE-INPUT, RESTORE-INPUT and REFILL from a file
293
294: READ_A_LINE
295 REFILL 0=
296 ABORT" REFILL FAILED"
297;
298
299VARIABLE SI_INC 0 SI_INC !
300
301: SI1
302 SI_INC @ >IN +!
303 15 SI_INC !
304;
305
306: S$ S" SAVE-INPUT SI1 RESTORE-INPUT 12345" ;
307
308CREATE 2RES -1 , -1 , \ Don't use 2VARIABLE from Double number word set
309
310: SI2
311 READ_A_LINE
312 READ_A_LINE
313 SAVE-INPUT
314 READ_A_LINE
315 READ_A_LINE
316 S$ EVALUATE 2RES 2!
317 RESTORE-INPUT
318;
319
320\ WARNING: do not delete or insert lines of text after si2 is called
321\ otherwise the next test will fail
322
323T{ SI2
32433333 \ This line should be ignored
3252RES 2@ 44444 \ RESTORE-INPUT should return to this line
326
32755555
328TESTING the nested results
329 -> 0 0 2345 44444 55555 }T
330
331\ End of warning
332
333\ ----------------------------------------------------------------------------
334
335\ CR .( End of File-Access word set tests) CR
336
337}TEST
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.