From c857da986bfb6ac117c356cccd35d9481b770a09 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Tue, 17 Sep 2024 19:52:42 +0200 Subject: [PATCH] forge: make forge/sf the standard forge package; keep old files as x-... for reference --- app/demo/etc/config.lisp | 4 ++- app/demo/main.lisp | 4 +-- scopes-core.asd | 9 ++--- test/test-forge.lisp | 71 +++++++++++++++++++--------------------- test/test-sf.lisp | 55 ------------------------------- test/x-test-forge.lisp | 58 ++++++++++++++++++++++++++++++++ 6 files changed, 100 insertions(+), 101 deletions(-) delete mode 100644 test/test-sf.lisp create mode 100644 test/x-test-forge.lisp diff --git a/app/demo/etc/config.lisp b/app/demo/etc/config.lisp index 742cb98..067f653 100644 --- a/app/demo/etc/config.lisp +++ b/app/demo/etc/config.lisp @@ -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 diff --git a/app/demo/main.lisp b/app/demo/main.lisp index c3a66c4..4a56c72 100644 --- a/app/demo/main.lisp +++ b/app/demo/main.lisp @@ -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)) diff --git a/scopes-core.asd b/scopes-core.asd index 0b2ee87..7f6d46b 100644 --- a/scopes-core.asd +++ b/scopes-core.asd @@ -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))) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index b36b55a..f70028c 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -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 '( 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 '( in ") + (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 '()) + (forge:exec-list '(7 const seven)) + (forge:exec-list '(seven square)) + (== (forge:popd) 49) + (forge:exec-list '()) + (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) + ) diff --git a/test/test-sf.lisp b/test/test-sf.lisp deleted file mode 100644 index 6229112..0000000 --- a/test/test-sf.lisp +++ /dev/null @@ -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 '( 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 '( in ") - (forge:exec-list '(3 cube)) - (== (forge:popd) 27)) - -(deftest test-val () - (forge:exec-list '()) - (forge:exec-list '(7 const seven)) - (forge:exec-list '(seven square)) - (== (forge:popd) 49) - (forge:exec-list '()) - (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) - ) - diff --git a/test/x-test-forge.lisp b/test/x-test-forge.lisp new file mode 100644 index 0000000..b36b55a --- /dev/null +++ b/test/x-test-forge.lisp @@ -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)) +