122 lines
4.8 KiB
Common Lisp
122 lines
4.8 KiB
Common Lisp
(in-package :kurt)
|
|
|
|
(defun drop-file-type (file &key (returns :string))
|
|
(let* ((file-str (namestring file))
|
|
(dropped (subseq file-str 0 (position #\. file-str))))
|
|
(case returns
|
|
(:string dropped)
|
|
(:file (pathname dropped)))))
|
|
|
|
(defun change-file-type (file new-type &key (returns :string))
|
|
(let* ((pathn (pathname file))
|
|
(new-file (format nil "~a.~a"
|
|
(drop-file-type pathn)
|
|
new-type)))
|
|
(case returns
|
|
(:string new-file)
|
|
(:file (pathname new-file)))))
|
|
|
|
(defun read-form-comment (str)
|
|
(read-from-string
|
|
(format nil "~{~a~^~%~}"
|
|
(iter (for ch = (peek-char t str nil nil))
|
|
(while ch)
|
|
(cond ((char= ch #\;)
|
|
(iter (for ch = (read-char str nil nil))
|
|
(while (and ch (char= #\; ch))))
|
|
(collect (read-line str)))
|
|
(t (finish)))))))
|
|
|
|
(defun run-test (path &key (target :nasm))
|
|
"File must begin with 2 comments:
|
|
First must be TEST
|
|
Second must eval to the expected result"
|
|
(let ((abs-path (if (cl-fad:pathname-absolute-p path)
|
|
path
|
|
(from-root path)))
|
|
(successful nil))
|
|
(with-open-file (str abs-path :external-format :utf-8)
|
|
(unless (string-equal "test" (second (uiop:split-string
|
|
(read-line str)
|
|
:separator '(#\Space))))
|
|
(return-from run-test 'not-test))
|
|
(let ((expected-output (eval (read-form-comment str))))
|
|
(generate-program (parse-tokens (lex-stream str))
|
|
:path (change-file-type abs-path (case target
|
|
(:nasm "asm")
|
|
(:c "c")))
|
|
:compile t :silence t
|
|
:target target)
|
|
(let ((output (run (list (drop-file-type abs-path))
|
|
:output :string :silence t)))
|
|
(format t "testing ~a... " (pathname-name path))
|
|
(if (string= expected-output output)
|
|
(progn (format t "successful~%") (setf successful t))
|
|
(format t "~{~a~%~}"
|
|
(list "failed"
|
|
"---expected output---"
|
|
expected-output
|
|
"---actual output---"
|
|
output))))
|
|
;; delete generated .asm .o and executable file
|
|
(case target
|
|
(:nasm (delete-file (probe-file (change-file-type abs-path "asm")))
|
|
(delete-file (probe-file (change-file-type abs-path "o"))))
|
|
(:c (delete-file (probe-file (change-file-type abs-path "c")))))
|
|
(delete-file (probe-file (drop-file-type abs-path)))))
|
|
successful))
|
|
|
|
(defun run-tests (&key (ignore-err nil) (target :nasm))
|
|
(loop for success?
|
|
in (mapcar (lambda (file) (if (not ignore-err)
|
|
(run-test file :target target)
|
|
(ignore-errors
|
|
(run-test file :target target))))
|
|
(remove-if-not (lambda (file)
|
|
(string= "kurt" (pathname-type file)))
|
|
(append
|
|
(cl-fad:list-directory
|
|
(from-root "test"))
|
|
(cl-fad:list-directory
|
|
(from-root "examples/euler")))))
|
|
counting (eq t success?) into succs
|
|
counting (null success?) into fails
|
|
finally (format t "~a success, ~a fail~%" succs fails)))
|
|
|
|
;; (defun test-from-string (string expected-output &key (silence t))
|
|
;; (generate-program (parse-tokens (lex-string string))
|
|
;; :path "test/test.asm" :compile t :silence silence)
|
|
;; (let ((output (run '("test/test") :output :string :silence silence)))
|
|
;; (if (string= expected-output output)
|
|
;; t
|
|
;; (format t "~{~a~%~}"
|
|
;; (list "test failed"
|
|
;; "---expected output---"
|
|
;; expected-output
|
|
;; "---actual output---"
|
|
;; output)))))
|
|
|
|
;; (defun run-tests ()
|
|
;; (test-from-string "3 6 + dump" (format nil "9~%"))
|
|
;; (test-from-string
|
|
;; "0 döngü eş 4 < iken
|
|
;; eş dump
|
|
;; 1 +
|
|
;; yap"
|
|
;; (format nil "~{~a~%~}" '(0 1 2 3)))
|
|
;; (test-from-string
|
|
;; "bel 0 + 97 yaz
|
|
;; bel 1 + 98 yaz
|
|
;; bel 2 + 99 yaz
|
|
;; bel 3 + 10 yaz
|
|
|
|
;; 1 bel 4 1 syscall-3
|
|
|
|
;; bel 0 + eş oku 1 + yaz
|
|
;; bel 1 + eş oku 1 + yaz
|
|
;; bel 2 + eş oku 1 + yaz
|
|
|
|
;; 1 bel 4 1 syscall-3
|
|
;; 0 60 syscall-1"
|
|
;; (format nil "abc~%bcd~%")))
|