(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~%")))