Hash :
8c7e7b67
Author :
Thomas de Grivel
Date :
2018-06-28T21:42:49
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
(in-package :common-lisp-user)
(defpackage :css-lexer/test
(:use :babel-stream
:cl
:cl-stream
:css-lexer
:unistd-stream)
#.(cl-stream:shadowing-import-from)
(:export
#:run
#:simple-test
#:test
#:test-file))
(in-package :css-lexer/test)
(defgeneric test (x))
(defmethod test ((s string))
(with-stream (css (css-lexer (string-input-stream s)))
(let ((result))
(loop
(multiple-value-bind (token state) (stream-read css)
(ecase state
((nil) (push token result))
((:eof) (return))
((:non-blocking) (sleep 0.01)))))
(nreverse result))))
(defmethod test ((path pathname))
(with-stream (css (css-lexer
(babel-input-stream
(unistd-stream-open
(namestring path) :read t))))
(let ((result))
(loop
(multiple-value-bind (token state) (stream-read css)
(ecase state
((nil) (push token result))
((:eof) (return))
((:non-blocking) (sleep 0.01)))))
(nreverse result))))
(defparameter *tests*
'((""
eof-token)
("body { color: #f00; }"
ident-token whitespace-token {-token whitespace-token
ident-token colon-token whitespace-token hash-token semicolon-token
whitespace-token }-token eof-token)))
(defvar *success*)
(defun compare-result (result expected)
(loop
(when (endp result)
(cond ((endp expected)
(format t "; OK~%")
(incf *success*))
(t
(format t "; FAIL not matched: ~S~%" expected)))
(return (endp expected)))
(when (endp expected)
(format t "; FAIL unexpected: ~S~%" result)
(return nil))
(let ((r (first result))
(e (first expected)))
(unless (eq (class-name (class-of r)) e)
(format t "; FAIL expected ~S got ~S~%" e r)
(return)))
(pop result)
(pop expected)))
(defun run ()
(let ((count (length *tests*))
(i 0)
(*success* 0))
(dolist (test *tests*)
(destructuring-bind (arg &rest expected) test
(format t "~&; ~A/~A ~S~%" (incf i) count arg)
(let ((result (test arg)))
(compare-result result expected))))
(format t "; Passed tests ~A/~A total~%" *success* count)))
(untrace token-stream::subseq*
token-stream:make-token)