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

forge: use deftest; implement seq as class

Browse source
This commit is contained in:
Helmut Merz 2024-05-21 11:39:34 +02:00
parent 53a61b660b
commit 547e02b85f
2 changed files with 25 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
forge/forge.lisp
View file

@ -117,47 +117,30 @@
; sequence ; sequence
(defun make-seq () (defclass seq ()
(let* ((start (list nil)) ((start :reader start :initform (list nil) :initarg :start)
(cur start) (cur :accessor cur)
(end start) (end :accessor end)))
(args (list start cur end)))
#'(lambda (fn) (defun make-seq (&optional start)
(setf args (apply fn args))))) (let* ((start (cons nil start))
(seq (make-instance 'seq :start start)))
(setf (cur seq) (setf (end seq) start))
seq))
(defun seq-all (seq) (defun seq-all (seq)
(let (rv) (cdr (start seq)))
(funcall seq #'(lambda (start cur end)
(setf rv (cdr start))
(list start cur end)))
rv))
(defun seq-cur (seq) (defun seq-cur (seq)
(let (rv) (car (cur seq)))
(funcall seq #'(lambda (start cur end)
(setf rv (car cur))
(list start cur end)))
rv))
(defun seq-end (seq) (defun seq-end (seq)
(let (rv) (car (end seq)))
(funcall seq #'(lambda (start cur end)
(setf rv (car end))
(list start cur end)))
rv))
(defun seq-next (seq) (defun seq-next (seq)
(let (rv) (pop (cur seq))
(funcall seq #'(lambda (start cur end) (car (cur seq)))
(pop cur)
(setf rv (car cur))
(list start cur end)))
rv))
(defun seq-add (seq v) (defun seq-add (seq v)
(funcall seq #'(lambda (start cur end) (setf (cdr (end seq)) (list v))
(setf (cdr end) (list v)) (pop (end seq)))
(pop end)
(list start cur end)))
nil)

16
test/test-forge.lisp
View file

@ -7,12 +7,12 @@
(:local-nicknames (:forge :scopes/forge) (:local-nicknames (:forge :scopes/forge)
(:t :scopes/testing)) (:t :scopes/testing))
(:export #:run) (:export #:run)
(:import-from :scopes/testing #:==)) (:import-from :scopes/testing #:deftest #:==))
(in-package :scopes/test-forge) (in-package :scopes/test-forge)
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite))) (let ((t:*test-suite* (t:test-suite "forge")))
(test-seq) (test-seq)
(test-exec) (test-exec)
;(format t "~%data-stack ~a" (dstack)) ;(format t "~%data-stack ~a" (dstack))
@ -22,32 +22,32 @@
(test-var) (test-var)
(t:show-result))) (t:show-result)))
(defun test-seq () (deftest test-seq ()
(let ((seq (forge:make-seq))) (let ((seq (forge:make-seq)))
(forge:seq-add seq 1) (forge:seq-add seq 1)
(forge:seq-add seq 2) (forge:seq-add seq 2)
(== (forge:seq-next seq) 1) (== (forge:seq-next seq) 1)
(== (forge:seq-end seq) 2))) (== (forge:seq-end seq) 2)))
(defun test-exec () (deftest test-exec ()
(forge:exec '(4 2 +)) (forge:exec '(4 2 +))
(== (car (forge:dstack)) 6)) (== (car (forge:dstack)) 6))
(defun test-def () (deftest test-def ()
(forge:exec '((dup *) "square" def)) (forge:exec '((dup *) "square" def))
(forge:exec '(7 square)) (forge:exec '(7 square))
(== (car (forge:dstack)) 49)) (== (car (forge:dstack)) 49))
(defun test-exec-str () (deftest test-exec-str ()
(forge:exec-str "16 square") (forge:exec-str "16 square")
(== (car (forge:dstack)) 256)) (== (car (forge:dstack)) 256))
(defun test-const () (deftest test-const ()
(forge:exec-str "17 \"c1\" const") (forge:exec-str "17 \"c1\" const")
(forge:exec-str "c1 square") (forge:exec-str "c1 square")
(== (car (forge:dstack)) 289)) (== (car (forge:dstack)) 289))
(defun test-var () (deftest test-var ()
(forge:exec '(24 "v1" var)) (forge:exec '(24 "v1" var))
(forge:exec '(v1 get 2 *)) (forge:exec '(v1 get 2 *))
(== (car (forge:dstack)) 48) (== (car (forge:dstack)) 48)