cco/decons
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

rename test-decons package; start new csys stuff

Browse source
This commit is contained in:
Helmut Merz 2025-06-04 10:57:05 +02:00
parent a70a1487eb
commit 7c557a2db4
3 changed files with 20 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
csys.lisp Normal file
View file

@ -0,0 +1,10 @@
;;;; decons/csys - cybernetic communication systems
(defpackage :decons/csys
(:use :common-lisp)
(:local-nicknames (:util :scopes/util))
(:export #:system))
(in-package :decons/csys)

2
decons.asd
View file

@ -18,4 +18,4 @@
:depends-on (:decons) :depends-on (:decons)
:components ((:file "test-decons")) :components ((:file "test-decons"))
:perform (test-op (o c) :perform (test-op (o c)
(symbol-call :test-decons :run))) (symbol-call :decons/test-decons :run)))

27
test-decons.lisp
View file

@ -1,6 +1,6 @@
;;;; decons/test-decons - basic tests. ;;;; decons/test-decons - basic tests.
(defpackage :test-decons (defpackage :decons/test-decons
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:mlx :decons/mlx) (:local-nicknames (:mlx :decons/mlx)
(:r :decons/recurse) (:r :decons/recurse)
@ -9,19 +9,17 @@
(:export #:run) (:export #:run)
(:import-from :scopes/testing #:deftest #:== #:!=)) (:import-from :scopes/testing #:deftest #:== #:!=))
(in-package :test-decons) (in-package :decons/test-decons)
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite "decons"))) (let ((t:*test-suite* (t:test-suite "decons")))
(test-basic) (test-xplore)
(test-tensor) (test-recursive)
(test-rcall)
(test-rreduce)
(test-line) (test-line)
(test-quad) (test-quad)
(t:show-result))) (t:show-result)))
(deftest test-basic () (deftest test-xplore ()
(== xplore:+pi+ 3.14159) (== xplore:+pi+ 3.14159)
(let ((c (make-instance 'xplore:circle :radius 2.0))) (let ((c (make-instance 'xplore:circle :radius 2.0)))
(== (xplore:area c) 12.56636)) (== (xplore:area c) 12.56636))
@ -29,9 +27,6 @@
(== (xplore:absv 7) 7) (== (xplore:absv 7) 7)
(== (xplore:absv -7) 7) (== (xplore:absv -7) 7)
(== (xplore:remainder 7 4) 3) (== (xplore:remainder 7 4) 3)
)
(deftest test-tensor ()
(== (xplore:scalar-p 7) t) (== (xplore:scalar-p 7) t)
(== (xplore:scalar-p '(a b)) nil) (== (xplore:scalar-p '(a b)) nil)
(let ((t1 (xplore:tensor '(4) '(0 1 2 3)))) (let ((t1 (xplore:tensor '(4) '(0 1 2 3))))
@ -41,20 +36,16 @@
(== (xplore:scalar-p t1) nil) (== (xplore:scalar-p t1) nil)
)) ))
(deftest test-rcall () (deftest test-recursive ()
(== (r:reduce-all #'+ '(1 2 (3 4))) 10)
(== (r:reduce-1 #'+ '(1 2 (3 4))) '(1 2 7))
(== (r:call #'1+ 7) 8) (== (r:call #'1+ 7) 8)
(== (r:call #'1+ '(2 3)) '(3 4)) (== (r:call #'1+ '(2 3)) '(3 4))
(== (r:add 2 3) 5) (== (r:add 2 3) 5)
(== (r:add 3 '(4 5)) '(7 8)) (== (r:add 3 '(4 5)) '(7 8))
(== (r:add '(2 3) '(4 5)) '(6 8)) ; not '((6 7) (7 8)) (== (r:add '(2 3) '(4 5)) '(6 8)) ; not '((6 7) (7 8))
(== (r:sub '(6 7) '(4 5)) '(2 2)) ; not '((2 3) (1 2)) (== (r:sub '(6 7) '(4 5)) '(2 2)) ; not '((2 3) (1 2))
(== (r:sqr '(2 3 4)) '(4 9 16)) (== (r:sqr '(2 3 4)) '(4 9 16)))
)
(deftest test-rreduce ()
(== (r:reduce-all #'+ '(1 2 (3 4))) 10)
(== (r:reduce-1 #'+ '(1 2 (3 4))) '(1 2 7))
)
(defvar *ds1* '((2.0 1.0 4.0 3.0) (defvar *ds1* '((2.0 1.0 4.0 3.0)
(1.8 1.2 4.2 3.3))) (1.8 1.2 4.2 3.3)))