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)
(defclass storage-factory ()
((params :initarg :params)
(config :initarg :config)))
(defclass storage ()
((db :initarg :db)
(config :initarg :config)
(schema :initarg :schema)))
((factory :initarg :factory)
(db)
(schema)))
(defun drop-table (st tn)
st

11
test/etc.lisp
View file

@ -2,10 +2,17 @@
;;; use: `(load "test/etc")` from package scopes/test-storage
(defparameter db-config-sqlite
'(:db-type :sqlite3))
'(:db-type :sqlite3
:database-name "test/test.db"))
(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-postgres* db-config-postgres)

38
test/test-forge.lisp
View file

@ -5,44 +5,44 @@
(defpackage :scopes/test-forge
(:use :common-lisp)
(:local-nicknames (:scf :scopes/forge)
(:sct :scopes/testing))
(:t :scopes/testing))
(:export #:run))
(in-package :scopes/test-forge)
(defun run ()
(let ((fe (scf:forge-env))
(tst (sct:test-suite)))
(test-exec tst fe)
(t:*tst* (t:test-suite)))
(test-exec fe)
;(format t "~%data-stack ~a" (data-stack fe))
(test-def tst fe)
(test-exec-str tst fe)
(test-const tst fe)
(test-var tst fe)
(sct:result tst)))
(test-def fe)
(test-exec-str fe)
(test-const fe)
(test-var fe)
(t:show-result)))
(defun test-exec (tst fe)
(defun test-exec (fe)
(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 '(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")
(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 "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 '(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 '(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 ()
(let ((st (make-instance 'storage:storage))
(tst (t:test-suite)))
(test-track tst st)
(t:result tst)))
(t:*tst* (t:test-suite)))
(test-track st)
(t:show-result)))
(defun test-track (tst st)
(defun test-track (st)
(let ((tr (make-instance 'tracking:track)))
(storage:drop-table st :tracks)
(tracking:create-table st :tracks '(taskid username))
;(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
(:use :common-lisp)
(:export #:test-suite #:assert-eq #:result))
(:export #:*tst*
#:test-suite #:show-result
#:==))
(in-package :scopes/testing)
(defparameter *tst* nil)
(defclass test-suite ()
((result :initform nil
:reader result
:accessor result!)))
:accessor result)))
(defun test-suite ()
(make-instance 'test-suite))
(defun assert-eq (tst have wanted)
(push (equalp have wanted) (result! tst)))
(defun show-result ()
(print (result *tst*)))
(defun == (have wanted)
(push (equalp have wanted) (result *tst*)))