added some basic tests

test/arith.lorth

@@ -0,0 +1,3 @@
+;;; test
+;;; (format nil "9~%")
+3 6 + dump

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

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

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

test/stack.lorth

@@ -0,0 +1,5 @@
+;;; test
+;;; (format nil "~{~a~%~}" '(1 5 4 4))
+1 dump
+4 5 dump
+eş dump dump

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

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