(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)))
))
)