cl-scopes/test/test-forge.lisp

60 lines
1.7 KiB
Common Lisp

;;;; cl-scopes/test/test-forge
;;;; testing facility for scopes/forge
(defpackage :scopes/test-forge
(:use :common-lisp)
(:local-nicknames (:forge :scopes/forge)
(:util :scopes/util)
(:t :scopes/testing))
(:export #:run)
(:import-from :scopes/testing #:deftest #:==))
(in-package :scopes/test-forge)
(defun run ()
(let ((t:*test-suite* (t:test-suite "forge")))
(unwind-protect
(progn
;(forge:setup-builtins)
(test-exec)
(test-def)
(test-val)
(test-if)))
(util:lgi (forge:stack forge:*forge-env*))
(t:show-result)))
(deftest test-exec ()
(forge:exec-list '(4 2 add))
(== (forge:popd) 6)
(forge:exec-list '(<comp dup mul /> in square reg))
(forge:exec-list '(7 square))
(== (forge:popd) 49)
(forge:exec-string "8 square")
(== (forge:popd) 64)
(forge:exec-stream (make-string-input-stream "12 square"))
(== (forge:popd) 144))
(deftest test-def ()
(forge:exec-list '(<comp in <comp swp reg /> in <def reg))
(forge:exec-string "<def cube dup dup mul mul />")
(forge:exec-list '(3 cube))
(== (forge:popd) 27))
(deftest test-val ()
(forge:exec-list '(<def const val in reg />))
(forge:exec-list '(7 const seven))
(forge:exec-list '(seven square))
(== (forge:popd) 49)
(forge:exec-list '(<def var ptr const />))
(forge:exec-list '(3 var myvar))
(forge:exec-list '(myvar get))
(== (forge:popd) 3)
(forge:exec-list '(42 myvar put))
(forge:exec-list '(myvar get))
(== (forge:popd) 42)
)
(deftest test-if ()
(forge:exec-list '(<comp in <comp swp reg /> in <defc regc))
(forge:exec-list '(<defc <if <comp next next comp comp next call-if comp />)))