;;; 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)
    (test-var 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))

(defun test-var (tst fe)
  (scf:exec fe '(24 "v1" var))
  (scf:exec fe '(v1 get 2 *))
  (sct:assert-eq tst (car (scf:data-stack fe)) 48)
  (scf:exec fe '(5 v1 put))
  (scf:exec fe '(v1 get 2 *))
  (sct:assert-eq tst (car (scf:data-stack fe)) 10))