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

testing: + in-seq test, use in csys probe

Browse source
This commit is contained in:
Helmut Merz 2026-02-28 11:55:59 +01:00
parent f5a5d6b629
commit f3491a5aa3
4 changed files with 14 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
csys/csys.lisp
View file

@ -46,7 +46,8 @@
(defun find-create-sensors (msg) (defun find-create-sensors (msg)
(let* ((key (cddr (shape:head msg))) (let* ((key (cddr (shape:head msg)))
(sns (gethash key *sensors*))) (sns (gethash key *sensors*)))
(format t "~&~a ~a" key sns) ;(format t "~&~a ~a" key sns)
(util:lgi key sns)
(or sns (or sns
(let* ((mx (message:create (let* ((mx (message:create
(list :csys :sensor (shape:head-value msg :class)))) (list :csys :sensor (shape:head-value msg :class))))

2
scopes-csys.asd
View file

@ -10,7 +10,7 @@
:description "Concurrent cybernetic communications systems." :description "Concurrent cybernetic communications systems."
:depends-on (:scopes-core) :depends-on (:scopes-core)
:components ((:file "csys/csys")) :components ((:file "csys/csys"))
:long-description "scopes/csys: Concurrent cybernetic communications systems." :long-description "scopes/csys: Concurrent cybernetic communication systems."
:in-order-to ((test-op (test-op "scopes-csys/test")))) :in-order-to ((test-op (test-op "scopes-csys/test"))))
(defsystem :scopes-csys/test (defsystem :scopes-csys/test

6
test/test-csys.lisp
View file

@ -14,7 +14,7 @@
(:util :scopes/util) (:util :scopes/util)
(:t :scopes/testing)) (:t :scopes/testing))
(:export #:run) (:export #:run)
(:import-from :scopes/testing #:deftest #:== #:!=)) (:import-from :scopes/testing #:deftest #:== #:!= #:in-seq))
(in-package :scopes/test-csys) (in-package :scopes/test-csys)
@ -25,8 +25,8 @@
(defun probe (msg state syns env) (defun probe (msg state syns env)
(let ((t:*test-suite* (test-suite env))) (let ((t:*test-suite* (test-suite env)))
(== (shape:data msg) (pop state)) (let ((state (in-seq (shape:data msg) state :remove t)))
(actor:become (csys:neuron #'probe state syns env)))) (actor:become (csys:neuron #'probe state syns env)))))
(defvar *probe* nil) (defvar *probe* nil)

10
testing.lisp
View file

@ -6,7 +6,7 @@
(:use :common-lisp) (:use :common-lisp)
(:export #:*test-suite* (:export #:*test-suite*
#:test-suite #:deftest #:show-result #:test-suite #:deftest #:show-result
#:failure #:check #:test #:== #:has-prefix #:failure #:check #:test #:== #:has-prefix #:in-seq
#:test-path #:*current-system*)) #:test-path #:*current-system*))
(in-package :scopes/testing) (in-package :scopes/testing)
@ -39,7 +39,8 @@
(let ((is-ok (funcall fn have wanted))) (let ((is-ok (funcall fn have wanted)))
(push is-ok (car (result *test-suite*))) (push is-ok (car (result *test-suite*)))
(unless is-ok (unless is-ok
(failure fmt have wanted)))) (failure fmt have wanted))
is-ok))
(defun == (have wanted) (defun == (have wanted)
(check #'equalp "~s!=~s" have wanted)) (check #'equalp "~s!=~s" have wanted))
@ -51,6 +52,11 @@
(check #'(lambda (h w) (string= (str:prefix (list h w)) w)) (check #'(lambda (h w) (string= (str:prefix (list h w)) w))
"~s has not prefix ~s" have wanted)) "~s has not prefix ~s" have wanted))
(defun in-seq (have seq &key remove)
(if (and (check #'position "~s is not in ~s" have seq) remove)
(remove-if (lambda (x) (eql x have)) seq :count 1)
seq))
(defmacro deftest (name args &body body) (defmacro deftest (name args &body body)
`(defun ,name ,args `(defun ,name ,args
(push '(,name) (result *test-suite*)) (push '(,name) (result *test-suite*))