diff options
| -rw-r--r-- | main.lisp | 2 | ||||
| -rw-r--r-- | test/arith.lorth | 3 | ||||
| -rw-r--r-- | test/bits.lorth | 15 | ||||
| -rw-r--r-- | test/branchs.lorth | 62 | ||||
| -rw-r--r-- | test/loop.lorth | 6 | ||||
| -rw-r--r-- | test/stack.lorth | 5 | ||||
| -rw-r--r-- | test/syscall.lorth | 15 | ||||
| -rw-r--r-- | test/tests.lisp | 117 |
8 files changed, 225 insertions, 0 deletions
@@ -15,6 +15,8 @@ (compile-program (second args))) ((string= flag "-i") (interpret-program (make-program (second args)))) + ((string= flag "-t") + (run-tests)) (t (format t "~a is not a valid flag~%" flag)))))) ;; (defun make-exe () diff --git a/test/arith.lorth b/test/arith.lorth new file mode 100644 index 0000000..76bef42 --- /dev/null +++ b/test/arith.lorth @@ -0,0 +1,3 @@ +;;; test +;;; (format nil "9~%") +3 6 + dump
\ No newline at end of file diff --git a/test/bits.lorth b/test/bits.lorth new file mode 100644 index 0000000..77be5b0 --- /dev/null +++ b/test/bits.lorth @@ -0,0 +1,15 @@ +;;; test +;;; (format nil "~{~a~%~}" (append '(0 1 2) +;;; '(7 3 5) +;;; '(4 32 12))) +1 2 & dump +1 1 & dump +3 2 & dump + +1 2 4 | | dump +3 1 | dump +5 5 | dump + +32 3 >> dump +1 5 << dump +3 2 << dump
\ No newline at end of file diff --git a/test/branchs.lorth b/test/branchs.lorth new file mode 100644 index 0000000..41eaf96 --- /dev/null +++ b/test/branchs.lorth @@ -0,0 +1,62 @@ +;;; test +;;; (format nil "~{~a~%~}" '(1 2 3 4 5)) + +34 36 + +eş 70 = ise 1 dump +yoksa eş 68 = ise + 1 ise + 2 dump + yoksa + 3 dump + yap +yoksa eş 69 = ise 4 dump +yoksa 5 dump +yap yap yap + +34 34 + +eş 70 = ise 1 dump +yoksa eş 68 = ise + 1 ise + 2 dump + yoksa + 3 dump + yap +yoksa eş 69 = ise 4 dump +yoksa 5 dump +yap yap yap + +34 34 + +eş 70 = ise 1 dump +yoksa eş 68 = ise + 0 ise + 2 dump + yoksa + 3 dump + yap +yoksa eş 69 = ise 4 dump +yoksa 5 dump +yap yap yap + +34 35 + +eş 70 = ise 1 dump +yoksa eş 68 = ise + 1 ise + 2 dump + yoksa + 3 dump + yap +yoksa eş 69 = ise 4 dump +yoksa 5 dump +yap yap yap + +34 420 + +eş 70 = ise 1 dump +yoksa eş 68 = ise + 1 ise + 2 dump + yoksa + 3 dump + yap +yoksa eş 69 = ise 4 dump +yoksa 5 dump +yap yap yap
\ No newline at end of file diff --git a/test/loop.lorth b/test/loop.lorth new file mode 100644 index 0000000..8234010 --- /dev/null +++ b/test/loop.lorth @@ -0,0 +1,6 @@ +;;; test +;;; (format nil "~{~a~%~}" (list 0 1 2 3)) +0 döngü eş 4 < iken + eş dump + 1 + +yap
\ No newline at end of file diff --git a/test/stack.lorth b/test/stack.lorth new file mode 100644 index 0000000..318d9be --- /dev/null +++ b/test/stack.lorth @@ -0,0 +1,5 @@ +;;; test +;;; (format nil "~{~a~%~}" '(1 5 4 4)) +1 dump +4 5 dump +eş dump dump diff --git a/test/syscall.lorth b/test/syscall.lorth new file mode 100644 index 0000000..a58a9ec --- /dev/null +++ b/test/syscall.lorth @@ -0,0 +1,15 @@ +;;; test +;;; (format nil "abc~%bcd~%") +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 diff --git a/test/tests.lisp b/test/tests.lisp new file mode 100644 index 0000000..c36a5f2 --- /dev/null +++ b/test/tests.lisp @@ -0,0 +1,117 @@ +(in-package :cl-forth) + +(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 lex-stream (str) + (iter outer + (for line = (read-line str nil nil)) + (until (null line)) + (for line-num from 1) + (appending (lex-line line line-num)))) + +(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) + "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) + (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 "asm") + :compile t :silence t) + (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 + (delete-file (probe-file (change-file-type abs-path "asm"))) + (delete-file (probe-file (change-file-type abs-path "o"))) + (delete-file (probe-file (drop-file-type abs-path))))) + successful)) + +(defun run-tests () + (loop for success? + in (mapcar #'run-test + (remove-if-not (lambda (file) + (string= "lorth" (pathname-type file))) + (cl-fad:list-directory + (from-root "test")))) + 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~%"))) |