;;;
;;; <assert-util-test.ss> ---- Tests for assert-util
;;; Time-stamp: <2004-10-08 07:39:30 noel>
;;;
;;; Copyright (C) 2003 by Noel Welsh.
;;;
;;; This file is part of SchemeUnit.

;;; SchemeUnit 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.

;;; SchemeUnitis 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 SchemeUnit; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

(module assert-util-test mzscheme

  (require "test.ss"
           "assert-util.ss"
           "assert-base.ss")

  (provide assert-util-tests)

  (define assert-util-tests
    (make-test-suite "All assert-util tests"
      (make-test-case "syntax->location-values ok"
        (let* ((stx (read-syntax (string->path "#f")
                                 (open-input-string "here")))
               (rep (syntax->location-representative stx)))
          (assert-equal? (syntax-source stx) (syntax-source rep))
          (assert-equal? (syntax-position stx) (syntax-position rep))
          (assert-equal? (syntax-span stx) (syntax-span rep))
          (write (compile stx) (open-output-string))))
      (make-test-case "Emacs compatible location strings"
        (begin
          (assert string=?
                  (syntax->location-string
                   (datum->syntax-object #f #f (list "file.ss" 42 38 1240 2)))
                  "file.ss:42:38")
          (assert string=?
                  (syntax->location-string
                   (datum->syntax-object
                    #f #f 
                    (list (string->path "file.ss") 42 38 1240 2)))
                  "file.ss:42:38")
          (assert string=?
                  (syntax->location-string
                   (datum->syntax-object #f #f (list #f 42 38 1240 2)))
                  "unknown:42:38")
          (assert string=?
                  (syntax->location-string
                   (datum->syntax-object #f #f (list 'foo.ss 42 38 1240 2)))
                  "foo.ss:42:38")
          (assert string=?
                  (syntax->location-string
                   (datum->syntax-object #f #f (list "foo.ss" #f #f #f #f)))
                  "foo.ss:?:?")))
      (make-test-case "Stack inspection functions are correct"
        (with-handlers
            ((exn:test:assertion?
              (lambda (exn)
                (let ((stack (exn:test:assertion-stack exn)))
                  (assert-eq? (get-assertion-location-representative stack)
                              'location)
                  (assert-eq? (get-assertion-name stack)
                              'name)
                  (assert-eq? (get-assertion-params stack)
                              'params)
                  (assert-eq? (get-assertion-expression stack)
                              'expression)
                  (assert-eq? (get-assertion-message stack)
                              'message)
                  (assert-eq? (get-assertion-info 'foo stack) 'bar)
                  (assert-eq? (get-assertion-info 'not-there stack)
                              #f)))))
          (with-assertion-info*
           (list
            (make-assertion-name 'name)
            (make-assertion-params 'params)
            (make-assertion-location-representative 'location)
            (make-assertion-expression 'expression)
            (make-assertion-message 'message)
            (make-assertion-info 'foo 'bar))
           (lambda ()
             (fail-assertion)))))
      (make-test-case "Stack inspection functions find latest values"
        (with-handlers
            ((exn:test:assertion?
              (lambda (exn)
                (let ((stack (exn:test:assertion-stack exn)))
                  (assert-eq? (get-assertion-location-representative stack)
                              'location)))))
          (with-assertion-info*
           (list (make-assertion-location-representative 'foo))
           (lambda ()
             (with-assertion-info*
              (list (make-assertion-location-representative 'location))
              (lambda ()
                (fail-assertion)))))))
      (make-test-case
          "Stack inspection functions handle empty stack"
        (begin
          (assert-eq? (get-assertion-location-representative null)
                      #f)
          (assert-eq? (get-assertion-name null)
                      #f)
          (assert-eq? (get-assertion-params null)
                      #f)
          (assert-eq? (get-assertion-expression null)
                      #f)
          (assert-eq? (get-assertion-message null)
                      #f)
          (assert-eq? (get-assertion-info 'foo null) #f)
          (assert-eq? (get-assertion-info 'not-there null)
                      #f)))
      ))
  
  )

;;; assert-util-test.ss ends here