simulate-file for testing readers

collects/2htdp/batch-io.rkt

@@ -1,11 +1,16 @@
 #lang scheme
 
-(require (for-syntax syntax/parse) srfi/13 htdp/error "private/csv/csv.ss")
+(require (for-syntax syntax/parse) 
+         srfi/13 htdp/error 
+         (rename-in lang/prim (first-order->higher-order f2h))
+         "private/csv/csv.ss")
 
 ;; todo?
 ;; -- export tokenization? 
 
 ;; -----------------------------------------------------------------------------
+(provide simulate-file) ;; syntax (simulate-file reader string ...)
+
 (provide
  ;; all reader functions consume the name of a file f:
  ;; -- f must be a file name (string) in the same folder as the program 
@@ -82,6 +87,33 @@
   (check-proc 'read-csv-file row 1 "one argument" "row")
   (read-csv-file/func f row))
 
+;; -----------------------------------------------------------------------------
+;; tester 
+
+(define-syntax (simulate-file stx)
+  (syntax-case stx ()
+    [(simulate-file) 
+     (raise-syntax-error #f "expects a reader function as first argument" stx)]
+    [(simulate-file reader str ...) #'(simulate-file/proc (f2h reader) str ...)]))
+     
+
+(define (simulate-file/proc reader . los)
+  (define _1 (check-proc "simulate-file" reader 1 "reader" "one argument"))
+  (define _2 
+    (andmap 
+     (lambda (f)
+       (check-arg "simulate-file" (string? f) "sequence of strings" "" f))
+     los))
+  (define t (make-temporary-file "drracket-temporary-file-~a"))
+  (dynamic-wind 
+   (lambda ()
+     (with-output-to-file t 
+       (lambda () (for-each displayln los)) #:exists 'replace))
+   (lambda () 
+     (reader (path->string t)))
+   (lambda ()
+     (delete-file t))))
+
 ;; -----------------------------------------------------------------------------
 ;; writer 
 
@@ -91,8 +123,8 @@
   (let ([result (not (file-exists? f))])
     (with-output-to-file f 
       (lambda () (printf "~a" str))
-      #:exists 'truncate)
-    result))
+      #:exists 'replace)
+    #t))
 
 ;; -----------------------------------------------------------------------------
 ;; auxiliaries 
@@ -115,7 +147,7 @@
 
 ;; [Listof Char] -> [Listof Char]
 (define (drop-last-newline accu)
-  (reverse (if (char=? (car accu) #\newline) (cdr accu) accu)))
+  (reverse (if (and (pair? accu) (char=? (car accu) #\newline)) (cdr accu) accu)))
 
 ;; String[file name] Symbol -> Void
 ;; effect: ensure that f is a file in current directory or report error for t

collects/2htdp/tests/batch-io.rkt

@@ -3,6 +3,36 @@
 (require rackunit)
 (require 2htdp/batch-io)
 
+(check-equal?
+ (simulate-file read-file 
+                "hello world"
+                " good bye"
+                "done")
+ "hello world\n good bye\ndone")
+
+(check-equal? 
+ (simulate-file read-lines
+                "hello world"
+                " good bye"
+                "done")
+ '("hello world" " good bye" "done"))
+
+(check-equal? 
+ (simulate-file read-words
+                "hello world"
+                " good bye"
+                "done")
+ '("hello" "world" "good" "bye" "done"))
+
+(check-equal? 
+ (simulate-file read-words/line
+                "hello world"
+                " good bye"
+                "done")
+ '(("hello" "world") ("good" "bye") ("done")))
+
+(check-equal? (simulate-file read-file) "")
+
 (define file "batch-io.txt")
 
 (define test1 #<<eos
@@ -18,11 +48,11 @@ eos
                (string #\newline)
                (second test2-as-list))))
 
-(write-file file test1)
-(check-true (string=? (read-file file) test1) "read-file 1")
+;(write-file file test1)
+(check-true (string=? (simulate-file read-file test1) test1) "read-file 1")
 
-(write-file file test2)
-(check-true (string=? (read-file file) test2) "read-file 2")
+;(write-file file test2)
+(check-true (string=? (simulate-file read-file test2) test2) "read-file 2")
 
 (write-file file test1)
 (check-equal? (read-lines file) (list test1) "as-lines 1")
@@ -75,6 +105,9 @@ eos
               "as-csv/rows")
 
 
+(check-exn exn:fail:contract? (lambda () (simulate-file cons)))
+;; (check-exn exn:fail:contract? (lambda () (simulate-file))) ;; <--- figure this out 
+
 (check-exn exn:fail:contract? (lambda () (write-file 0 1)))
 (check-exn exn:fail:contract? (lambda () (write-file '("test") 1)))
 (check-exn exn:fail:contract? (lambda () (write-file "test" '("test"))))