39 lines
1,002 B
Common Lisp
39 lines
1,002 B
Common Lisp
;;; cl-scopes/test/test-forge
|
|
|
|
;;;; testing facility for scopes/forge
|
|
|
|
(defpackage :scopes/test-forge
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:scf :scopes/forge)
|
|
(:sct :scopes/testing))
|
|
(:export #:run))
|
|
|
|
(in-package :scopes/test-forge)
|
|
|
|
(defun run ()
|
|
(let ((fe (scf:forge-env))
|
|
(tst (sct:test-suite)))
|
|
(test-exec tst fe)
|
|
;(format t "~%data-stack ~a" (data-stack fe))
|
|
(test-def tst fe)
|
|
(test-exec-str tst fe)
|
|
(test-const tst fe)
|
|
(sct:result tst)))
|
|
|
|
(defun test-exec (tst fe)
|
|
(scf:exec fe '(4 2 +))
|
|
(sct:assert-eq tst (car (scf:data-stack fe)) 6))
|
|
|
|
(defun test-def (tst fe)
|
|
(scf:exec fe '((dup *) "square" def))
|
|
(scf:exec fe '(7 square))
|
|
(sct:assert-eq tst (car (scf:data-stack fe)) 49))
|
|
|
|
(defun test-exec-str (tst fe)
|
|
(scf:exec-str fe "16 square")
|
|
(sct:assert-eq tst (car (scf:data-stack fe)) 256))
|
|
|
|
(defun test-const (tst fe)
|
|
(scf:exec-str fe "17 \"c1\" const")
|
|
(scf:exec-str fe "c1 square")
|
|
(sct:assert-eq tst (car (scf:data-stack fe)) 289))
|