diff --git a/scheme/file.sld b/scheme/file.sld index e5a90e5f..510a67b2 100644 --- a/scheme/file.sld +++ b/scheme/file.sld @@ -17,7 +17,16 @@ (call-with-port (open-input-file string) proc)) (define (call-with-output-file string proc) (call-with-port (open-output-file string) proc)) - (define (with-input-from-file string thunk) #f) + (define (with-input-from-file string thunk) + ;; Have to do this the long way since parameterize is not available + (let ((old (current-input-port)) + (new ((current-input-port ') (open-input-file string)))) + (dynamic-wind + (lambda () (current-input-port ' new)) + thunk + (lambda () + (close-port (current-input-port)) + (current-input-port ' old))))) (define (with-output-to-file string thunk) ;; Have to do this the long way since parameterize is not available (let ((old (current-output-port)) diff --git a/test2.scm b/test2.scm index f966bc8e..c3d9fc57 100644 --- a/test2.scm +++ b/test2.scm @@ -3,38 +3,8 @@ (scheme write)) ; TODO: I think this compiles OK (test), but interpreter does not like it: -;cyclone> ( call-with-output-file "test.txt" (lambda () #f)) +;cyclone> +(call-with-output-file "test.txt" (lambda (port) (write 'ok port))) ;Error: Unable to evaluate: ((procedure () ...) ) -; TODO: need to get this working in compiler, then try interpreter: -;(with-output-to-file -; "test.out" -; (lambda () -; (write 'hello) -; (display " ") -; (display 'world))) -; BEGIN test code - trying to get definition of with-output-to-file to work - (define (my-make-parameter init . o) - (let* ((converter - (if (pair? o) (car o) (lambda (x) x))) - (value (converter init))) - (lambda args - (cond - ((null? args) - value) - ((eq? (car args) ') - (set! value (cadr args))) - ((eq? (car args) ') - converter) - (else - (error "bad parameter syntax")))))) - (define my-param - (my-make-parameter (current-output-port)));(Cyc-stdout))) -(define old (my-param)) -(define new ((my-param ') (open-output-file "test.txt"))) -; The next line seems to crash in icyc but not in compiled code (until write, at least). what's going on?? -(my-param ' new) -(write 'test (my-param)) -;(write 'hello-world) -; END test code diff --git a/tests/unit-tests.scm b/tests/unit-tests.scm index 5f1adb21..0b038391 100644 --- a/tests/unit-tests.scm +++ b/tests/unit-tests.scm @@ -1,5 +1,7 @@ (import (scheme base) (scheme char) + (scheme file) + (scheme read) (scheme write) (scheme eval)) @@ -263,6 +265,20 @@ (assert:equal "vector-fill!" a #(1 2 smash smash 5)) ;; END vectors +;; I/O +(with-output-to-file + "test.out" + (lambda () + (write 'hello-world))) +;(write "done with output") +(with-input-from-file + "test.out" + (lambda () + (assert:equal "I/O with-*-file test" (read) 'hello-world))) +;(write "done with input") +;; TODO: (delete-file "test.out") +;; END I/O + ; TODO: use display, output without surrounding quotes (write (list *num-passed* " tests passed with no errors")) ;;