ref: 75381c30fbe9f71aebc53efe04b6778704b8285e
dir: /tests/file-handle.zuo/
#lang zuo
(require "harness.zuo")
(alert "file handles")
(check (not (handle? 1)))
(check (not (handle? '(handle))))
(check eof eof)
(check (eq? eof eof))
(check (handle? (fd-open-input 'stdin)))
(check (handle? (fd-open-output 'stdout (hash))))
(check (handle? (fd-open-output 'stderr (hash))))
(check-arg-fail (fd-open-output 'stdin (hash)) "not a path string")
(check-arg-fail (fd-open-input 'stdout) "not a path string")
(check-arg-fail (fd-open-input 'stderr) "not a path string")
(check-arg-fail (fd-open-output 'stdout (hash 'exists 'truncate)) "unrecognized or unused option")
(let ([out (fd-open-output (build-path tmp-dir "handle1.txt") :truncate)])
(check (handle? out))
(check (void? (fd-write out "one")))
(check (void? (fd-close out)))
(check (handle? out)))
(check-fail (let ([out (fd-open-output ,(build-path tmp-dir "handle2.txt") :truncate)])
(fd-close out)
(fd-close out))
"not an open")
(let ([in (fd-open-input (build-path tmp-dir "handle1.txt"))])
(check (handle? in))
(check (fd-read in 1) "o")
(check (fd-read in 2) "ne")
(check (fd-read in 1) eof)
(check (fd-read in 0) "")
(check (void? (fd-close in)))
(check (handle? in)))
(let ([in (fd-open-input (build-path tmp-dir "handle1.txt"))])
(check (fd-read in eof) "one")
(check (fd-read in 1) eof)
(check (fd-read in 'avail) eof)
(check (fd-read in eof) "")
(check (void? (fd-close in))))
(check-arg-fail (fd-open-output 'no :error) "not a path string")
(check-arg-fail (fd-open-output "" :error) "not a path string")
(check-arg-fail (fd-open-input 'no) "not a path string")
(check-arg-fail (fd-open-input "") "not a path string")
(check-arg-fail (fd-read 'no 0) "not an open input")
(check-arg-fail (fd-write 'no "") "not an open output")
(check-arg-fail (fd-close 'oops) "not an open input or output")
(check-arg-fail (fd-open-output "file" 'oops) "not a hash table")
(check-arg-fail (fd-open-output "file" (hash 'oops 'truncate)) "unrecognized or unused option")
(check-arg-fail (fd-open-output "file" (hash 'exists 'oops)) "invalid exists mode")
(check-arg-fail (fd-open-output ,(build-path tmp-dir "handle1.txt")
:error)
"file open failed")
(check-arg-fail (fd-open-output ,(build-path (build-path tmp-dir "no-such-dir")
"handle0.txt")
:error)
"file open failed")
(check-arg-fail (fd-open-output ,(build-path tmp-dir "nonesuch.txt")
:must-truncate)
"file open failed")
(check-arg-fail (fd-open-output ,(build-path tmp-dir "nonesuch.txt")
:update)
"file open failed")
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
:append)])
(fd-write fd " two")
(fd-close fd)
(define in (fd-open-input (build-path tmp-dir "handle1.txt")))
(check (fd-read in eof) "one two")
(fd-close in))
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
:must-truncate)])
(fd-write fd "[three]")
(fd-close fd)
(define in (fd-open-input (build-path tmp-dir "handle1.txt")))
(check (fd-read in eof) "[three]")
(fd-close in))
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
:update)])
(fd-write fd "4")
(fd-close fd)
(define in (fd-open-input (build-path tmp-dir "handle1.txt")))
(check (fd-read in eof) "4three]")
(fd-close in))
(let ([fd (fd-open-output (build-path tmp-dir "handle1.txt")
:can-update)])
(fd-write fd "50")
(fd-close fd)
(define in (fd-open-input (build-path tmp-dir "handle1.txt")))
(check (fd-read in eof) "50hree]")
(fd-close in))
(let ([fd (begin
(rm (build-path tmp-dir "handle1.txt"))
(fd-open-output (build-path tmp-dir "handle1.txt")
:can-update))])
(fd-write fd "six")
(fd-close fd)
(define in (fd-open-input (build-path tmp-dir "handle1.txt")))
(check (fd-read in eof) "six")
(fd-close in))
(let ([not-there (build-path tmp-dir "handle0.txt")])
(when (file-exists? not-there) (rm not-there))
(check-arg-fail (fd-open-input ,not-there) "file open failed"))
(let ()
(define path (build-path tmp-dir "handle2.txt"))
(define out (fd-open-output path :truncate))
(define big (apply ~a (let loop ([i 10000])
(if (= i 0)
'()
(cons "hello" (loop (- i 1)))))))
(fd-write out big)
(fd-close out)
(let ()
(define in (fd-open-input path))
(check (equal? big (fd-read in eof)))
(check (fd-read in 1) eof)
(fd-close in))
(let ()
(define in (fd-open-input path))
(define len (quotient (string-length big) 2))
(check (equal? (fd-read in len) (substring big 0 len)))
(check (fd-read in 1) (string (string-ref big len)))
(fd-close in)))
(check (fd-poll '() 0) #f)
(check (fd-poll '() 1) #f)
(check-arg-fail (fd-poll 'stdin) "not a list of")
(check-arg-fail (fd-poll '(stdin)) "not a list of")
(check-arg-fail (fd-poll '() 'oops) "not a nonnegative integer or #f")
(define zuo.exe (hash-ref (runtime-env) 'exe))
(let ([ht (process zuo.exe
"-c"
(~a "#lang zuo/base\n"
(~s '(let ()
(define in (fd-open-input 'stdin))
(define out (fd-open-output 'stdout))
(let loop ()
(define msg (fd-read in 1))
(unless (eq? msg eof)
(fd-write out msg)
(loop))))))
(hash 'stdin 'pipe
'stdout 'pipe))])
(define in (hash-ref ht 'stdout))
(define out (hash-ref ht 'stdin))
(check (fd-poll (list in) 0) #f)
(check (fd-poll (list in out) 0) out)
(check (fd-poll (list in out)) out)
(fd-write out "x")
(check (fd-poll (list in)) in)
(check (fd-poll (list in) 0) in)
(check (fd-poll (list in in in) 0) in)
(check (fd-poll (list in out)) in)
(check (fd-read in 1) "x")
(fd-close in)
(fd-close out)
(process-wait (hash-ref ht 'process))
(void))