forge: make forge/sf the standard forge package; keep old files as x-... for reference

This commit is contained in:
Helmut Merz 2024-09-17 19:52:42 +02:00
parent 6ed436f94f
commit c857da986b
6 changed files with 100 additions and 101 deletions

View file

@ -5,7 +5,9 @@
(config:root :env-keys '(:docroot :address :port :loglevel :logfile)
:env-path (util:runtime-path ".env"))
(config:add :logger :class 'logging:config)
(config:add :logger
:class 'logging:config
:console nil)
(config:add :server
:class 'server:config

View file

@ -18,7 +18,7 @@
(format t "~%Hello World.~%config-path: ~s~%" config-path)
(load config-path))
(core:setup-services)
(setf forge:*forge-env* (forge:forge-env))
(forge:setup-builtins)
;(setf forge:*forge-env* (forge:forge-env))
;(forge:setup-builtins)
(forge:repl)
(core:shutdown))

View file

@ -13,8 +13,7 @@
:depends-on ("core/message" "config"
"forge/forge" "logging" "util/util"))
(:file "core/message" :depends-on ("shape/shape"))
(:file "forge/forge")
(:file "forge/sf" :depends-on ("util/iter" "util/util"))
(:file "forge/forge" :depends-on ("util/iter" "util/util"))
(:file "logging" :depends-on ("config" "util/util"))
(:file "shape/shape")
(:file "util/util")
@ -28,10 +27,8 @@
:depends-on (:scopes-core)
:components ((:file "test/test-config")
(:file "test/test-core")
(:file "test/test-forge")
(:file "test/test-sf"))
(:file "test/test-forge"))
:perform (test-op (o c)
(symbol-call :scopes/test-config :run)
(symbol-call :scopes/test-core :run)
;(symbol-call :scopes/test-forge :run)
(symbol-call :scopes/test-sf :run)))
(symbol-call :scopes/test-forge :run)))

View file

@ -5,6 +5,7 @@
(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 #:==))
@ -13,46 +14,42 @@
(defun run ()
(let ((t:*test-suite* (t:test-suite "forge")))
;(forge:*forge-env* (forge:forge-env)))
(setf forge:*forge-env* (forge:forge-env))
(forge:setup-builtins)
(test-iseq)
(test-exec)
(test-def)
(test-const)
(test-var)
(unwind-protect
(progn
;(forge:setup-builtins)
(test-exec)
(test-def)
(test-val)))
(util:lgi (forge:stack forge:*forge-env*))
(t:show-result)))
(deftest test-iseq ()
(let ((seq (forge:make-iseq)))
(forge:isq-add seq 1)
(forge:isq-add seq 2)
(== (forge:isq-next seq) 1)
(== (forge:isq-end seq) 2)))
(deftest test-exec ()
(forge:exec-str "4 2 +")
(== (car (forge:dstack)) 6))
;(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-str "(comp quote defer regc) quote defc regc")
(forge:exec-str "(comp quote defer reg) defc def")
(forge:exec-str "(dup *) def square")
(forge:exec-str "7 square")
(== (car (forge:dstack)) 49))
(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-const ()
(forge:exec-str "(defer wrap comp quote defer reg) defc const")
(forge:exec-str "11 const eleven")
(forge:exec-str "eleven square")
(== (car (forge:dstack)) 121))
(deftest test-var ()
(forge:exec-str "(defer wrap defer wrap comp quote defer reg) defc var")
(forge:exec-str "7 var myvar")
(forge:exec-str "myvar get square")
(== (car (forge:dstack)) 49)
(forge:exec-str "8 myvar set")
(forge:exec-str "myvar get square")
(== (car (forge:dstack)) 64))
(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)
)

View file

@ -1,55 +0,0 @@
;;;; 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)
)

58
test/x-test-forge.lisp Normal file
View file

@ -0,0 +1,58 @@
;;;; cl-scopes/test/test-forge
;;;; testing facility for scopes/forge
(defpackage :scopes/test-forge
(:use :common-lisp)
(:local-nicknames (:forge :scopes/forge)
(: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")))
;(forge:*forge-env* (forge:forge-env)))
(setf forge:*forge-env* (forge:forge-env))
(forge:setup-builtins)
(test-iseq)
(test-exec)
(test-def)
(test-const)
(test-var)
(t:show-result)))
(deftest test-iseq ()
(let ((seq (forge:make-iseq)))
(forge:isq-add seq 1)
(forge:isq-add seq 2)
(== (forge:isq-next seq) 1)
(== (forge:isq-end seq) 2)))
(deftest test-exec ()
(forge:exec-str "4 2 +")
(== (car (forge:dstack)) 6))
(deftest test-def ()
(forge:exec-str "(comp quote defer regc) quote defc regc")
(forge:exec-str "(comp quote defer reg) defc def")
(forge:exec-str "(dup *) def square")
(forge:exec-str "7 square")
(== (car (forge:dstack)) 49))
(deftest test-const ()
(forge:exec-str "(defer wrap comp quote defer reg) defc const")
(forge:exec-str "11 const eleven")
(forge:exec-str "eleven square")
(== (car (forge:dstack)) 121))
(deftest test-var ()
(forge:exec-str "(defer wrap defer wrap comp quote defer reg) defc var")
(forge:exec-str "7 var myvar")
(forge:exec-str "myvar get square")
(== (car (forge:dstack)) 49)
(forge:exec-str "8 myvar set")
(forge:exec-str "myvar get square")
(== (car (forge:dstack)) 64))