X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/593eb738c871efd888f6c8652991dc2a413c8727..946b28a8478c998de8aaec852f23548a4242e070:/fth/t_file.fth diff --git a/fth/t_file.fth b/fth/t_file.fth index 2817f05..297f208 100644 --- a/fth/t_file.fth +++ b/fth/t_file.fth @@ -60,7 +60,7 @@ include? }T{ t_tools.fth true fp-require-e ! -true value verbose +false value verbose : testing verbose IF @@ -73,14 +73,6 @@ true value verbose : s= compare 0= ; : $" state IF postpone s" else ['] s" execute THEN ; immediate - -\ FIXME: stubs for missing definition -: flush-file drop -1 ; -: resize-file drop 2drop -1 ; -: rename-file 2drop 2drop -1 ; -: file-status 2drop 0 -1 ; - - TESTING File Access word set DECIMAL @@ -118,6 +110,23 @@ T{ BUF 100 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 SWAP DROP }T T{ BUF #CHARS @ LINE1 S= -> TRUE }T T{ FID1 @ CLOSE-FILE -> 0 }T +\ Test with buffer shorter than line. +T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T +T{ FID1 @ FILE-POSITION -> 0. 0 }T +T{ BUF 0 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 0 }T +T{ BUF 3 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 3 }T +T{ BUF #CHARS @ LINE1 DROP 3 S= -> TRUE }T +T{ BUF 100 FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 NIP 3 - }T +T{ BUF #CHARS @ LINE1 3 /STRING S= -> TRUE }T +T{ FID1 @ CLOSE-FILE -> 0 }T + +\ Test with buffer exactly as long as the line. +T{ FN1 R/O OPEN-FILE SWAP FID1 ! -> 0 }T +T{ FID1 @ FILE-POSITION -> 0. 0 }T +T{ BUF LINE1 NIP FID1 @ READ-LINE ROT DUP #CHARS ! -> TRUE 0 LINE1 NIP }T +T{ BUF #CHARS @ LINE1 S= -> TRUE }T +T{ FID1 @ CLOSE-FILE -> 0 }T + \ ---------------------------------------------------------------------------- TESTING S" in interpretation mode (compile mode tested in Core tests) @@ -202,12 +211,12 @@ T{ FN2 R/W BIN OPEN-FILE SWAP DROP 0= -> FALSE }T T{ FN2 DELETE-FILE 0= -> FALSE }T \ ---------------------------------------------------------------------------- -\ TESTING multi-line ( comments -\ -\ T{ ( 1 2 3 -\ 4 5 6 -\ 7 8 9 ) 11 22 33 -> 11 22 33 }T -\ +TESTING multi-line ( comments + +T{ ( 1 2 3 +4 5 6 +7 8 9 ) 11 22 33 -> 11 22 33 }T + \ ---------------------------------------------------------------------------- TESTING SOURCE-ID (can only test it does not return 0 or -1) @@ -217,7 +226,7 @@ T{ SOURCE-ID DUP -1 = SWAP 0= OR -> FALSE }T TESTING RENAME-FILE FILE-STATUS FLUSH-FILE : FN3 S" fatest3.txt" ; -: >END FID1 @ FILE-SIZE .s DROP FID1 @ REPOSITION-FILE ; +: >END FID1 @ FILE-SIZE DROP FID1 @ REPOSITION-FILE ; T{ FN3 DELETE-FILE DROP -> }T @@ -225,15 +234,30 @@ T{ FN1 FN3 RENAME-FILE 0= -> TRUE }T T{ FN1 FILE-STATUS SWAP DROP 0= -> FALSE }T T{ FN3 FILE-STATUS SWAP DROP 0= -> TRUE }T \ Return value is undefined T{ FN3 R/W OPEN-FILE SWAP FID1 ! -> 0 }T -\ nyi T{ >END -> 0 }T -\ nyi T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T +T{ >END -> 0 }T +T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T -\ nyi T{ FID1 @ FLUSH-FILE -> 0 }T \ Can only test FLUSH-FILE doesn't fail -\ nyi T{ FID1 @ CLOSE-FILE -> 0 }T +T{ FID1 @ FLUSH-FILE -> 0 }T \ Can only test FLUSH-FILE doesn't fail +T{ FID1 @ CLOSE-FILE -> 0 }T \ Tidy the test folder T{ fn3 DELETE-FILE DROP -> }T +\ ------------------------------------------------------------------------------ +TESTING REQUIRED REQUIRE INCLUDED +\ Tests taken from Forth 2012 RfD + +T{ 0 S" t_required_helper1.fth" REQUIRED + REQUIRE t_required_helper1.fth + INCLUDE t_required_helper1.fth + -> 2 }T + +T{ 0 INCLUDE t_required_helper2.fth + S" t_required_helper2.fth" REQUIRED + REQUIRE t_required_helper2.fth + S" t_required_helper2.fth" INCLUDED + -> 2 }T + \ ---------------------------------------------------------------------------- TESTING two buffers available for S" and/or S\" (Forth 2012)