cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

simplify testing code: use *tst* for test suite; renaming -> t:==

Browse source
This commit is contained in:
Helmut Merz 2024-05-07 11:11:15 +02:00
parent 6938217533
commit 7b8db5f923
5 changed files with 51 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
storage/storage.lisp
View file

@ -12,10 +12,14 @@
(defparameter *db-config* nil) (defparameter *db-config* nil)
(defclass storage-factory ()
((params :initarg :params)
(config :initarg :config)))
(defclass storage () (defclass storage ()
((db :initarg :db) ((factory :initarg :factory)
(config :initarg :config) (db)
(schema :initarg :schema))) (schema)))
(defun drop-table (st tn) (defun drop-table (st tn)
st st

11
test/etc.lisp
View file

@ -2,10 +2,17 @@
;;; use: `(load "test/etc")` from package scopes/test-storage ;;; use: `(load "test/etc")` from package scopes/test-storage
(defparameter db-config-sqlite (defparameter db-config-sqlite
'(:db-type :sqlite3)) '(:db-type :sqlite3
:database-name "test/test.db"))
(defparameter db-config-postgres (defparameter db-config-postgres
'(:db-type :postgres)) '(:db-type :postgres
:database-name "cl-test"
:host "localhost"
:port "5432"
:username "testuser"
:password "secret"
:schema "testing"))
(setf scopes/test-storage:*db-config-sqlite* db-config-sqlite) (setf scopes/test-storage:*db-config-sqlite* db-config-sqlite)
(setf scopes/test-storage:*db-config-postgres* db-config-postgres) (setf scopes/test-storage:*db-config-postgres* db-config-postgres)

38
test/test-forge.lisp
View file

@ -5,44 +5,44 @@
(defpackage :scopes/test-forge (defpackage :scopes/test-forge
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:scf :scopes/forge) (:local-nicknames (:scf :scopes/forge)
(:sct :scopes/testing)) (:t :scopes/testing))
(:export #:run)) (:export #:run))
(in-package :scopes/test-forge) (in-package :scopes/test-forge)
(defun run () (defun run ()
(let ((fe (scf:forge-env)) (let ((fe (scf:forge-env))
(tst (sct:test-suite))) (t:*tst* (t:test-suite)))
(test-exec tst fe) (test-exec fe)
;(format t "~%data-stack ~a" (data-stack fe)) ;(format t "~%data-stack ~a" (data-stack fe))
(test-def tst fe) (test-def fe)
(test-exec-str tst fe) (test-exec-str fe)
(test-const tst fe) (test-const fe)
(test-var tst fe) (test-var fe)
(sct:result tst))) (t:show-result)))
(defun test-exec (tst fe) (defun test-exec (fe)
(scf:exec fe '(4 2 +)) (scf:exec fe '(4 2 +))
(sct:assert-eq tst (car (scf:data-stack fe)) 6)) (t:== (car (scf:data-stack fe)) 6))
(defun test-def (tst fe) (defun test-def (fe)
(scf:exec fe '((dup *) "square" def)) (scf:exec fe '((dup *) "square" def))
(scf:exec fe '(7 square)) (scf:exec fe '(7 square))
(sct:assert-eq tst (car (scf:data-stack fe)) 49)) (t:== (car (scf:data-stack fe)) 49))
(defun test-exec-str (tst fe) (defun test-exec-str (fe)
(scf:exec-str fe "16 square") (scf:exec-str fe "16 square")
(sct:assert-eq tst (car (scf:data-stack fe)) 256)) (t:== (car (scf:data-stack fe)) 256))
(defun test-const (tst fe) (defun test-const (fe)
(scf:exec-str fe "17 \"c1\" const") (scf:exec-str fe "17 \"c1\" const")
(scf:exec-str fe "c1 square") (scf:exec-str fe "c1 square")
(sct:assert-eq tst (car (scf:data-stack fe)) 289)) (t:== (car (scf:data-stack fe)) 289))
(defun test-var (tst fe) (defun test-var (fe)
(scf:exec fe '(24 "v1" var)) (scf:exec fe '(24 "v1" var))
(scf:exec fe '(v1 get 2 *)) (scf:exec fe '(v1 get 2 *))
(sct:assert-eq tst (car (scf:data-stack fe)) 48) (t:== (car (scf:data-stack fe)) 48)
(scf:exec fe '(5 v1 put)) (scf:exec fe '(5 v1 put))
(scf:exec fe '(v1 get 2 *)) (scf:exec fe '(v1 get 2 *))
(sct:assert-eq tst (car (scf:data-stack fe)) 10)) (t:== (car (scf:data-stack fe)) 10))

10
test/test-storage.lisp
View file

@ -22,13 +22,13 @@
(defun run () (defun run ()
(let ((st (make-instance 'storage:storage)) (let ((st (make-instance 'storage:storage))
(tst (t:test-suite))) (t:*tst* (t:test-suite)))
(test-track tst st) (test-track st)
(t:result tst))) (t:show-result)))
(defun test-track (tst st) (defun test-track (st)
(let ((tr (make-instance 'tracking:track))) (let ((tr (make-instance 'tracking:track)))
(storage:drop-table st :tracks) (storage:drop-table st :tracks)
(tracking:create-table st :tracks '(taskid username)) (tracking:create-table st :tracks '(taskid username))
;(setf (scs:data tr) nil) ;(setf (scs:data tr) nil)
(t:assert-eq tst (tracking:data tr) nil))) (t:== (tracking:data tr) nil)))

16
testing.lisp
View file

@ -4,17 +4,23 @@
(defpackage :scopes/testing (defpackage :scopes/testing
(:use :common-lisp) (:use :common-lisp)
(:export #:test-suite #:assert-eq #:result)) (:export #:*tst*
#:test-suite #:show-result
#:==))
(in-package :scopes/testing) (in-package :scopes/testing)
(defparameter *tst* nil)
(defclass test-suite () (defclass test-suite ()
((result :initform nil ((result :initform nil
:reader result :accessor result)))
:accessor result!)))
(defun test-suite () (defun test-suite ()
(make-instance 'test-suite)) (make-instance 'test-suite))
(defun assert-eq (tst have wanted) (defun show-result ()
(push (equalp have wanted) (result! tst))) (print (result *tst*)))
(defun == (have wanted)
(push (equalp have wanted) (result *tst*)))