Implement FILE-STATUS

[pforth] / fth / t_file.fth

diff --git a/fth/t_file.fth b/fth/t_file.fth
index 2817f05..018ca58 100644 (file)
--- a/fth/t_file.fth
+++ b/fth/t_file.fth
@@ -60,7 +60,7 @@ include? }T{  t_tools.fth
 
 true fp-require-e !
 
 
 true fp-require-e !
 

-true value verbose
+false value verbose

 
 : testing
     verbose IF
 
 : testing
     verbose IF


@@ -73,14 +73,6 @@ true value verbose
 : s= compare 0= ;
 : $" state IF postpone s" else ['] s" execute THEN ; immediate
 
 : 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
 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
 
 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)
 
 \ ----------------------------------------------------------------------------
 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
 
 \ ----------------------------------------------------------------------------
 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)
 
 \ ----------------------------------------------------------------------------
 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" ;
 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
 
 
 T{ FN3 DELETE-FILE DROP -> }T


@@ -225,11 +234,11 @@ 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
 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
 
 \ Tidy the test folder
 T{ fn3 DELETE-FILE DROP -> }T