;;;; 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-setup-builtins)
        (test-def)
        (test-val)
        (test-comp)
        (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:run <comp dup mul /> in square reg)
  (forge:run 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-setup-builtins ()
  (sf-builtin:setup-builtins))

(deftest test-def ()
  (forge:run <comp in <comp swp reg /> in <def reg)
  (forge:exec-string "<def cube dup dup mul mul />")
  (forge:run 3 cube)
  (== (forge:popd) 27))

(deftest test-val ()
  (forge:run <def const val in reg />)
  (forge:run 7 const seven)
  (forge:run seven square)
  (== (forge:popd) 49)
  (forge:run <def var ptr const />)
  (forge:run 3 var myvar)
  (forge:run myvar get)
  (== (forge:popd) 3)
  (forge:run 42 myvar put)
  (forge:run myvar get)
  (== (forge:popd) 42)
  )

(deftest test-comp ()
  (forge:run (2 3 mul) comp call)
  (== (forge:popd) 6)
  (forge:run def cubic (dup dup mul mul) 
             4 cubic)
  (== (forge:popd) 64)
  )

(deftest test-if ()
  (forge:run <comp in <comp swp reg /> in <defc regc)
  (forge:run <defc <if <comp next next lit lit next call-if lit />))