;;;
;;; Time-stamp: <2008-03-17 21:56:46 noel>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <[email protected]>
;;
;;
;; Commentary:

(module port-test mzscheme
  
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
  (require "port.ss")
  
  (provide port-tests)

  (define-syntax with-current-input-string
    (syntax-rules ()
      [(_ str expr)
       (parameterize ([current-input-port (open-input-string str)])
         expr)]))
  
  (define port-tests
    (test-suite
     "All tests for port"
     (test-case
      "port->list reads empty port"
      (check-equal? (port->list read (open-input-string ""))
                     '()))
     (test-case
      "port->list applys custom reader"
      (check-equal? (port->list (lambda (port)
                                   (let ((ip (read port)))
                                     (if (eof-object? ip)
                                         ip
                                         (string->number ip))))
                                 (open-input-string"\"20\""))
                     '(20)))
     (test-case
      "port->list reads to end of port"
      (check-equal? (port->list read (open-input-string "1 2 3 4"))
                     '(1 2 3 4)))

     (test-case
      "port->list reads current-input-port if none specified"
      (check-equal? (with-current-input-string "1 2 3 4" (port->list read))
                    '(1 2 3 4)))
     
     (test-case
      "port->string reads empty port"
      (check-equal? (port->string (open-input-string ""))
                     ""))
     (test-case
      "port->string reads to end of port"
      (let ((data "hello\nthere!\nhow are you?"))
        (check-equal? (port->string (open-input-string data))
                       data)))
     (test-case
      "port->string-list reads current-input-port if none given"
      (check-equal? (with-current-input-string "hello there" (port->string))
                    "hello there"))

     (test-case
      "port->bytes reads empty port"
      (check-equal? (port->bytes (open-input-bytes #""))
                    #""))
     (test-case
      "port->bytes reads to end of port"
      (let ((data #"hello\nthere!\nhow are you?"))
        (check-equal? (port->bytes (open-input-bytes data))
                       data)))
     (test-case
      "port->bytes reads current-input-port if none given"
      (check-equal? (with-current-input-string "hello there" (port->bytes))
                    #"hello there"))
     
     (test-case
      "port->string-list reads empty port"
      (check-equal? (port->string-list (open-input-string ""))
                     '()))
     (test-case
      "port->string-list reads to end of port"
      (let ((data "hello\nthere!\nhow are you?"))
        (check-equal? (port->string-list (open-input-string data))
                       '("hello" "there!" "how are you?"))))

     (test-case
      "port->string-list reads current-input-port if none given"
      (check-equal? (with-current-input-string "hello\nthere" (port->string-list))
                    '("hello" "there")))

     (test-case
      "port->sexp-list reads empty port"
      (check-equal? (port->sexp-list (open-input-string ""))
                     '()))
     (test-case
      "port->sexp-list reads assorted data"
      (check-equal?
       (port->sexp-list
        (open-input-string "2 foo \"harry\" (1 2 3 4)"))
       '(2 foo "harry" (1 2 3 4))))
     (test-case
      "port->sexp-list reads current-input-port if none given"
      (check-equal? (with-current-input-string "hello there" (port->sexp-list))
                    '(hello there)))
     
     (test-case
      "port-fold returns seed on empty port"
      (check-eq? (port-fold (open-input-string "")
                             read
                             list
                             'seed)
                  'seed))
     (test-case
      "port-fold handles multiple-value reader"
      (check-equal?
       (let-values (((sum len)
                     (port-fold (open-input-string "1 2 3 4")
                                read
                                (lambda (elt sum len)
                                  (values (+ sum elt)
                                          (add1 len)))
                                0
                                0)))
         (list sum len))
       (list 10 4)))
     
     ))
  )