

(if (not (defined? 'SECTION))
    (load-relative "testing.ss"))

(define testing.ss (build-path (current-load-relative-directory) "testing.ss"))

(SECTION 6 10 1)
(test #t input-port? (current-input-port))
(test #t output-port? (current-output-port))
(test #t output-port? (current-error-port))
(test (void) current-input-port (current-input-port))
(test (void) current-output-port (current-output-port))
(test (void) current-error-port (current-error-port))
(test #t call-with-input-file testing.ss input-port?)
(define this-file (open-input-file testing.ss))
(test #t input-port? this-file)
(close-input-port this-file)
(define this-file (open-input-file testing.ss 'binary))
(test #t input-port? this-file)
(close-input-port this-file)
(define this-file (open-input-file testing.ss 'text))
(test #t input-port? this-file)
(arity-test input-port? 1 1)
(arity-test output-port? 1 1)
(arity-test current-input-port 0 1)
(arity-test current-output-port 0 1)
(arity-test current-error-port 0 1)
(error-test '(current-input-port 8))
(error-test '(current-output-port 8))
(error-test '(current-error-port 8))
(error-test '(current-input-port (current-output-port)))
(error-test '(current-output-port (current-input-port)))
(error-test '(current-error-port (current-input-port)))
(SECTION 6 10 2)
(test #\; peek-char this-file)
(arity-test peek-char 0 1)
(test #\; read-char this-file)
(arity-test read-char 0 1)
(test '(define cur-section '()) read this-file)
(arity-test read 0 1)
(test #\( peek-char this-file)
(test '(define errs '()) read this-file)
(close-input-port this-file)
(close-input-port this-file)
(arity-test close-input-port 1 1)
(arity-test close-output-port 1 1)
(error-test '(peek-char 5))
(error-test '(peek-char (current-output-port)))
(error-test '(read-char 5))
(error-test '(read-char (current-output-port)))
(error-test '(read 5))
(error-test '(read (current-output-port)))
(error-test '(close-input-port 5))
(error-test '(close-output-port 5))
(error-test '(close-input-port (current-output-port)))
(error-test '(close-output-port (current-input-port)))
(define (check-test-file name)
  (define test-file (open-input-file name))
  (test #t 'input-port?
	(call-with-input-file
	    name
	  (lambda (test-file)
	    (test load-test-obj read test-file)
	    (test #t eof-object? (peek-char test-file))
	    (test #t eof-object? (read-char test-file))
	    (input-port? test-file))))
  (test #\; read-char test-file)
  (test display-test-obj read test-file)
  (test load-test-obj read test-file)
  (close-input-port test-file))
(SECTION 6 10 3)
(define write-test-obj
  '(#t #f #\a () 9739 -3 . #((test) "te \" \" st" "" test #() b c)))
(define display-test-obj
  '(#t #f a () 9739 -3 . #((test) te " " st test #() b c)))
(define load-test-obj
  (list 'define 'foo (list 'quote write-test-obj)))
(let ([f (lambda (test-file)
	   (write-char #\; test-file)
	   (display write-test-obj test-file)
	   (newline test-file)
	   (write load-test-obj test-file)
	   (output-port? test-file))])
  (test #t call-with-output-file
	"tmp1" f 'truncate))
(check-test-file "tmp1")

(test (string #\null #\null #\" #\null #\")
      'write-null
      (let ([p (open-output-string)])
	(write-char #\null p)
	(display (string #\null) p)
	(write (string #\null) p)
	(let ([s (get-output-string p)])
	  s)))

; Test string ports with file-position:
(let ([s (open-output-string)])
  (test (string) get-output-string s)
  (test 0 file-position s)
  (display "a" s)
  (test (string #\a) get-output-string s)
  (test 1 file-position s)
  (test (void) file-position s 10)
  (test 10 file-position s)
  (test (string #\a #\nul #\nul #\nul #\nul #\nul #\nul #\nul #\nul #\nul) get-output-string s)
  (display "z" s)
  (test (string #\a #\nul #\nul #\nul #\nul #\nul #\nul #\nul #\nul #\nul #\z) get-output-string s)
  (test 11 file-position s)
  (test (void) file-position s 3)
  (display "mmm" s)
  (test (string #\a #\nul #\nul #\m #\m #\m #\nul #\nul #\nul #\nul #\z) get-output-string s)
  (test 6 file-position s)
  (display "banana" s)
  (test (string #\a #\nul #\nul #\m #\m #\m #\b #\a #\n #\a #\n #\a) get-output-string s)
  (test 12 file-position s))
(let ([s (open-input-string "hello")])
  (test 0 file-position s)
  (test #\h read-char s)
  (test 1 file-position s)
  (test #\e read-char s)
  (test (void) file-position s 0)
  (test 0 file-position s)
  (test #\h read-char s)
  (test (void) file-position s 4)
  (test 4 file-position s)
  (test #\o read-char s)
  (test 5 file-position s)
  (test eof read-char s)
  (test 5 file-position s)
  (test (void) file-position s 502)
  (test eof read-char s)
  (test eof read-char s)
  (test 502 file-position s)
  (test (void) file-position s 2)
  (test #\l read-char s)
  (test 3 file-position s))

(define s (open-output-string))
(error-test '(file-position 's 1))
(error-test '(file-position s 'one))
(error-test '(file-position s -1))
(error-test '(file-position s (expt 2 100)) exn:application:mismatch?)
(error-test '(file-position (make-input-port void void void) 100) exn:application:mismatch?)
(error-test '(file-position (make-output-port void void) 100) exn:application:mismatch?)
(arity-test file-position 1 2)

(define (test-read-line r1 r2 s1 s2 flags sep)
  (let ([p (open-input-string (string-append s1
					     (apply string sep)
					     s2))])
    (test r1 apply read-line p flags)
    (test r2 apply read-line p flags)))
(define (add-return s t) (string-append s (string #\return) t))
(define (add-linefeed s t) (string-append s (string #\linefeed) t))

(test-read-line "ab" "cd" "ab" "cd" null '(#\linefeed))
(test-read-line (add-return "ab" "cd") eof "ab" "cd" null '(#\return))
(test-read-line (add-return "ab" "") "cd" "ab" "cd" null '(#\return #\linefeed))
(test-read-line "ab" "cd" "ab" "cd" '(return) '(#\return))
(test-read-line (add-linefeed "ab" "cd") eof "ab" "cd" '(return) '(#\linefeed))
(test-read-line "ab" (add-linefeed "" "cd") "ab" "cd" '(return) '(#\return #\linefeed))
(test-read-line (add-return "ab" "cd") eof "ab" "cd" '(return-linefeed) '(#\return))
(test-read-line (add-linefeed "ab" "cd") eof "ab" "cd" '(return-linefeed) '(#\linefeed))
(test-read-line "ab" "cd" "ab" "cd" '(return-linefeed) '(#\return #\linefeed))
(test-read-line (add-return "ab" "") "cd" "ab" "cd" '(return-linefeed) '(#\return #\return #\linefeed))
(test-read-line "ab" (add-linefeed "" "cd") "ab" "cd" '(return-linefeed) '(#\return #\linefeed #\linefeed))
(test-read-line "ab" "cd" "ab" "cd" '(any) '(#\return))
(test-read-line "ab" "cd" "ab" "cd" '(any) '(#\linefeed))
(test-read-line "ab" "cd" "ab" "cd" '(any) '(#\return #\linefeed))
(test-read-line "ab" "" "ab" "cd" '(any) '(#\linefeed #\return))
(test-read-line "ab" "cd" "ab" "cd" '(any-one) '(#\return))
(test-read-line "ab" "cd" "ab" "cd" '(any-one) '(#\linefeed))
(test-read-line "ab" "" "ab" "cd" '(any-one) '(#\return #\linefeed))
(test-read-line "ab" "" "ab" "cd" '(any-one) '(#\linefeed #\return))

(arity-test read-line 0 2)
(error-test '(read-line 8))
(error-test '(read-line 'any))
(error-test '(read-line (current-input-port) 8))
(error-test '(read-line (current-input-port) 'anyx))

(arity-test open-input-file 1 2)
(error-test '(open-input-file 8))
(error-test '(open-input-file "x" 8))
(error-test '(open-input-file "x" 'something-else))
(error-test '(open-input-file "badfile") exn:i/o:filesystem?)

(arity-test open-output-file 1 3)
(error-test '(open-output-file 8))
(error-test '(open-output-file "x" 8))
(error-test '(open-output-file "x" 'something-else))
(let ([conflict? exn:application:mismatch?]
      [modes '(binary text)]
      [replacement '(error replace truncate append truncate/replace update)])
  (for-each
   (lambda (ones)
     (for-each
      (lambda (one)
	(error-test `(open-output-file "x" ',one 'bad))
	(error-test `(open-output-file "x" ',one 8))
	(error-test `(open-output-file "x" 'bad ',one))
	(error-test `(open-output-file "x" 8 ',one))
	(error-test `(call-with-output-file "x" void ',one 'bad))
	(error-test `(call-with-output-file "x" void ',one 8))
	(error-test `(call-with-output-file "x" void 'bad ',one))
	(error-test `(call-with-output-file "x" void 8 ',one))
	(error-test `(with-output-to-file "x" void ',one 8))
	(error-test `(with-output-to-file "x" void ',one 'bad))
	(error-test `(with-output-to-file "x" void 8 ',one))
	(error-test `(with-output-to-file "x" void 'bad ',one))
	(for-each
	 (lambda (two)
	   (error-test `(open-output-file "x" ',one ',two) conflict?)
	   (error-test `(call-with-output-file "x" void ',one ',two) conflict?)
	   (error-test `(with-output-to-file "x" void ',one ',two) conflict?))
	 ones))
      ones))
   `(,modes ,replacement)))
(error-test '(open-output-file (build-path (current-directory) "baddir" "x"))
	    exn:i/o:filesystem?)

(when (file-exists? "tmp4")
  (delete-file "tmp4"))
(close-output-port (open-output-file "tmp4"))
(error-test '(let ([c (make-custodian)])
	       (let ([p (parameterize ([current-custodian c])
				      (open-output-file "tmp4" 'replace))])
		 (custodian-shutdown-all c)
		 (display 'hi p)))
	    exn:i/o:port:closed?)
(error-test '(open-output-file "tmp4" 'error) exn:i/o:filesystem?)
(define p (open-output-file "tmp4" 'replace))
(display 7 p)
(display "" p)
(close-output-port p)
(close-output-port (open-output-file "tmp4" 'truncate))
(define p (open-input-file "tmp4"))
(test eof read p)
(close-input-port p)
(define p (open-output-file "tmp4" 'replace))
(display 7 p)
(close-output-port p)
(define p (open-output-file "tmp4" 'append))
(display 7 p)
(close-output-port p)
(error-test '(display 9 p) exn:i/o:port:closed?)
(error-test '(write 9 p) exn:i/o:port:closed?)
(error-test '(write-char #\a p) exn:i/o:port:closed?)

(error-test '(let ([c (make-custodian)])
	       (let ([p (parameterize ([current-custodian c])
				      (open-input-file "tmp4"))])
		 (custodian-shutdown-all c)
		 (read p)))
	    exn:i/o:port:closed?)
(define p (open-input-file "tmp4"))
(test 77 read p)
(close-input-port p)
(error-test '(read p) exn:i/o:port:closed?)
(error-test '(read-char p) exn:i/o:port:closed?)
(error-test '(char-ready? p) exn:i/o:port:closed?)

(define p (open-output-file "tmp4" 'update))
(display 6 p)
(close-output-port p)
(test 2 file-size "tmp4")
(define p (open-input-file "tmp4"))
(test 67 read p)
(test eof read p)
(close-input-port p)

(define p (open-output-file "tmp4" 'update))
(file-position p 1)
(display 68 p)
(close-output-port p)
(test 3 file-size "tmp4")
(define p (open-input-file "tmp4"))
(test 0 file-position p)
(test 668 read p)
(test 3 file-position p)
(test eof read p)
(test 3 file-position p)
(file-position p 1)
(test 1 file-position p)
(test #\6 read-char p)
(test #\8 read-char p)
(file-position p 0)
(test 0 file-position p)
(test #\6 read-char p)
(test 1 file-position p)
(file-position p 2)
(test #\8 read-char p)
(test 3 file-position p)
(close-input-port p)

(close-output-port (open-output-file "tmp4" 'truncate/replace))
(define p (open-input-file "tmp4"))
(test eof read p)
(close-input-port p)

(arity-test call-with-input-file 2 3)
(arity-test call-with-output-file 2 4)
(arity-test with-input-from-file 2 3)
(arity-test with-output-to-file 2 4)

(error-test '(call-with-input-file "x" 8))
(error-test '(call-with-input-file  8 (lambda (x) x)))
(error-test '(call-with-input-file  8 (lambda () 9)))
(error-test '(call-with-input-file  "x" (lambda (x) x) 8))
(error-test '(call-with-input-file  "x" (lambda (x) x) 'bad))

(error-test '(call-with-output-file "x" 8))
(error-test '(call-with-output-file  8 (lambda (x) x)))
(error-test '(call-with-output-file  8 (lambda () 9)))
(error-test '(call-with-output-file  "x" (lambda (x) x) 8))
(error-test '(call-with-output-file  "x" (lambda (x) x) 'bad))

(error-test '(with-input-from-file "x" 8))
(error-test '(with-input-from-file  8 (lambda () 9)))
(error-test '(with-input-from-file  8 (lambda (x) x)))
(error-test '(with-input-from-file  "x" (lambda () 9) 8))
(error-test '(with-input-from-file  "x" (lambda () 9) 'bad))

(error-test '(with-output-to-file "x" 8))
(error-test '(with-output-to-file  8 (lambda () 9)))
(error-test '(with-output-to-file  8 (lambda (x) x)))
(error-test '(with-output-to-file  "x" (lambda () 9) 8))
(error-test '(with-output-to-file  "x" (lambda () 9) 'bad))

(define s (open-output-string))
(test #f input-port? s)
(test #t output-port? s)
(let ([c (current-output-port)])
  (current-output-port s) 
  (display 8)
  (current-output-port c))
(test "8" get-output-string s)
(let ([c (current-error-port)])
  (current-error-port s) 
  (display 9 (current-error-port))
  (current-error-port c))
(test "89" get-output-string s)
(define s (open-input-string (get-output-string s)))
(test #t input-port? s)
(test #f output-port? s)
(test 89 + 0
      (let ([c (current-input-port)])
	(current-input-port s) 
	(begin0
	 (read)
	 (current-input-port c))))
(test eof read s)

(arity-test open-output-string 0 0)
(arity-test open-input-string 1 1)
(arity-test get-output-string 1 1)

(error-test '(get-output-string 9))
(error-test '(get-output-string (current-output-port)))

(define-values (out in) (make-pipe))
(test #t input-port? out)
(test #t output-port? in)
(let loop ([n 1000])
  (unless (zero? n)
	  (display n in)
	  (newline in)
	  (loop (sub1 n))))
(let loop ([n 999])
  (unless (zero? n)
	  (read out)
	  (loop (sub1 n))))
(test 1 read out)
(close-output-port in)
(test eof read out)
(close-input-port out)
(arity-test make-pipe 0 0)

(test #t input-port? (make-input-port void void void))
(error-test '(read (make-input-port void void void))
	    exn:i/o:port:user?)
(arity-test make-input-port 3 4)
(error-test '(make-input-port 8 void void))
(error-test '(make-input-port void 8 void))
(error-test '(make-input-port void void 8))
(error-test '(make-input-port add1 void void))
(error-test '(make-input-port void add1 void))
(error-test '(make-input-port void void add1))

(test #t output-port? (make-output-port void void))
(arity-test make-output-port 2 2)
(error-test '(make-output-port 8 void))
(error-test '(make-output-port void 8))
(error-test '(make-output-port (lambda () 9) void))
(error-test '(make-output-port void add1))

(let ([p (make-input-port 
	  (lambda () #\a) 
	  (lambda () #t) 
	  void 
	  (lambda () #\b))])
  (test #\a read-char p)
  (test #\b peek-char p)
  (test #\a read-char p)
  (test #\b peek-char p)
  (test #\b peek-char p)
  (test #\a read-char p)
  (test 3 file-position p))

(let* ([s (open-input-string "(apple \"banana\" [coconut])")]
       [p (make-input-port 
	   (lambda () (read-char s))
	   (lambda () #t)
	   void 
	   (lambda () (peek-char s)))])
  (test '(apple "banana" [coconut]) read p))

(define test-file 
  (open-output-file "tmp2" 'truncate))
(write-char #\; test-file)
(display write-test-obj test-file)
(newline test-file)
(write load-test-obj test-file)
(test #t output-port? test-file)
(close-output-port test-file)
(check-test-file "tmp2")

(define ui (make-input-port (lambda () #\") (lambda () #t) void))
(test "" read ui)
(arity-test (port-read-handler ui) 1 1)
(error-test '((port-read-handler ui) 8))
(let ([old (port-read-handler ui)])
  (port-read-handler ui (lambda (x) "hello"))
  (test "hello" read ui)
  (port-read-handler ui old)
  (test "" read ui))
(arity-test port-read-handler 1 2)
(error-test '(port-read-handler 1))
(error-test '(port-read-handler ui 8))
(error-test '(port-read-handler (current-output-port) 8))
(error-test '(port-read-handler ui (lambda () 9)))
(error-test '(port-read-handler ui (lambda (x y) 9)))

(define sp (open-output-string))
(test (void) display "hello" sp)
(test "hello" get-output-string sp)
(test (void) write "hello" sp)
(test "hello\"hello\"" get-output-string sp)
(arity-test (port-display-handler sp) 2 2)
(arity-test (port-write-handler sp) 2 2)
(arity-test (port-print-handler sp) 2 2)
(error-test '((port-display-handler sp) 8 8))
(error-test '((port-write-handler sp) 8 8))
(error-test '((port-print-handler sp) 8 8))
(let ([oldd (port-display-handler sp)]
      [oldw (port-write-handler sp)]
      [oldp (port-print-handler sp)]
      [adding (let ([s "hello\"hello\""])
		(lambda (a)
		  (set! s (string-append s a))
		  s))])
  (port-display-handler sp (lambda (v p) (oldd "X" p) (values 1 2)))
  (test (void) display "hello" sp)
  (test (adding "X") get-output-string sp)
  (test (void) write "hello" sp)
  (test (adding "\"hello\"") get-output-string sp)
  (test (void) print "hello" sp)
  (test (adding "\"hello\"") get-output-string sp)

  (port-write-handler sp (lambda (v p) (oldd "Y" p) 5))
  (test (void) display "hello" sp)
  (test (adding "X") get-output-string sp)
  (test (void) write "hello" sp)
  (test (adding "Y") get-output-string sp)
  (test (void) print "hello" sp)
  (test (adding "\"hello\"") get-output-string sp)
  (parameterize ([global-port-print-handler display])
     (test (void) print "hello" sp)
     (test (adding "X") get-output-string sp))
  (parameterize ([global-port-print-handler oldd])
     (test (void) print "hello" sp)
     (test (adding "hello") get-output-string sp))
  (test (void) print "hello" sp)
  (test (adding "\"hello\"") get-output-string sp)
		

  (port-print-handler sp (lambda (v p) (oldd "Z" p) 5))
  (test (void) display "hello" sp)
  (test (adding "X") get-output-string sp)
  (test (void) write "hello" sp)
  (test (adding "Y") get-output-string sp)
  (test (void) print "hello" sp)
  (test (adding "Z") get-output-string sp)
  (parameterize ([global-port-print-handler display])
     (test (void) print "hello" sp)
     (test (adding "Z") get-output-string sp))
  (test (void) print "hello" sp)
  (test (adding "Z") get-output-string sp)

  (port-display-handler sp oldd)
  (test (void) display "hello" sp)
  (test (adding "hello") get-output-string sp)
  (test (void) write "hello" sp)
  (test (adding "Y") get-output-string sp)

  (port-write-handler sp oldw)
  (test (void) display "hello" sp)
  (test (adding "hello") get-output-string sp)
  (test (void) write "hello" sp)
  (test (adding "\"hello\"") get-output-string sp)

  (port-display-handler sp oldw)
  (port-write-handler sp oldd)
  (port-print-handler sp oldp)
  (test (void) display "hello" sp)
  (test (adding "\"hello\"") get-output-string sp)
  (test (void) write "hello" sp)
  (test (adding "hello") get-output-string sp)
  (test (void) print "goodbye" sp)
  (test (adding "\"goodbye\"") get-output-string sp)
  (port-display-handler sp oldd)
  (port-write-handler sp oldw))
(error-test '(port-display-handler 1))
(error-test '(port-display-handler sp 8))
(error-test '(port-display-handler (current-input-port) 8))
(error-test '(port-display-handler sp (lambda (x) 9)))
(error-test '(port-display-handler sp (lambda (x y z) 9)))
(error-test '(port-write-handler 1))
(error-test '(port-write-handler sp 8))
(error-test '(port-write-handler (current-input-port) 8))
(error-test '(port-write-handler sp (lambda (x) 9)))
(error-test '(port-write-handler sp (lambda (x y z) 9)))

(SECTION 6 10 4)
(load "tmp1")
(test write-test-obj 'load foo)

(SECTION 'INEXACT-I/IO)
(define wto write-test-obj)
(define dto display-test-obj)
(define lto load-test-obj)
(define f-3.25 (string->number "-3.25"))
(define f.25 (string->number ".25"))
(set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely.
(set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13)
(set! load-test-obj (list 'define 'foo (list 'quote write-test-obj)))
(let ([f (lambda (test-file)
	   (write-char #\; test-file)
	   (display write-test-obj test-file)
	   (newline test-file)
	   (write load-test-obj test-file)
	   (output-port? test-file))])
  (test #t call-with-output-file
	"tmp3" f 'truncate))
(check-test-file "tmp3")
(set! write-test-obj wto)
(set! display-test-obj dto)
(set! load-test-obj lto)

(define badc-range-start 0)
(define badc-range-end 255)

(SECTION 'PRINTF)
(define (test-format format format-name)
  (test "~" format "~~")
  (test "hello---~---there" format "~a---~~---~a" "hello" 'there)
  (test "\"hello\"---~---there" format "~s---~~---~s" "hello" 'there)
  (test "\"hello\"---~---there" format "~v---~~---~v" "hello" 'there)
  (test (string #\a #\newline #\b #\newline #\c) format "a~nb~%c")
  (let ([try-newline-stuff
	 (lambda (newlines)
	   (test "12" format (apply string `(#\1 #\~ #\space ,@newlines #\space #\2)))
	   (test "12" format (apply string `(#\1 #\~ ,@newlines #\space #\2)))
	   (test "12" format (apply string `(#\1 #\~ ,@newlines #\2)))
	   (test (apply string `(#\1 ,@newlines #\2)) 
		 format (apply string `(#\1 #\~ ,@newlines #\space ,@newlines #\2))))])
    (for-each try-newline-stuff '((#\return) (#\newline) (#\return #\newline))))
  (test "twenty=20..." format "twenty=~s..." 20)
  (test "twenty=20..." format "twenty=~v..." 20)
  (test "twenty=20..." format "twenty=~e..." 20)
  (test "twenty=14..." format "twenty=~x..." 20)
  (test "twenty=24..." format "twenty=~o..." 20)
  (test "twenty=10100..." format "twenty=~b..." 20)
  (test "zee=z..." format "zee=~c..." #\z)

  (test #\. 
	(lambda (s) (string-ref s (sub1 (string-length s))))
	(parameterize ([error-print-width 40])
	  (format "~e" (make-string 200 #\v))))
  
  (let()
    (define bads
      (let loop ([i badc-range-end])
	(cond
	 [(eq? i badc-range-start) (list (integer->char i))]
	 [else (let ([c (integer->char i)]
		     [rest (loop (sub1 i))])
		 (case c
		   [(#\~ #\% #\n #\a #\s #\c #\o #\x #\b #\v #\e
			 #\N #\A #\S #\C #\O #\X #\B #\V #\E)
		    rest]
		   [else (if (char-whitespace? c)
			     rest
			     (cons c rest))]))])))

    (define with-censor (load-relative "censor.ss"))

    ; test for all bad tags; the string we generate shouldn't
    ;  be printed to a terminal directly because it can contain contain
    ;  control characters; censor it
    (unless (defined? 'building-flat-tests)
      (with-censor
       (lambda ()
	 (for-each (lambda (c)
		     (error-test `(,@format-name ,(format "a~~~cb" c) 0)))
		   bads)))))
  
  (error-test `(,@format-name 9))
  (error-test `(,@format-name "apple~"))
  (error-test `(,@format-name "~"))
  (error-test `(,@format-name "~~~"))
  (error-test `(,@format-name "~o") exn:application:mismatch?)
  (error-test `(,@format-name "~o" 1 2) exn:application:mismatch?)
  (error-test `(,@format-name "~c" 1) exn:application:mismatch?)
  (error-test `(,@format-name "~x" 'a) exn:application:mismatch?)
  (error-test `(,@format-name "~x" 4.0) exn:application:mismatch?)
  (error-test `(,@format-name "~x" 5+4.0i) exn:application:mismatch?))

(test-format format '(format))
(test-format
 (lambda args
   (let ([p (open-output-string)])
     (apply fprintf p args)
     (get-output-string p)))
 '(fprintf (current-output-port)))
(test-format
 (lambda args
   (let ([p (open-output-string)])
     (parameterize ([current-output-port p])
		   (apply printf args))
     (get-output-string p)))
 '(printf))

(arity-test format 1 -1)
(arity-test printf 1 -1)
(arity-test fprintf 2 -1)

(define success-1? (putenv "APPLE" "AnApple"))
(define success-2? (putenv "BANANA" "AnotherApple"))
(error-test `(getenv 7))
(error-test `(getenv (string #\a #\nul #\b)))
(error-test `(putenv 7 "hi"))
(error-test `(putenv "hi" 7))
(error-test `(putenv (string #\a #\nul #\b) "hi"))
(error-test `(putenv "hi" (string #\a #\nul #\b)))
(collect-garbage)
(unless (eq? (system-type) 'macos)
	(test #t 'success-1 success-1?)
	(test #t 'success-2 success-2?)
	(test "AnApple" getenv "APPLE")
	(test "AnotherApple" getenv "BANANA"))
(test #f getenv "AnUndefinedEnvironmentVariable")

(arity-test getenv 1 1)
(arity-test putenv 2 2)

(arity-test read-eval-print-loop 0 0)
(test (void) 'r-e-p-l-return 
      (parameterize ([current-input-port (make-input-port
					  (lambda () eof)
					  void
					  void)])
	   (read-eval-print-loop)))

(report-errs)
