cl-scopes/test/test-forge.lisp

48 lines
1.1 KiB
Common Lisp

;;; cl-scopes/test/test-forge
;;;; testing facility for scopes/forge
(defpackage :scopes/test-forge
(:use :common-lisp)
(:local-nicknames (:scf :scopes/forge)
(:t :scopes/testing))
(:export #:run))
(in-package :scopes/test-forge)
(defun run ()
(let ((fe (scf:forge-env))
(t:*tst* (t:test-suite)))
(test-exec fe)
;(format t "~%data-stack ~a" (data-stack fe))
(test-def fe)
(test-exec-str fe)
(test-const fe)
(test-var fe)
(t:show-result)))
(defun test-exec (fe)
(scf:exec fe '(4 2 +))
(t:== (car (scf:data-stack fe)) 6))
(defun test-def (fe)
(scf:exec fe '((dup *) "square" def))
(scf:exec fe '(7 square))
(t:== (car (scf:data-stack fe)) 49))
(defun test-exec-str (fe)
(scf:exec-str fe "16 square")
(t:== (car (scf:data-stack fe)) 256))
(defun test-const (fe)
(scf:exec-str fe "17 \"c1\" const")
(scf:exec-str fe "c1 square")
(t:== (car (scf:data-stack fe)) 289))
(defun test-var (fe)
(scf:exec fe '(24 "v1" var))
(scf:exec fe '(v1 get 2 *))
(t:== (car (scf:data-stack fe)) 48)
(scf:exec fe '(5 v1 put))
(scf:exec fe '(v1 get 2 *))
(t:== (car (scf:data-stack fe)) 10))