Merge pull request #1 from bdunahu/bdunahu

Add logic to open file, full lexer and tests.

3 files changed, 138 insertions, 0 deletions

diff --git a/t/lex.lisp b/t/lex.lisp
new file mode 100644
index 0000000..7a20608
--- /dev/null
+++ b/t/lex.lisp
@@ -0,0 +1,100 @@
+(in-package #:rva-tests)
+
+(defmacro read-this (str &body body)
+  `(let ((*standard-input* (make-string-input-stream ,str)))
+     ,@body))
+
+(def-suite lex-tests
+  :description "Test functions exported from the lexer."
+  :in all-tests)
+
+(in-suite lex-tests)
+
+(test read-token-reads-eof
+      (read-this ""
+                 (is (not (lex:read-token)))))
+
+(test read-token-reads-nl
+      (read-this "
+"
+                 (is (eq (lex:read-token) 'lex::nl))))
+
+(test read-token-reads-left-paren
+      (read-this "("
+                 (is (eq (lex:read-token) 'lex::left-paren))))
+
+(test read-token-reads-right-paren
+      (read-this ")"
+                 (is (eq (lex:read-token) 'lex::right-paren))))
+
+(test read-token-reads-left-paren
+      (read-this "$"
+                 (is (eq (lex:read-token) 'lex::dollar))))
+
+(test read-token-reads-plus
+      (read-this "+"
+                 (is (eq (lex:read-token) 'lex::plus))))
+
+(test read-token-reads-minus
+      (read-this "-"
+                 (is (eq (lex:read-token) 'lex::minus))))
+
+(test read-token-ignores-space
+      (read-this " ("
+                 (is (eq (lex:read-token) 'lex::left-paren))))
+
+(test read-token-ignores-tab
+      (read-this "      ("
+                 (is (eq (lex:read-token) 'lex::left-paren))))
+
+(test read-token-ignores-comment
+      (read-this "; this is a comment
+("
+                 (is (eq (lex:read-token) 'lex::nl))))
+
+(test read-token-immediate-zero
+      (read-this "0"
+                 (is (= (lex:read-token) 0))))
+
+(test read-token-immediate-all-digits
+      (read-this "123456789"
+                 (is (= (lex:read-token) 123456789))))
+
+(test read-token-immediate-binary
+      (read-this "0b00101010"
+                 (is (= (lex:read-token) 42))))
+
+(test read-token-immediate-octal
+      (read-this "0o052"
+                 (is (= (lex:read-token) 42))))
+
+(test read-token-immediate-hexadecimal
+      (read-this "0x200"
+                 (is (= (lex:read-token) 512))))
+
+(test read-token-immediate-invalid-immediate
+      (handler-case
+          (progn (read-this "0v0" (lex:read-token))
+                 (fail))
+        (lex:lexer-error ())))
+
+;; do we want a custom error for this too?
+(test read-token-immediate-radix
+      (handler-case
+          (progn (read-this "0x" (lex:read-token))
+                 (fail))
+        (sb-int:simple-parse-error ())))
+
+(test read-token-keyword-single
+      (read-this "a"
+                 (is (string= (lex:read-token) "a"))))
+
+(test read-token-keyword-add
+      (read-this "addi"
+                 (is (string= (lex:read-token) "addi"))))
+
+(test read-token-immediate-invalid-keyword
+      (handler-case
+          (progn (read-this "sub0" (lex:read-token))
+                 (fail))
+        (lex:lexer-error ())))
diff --git a/t/parse.lisp b/t/parse.lisp
new file mode 100644
index 0000000..bd1310f
--- /dev/null
+++ b/t/parse.lisp
@@ -0,0 +1,26 @@
+(in-package #:rva-tests)
+
+(def-suite parse-tests
+  :description "Test functions exported from the parser."
+  :in all-tests)
+
+(in-suite parse-tests)
+
+(test extract-label-is-a-label
+      (is (not (parse:extract-label '("LOOP" lex::colon)))))
+
+(test extract-label-not-a-label-one
+      (let ((lst '("NICE" "TRY")))
+        (is (equal lst
+                   (parse:extract-label lst)))))
+
+(test extract-label-not-a-label-two
+      (let ((lst '("LOOP" lex::colon lex::colon)))
+        (is (equal lst
+                   (parse:extract-label lst)))))
+
+(test extract-line-invalid-type
+      (handler-case
+          (progn (parse:tokens->ast '(("foo" LEX::DOLLAR)))
+                 (fail))
+        (lex:parser-error ())))
diff --git a/t/util.lisp b/t/util.lisp
index ef59fbb..c2dafab 100644
--- a/t/util.lisp
+++ b/t/util.lisp
@@ -14,3 +14,15 @@
 
 (test asm-extension?-returns-true-obvious-case
       (is (util:asm-extension? "quux.asm")))
+
+(test format-as-binary-unsigned-no-pad
+      (is (string= (util:format-as-binary 0 0)
+		   "0")))
+
+(test format-as-binary-unsigned-no-pad-fourty-two
+      (is (string= (util:format-as-binary 42 0)
+		   "101010")))
+
+(test format-as-binary-unsigned-pad-fourty-two
+      (is (string= (util:format-as-binary 42 10)
+		   "0000101010")))