;;;; cl-scopes/test/test-forge

;;;; testing facility for scopes/forge

(defpackage :scopes/test-sf
  (:use :common-lisp)
  (:local-nicknames (:forge :scopes/forge/sf) 
                    (:util :scopes/util)
                    (:t :scopes/testing))
  (:export #:run)
  (:import-from :scopes/testing #:deftest #:==))

(in-package :scopes/test-sf)

(defun run ()
  (let ((t:*test-suite* (t:test-suite "forge/sf")))
    (unwind-protect
      (progn
        ;(forge:setup-builtins)
        (test-exec)
        (test-def)
        (test-val)))
    (util:lgi (forge:stack forge:*forge-env*))
    (t:show-result)))
 
(deftest test-exec ()
  ;(forge:exec-str "4 2 add")
  (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))

(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)
  )