chore: more tests, fixes

- add DELAY
- fix definition of OF-MAX-LENGTH
- add ignorable declaration to CONJ and DISJ
- lots of new tests
This commit is contained in:
Edward Langley
2022-10-01 12:00:23 -07:00
parent 6b83963208
commit 0a90adbe04
4 changed files with 222 additions and 15 deletions

View File

@ -8,7 +8,8 @@
:author "Edward Langley <el-cl@elangley.org>" :author "Edward Langley <el-cl@elangley.org>"
:license "Apache v2" :license "Apache v2"
:depends-on (:cl-ppcre :depends-on (:cl-ppcre
:alexandria) :alexandria
(:require :sb-cover))
:serial t :serial t
:in-order-to ((test-op (test-op :data-lens/test))) :in-order-to ((test-op (test-op :data-lens/test)))
:components ((:file "package") :components ((:file "package")
@ -20,7 +21,8 @@
:author "Edward Langley <el-cl@elangley.org>" :author "Edward Langley <el-cl@elangley.org>"
:license "Apache v2" :license "Apache v2"
:depends-on (:data-lens :depends-on (:data-lens
:fiveam) :fiveam
:string-case)
:serial t :serial t
:perform (test-op (o c) :perform (test-op (o c)
(unless (symbol-call :fiveam '#:run! :data-lens.lens) (unless (symbol-call :fiveam '#:run! :data-lens.lens)

View File

@ -102,7 +102,7 @@
(defun-ct of-max-length (len) (defun-ct of-max-length (len)
(lambda (it) (lambda (it)
(>= (length it) (<= (length it)
len))) len)))
(defun-ct applicable-when (fun test) (defun-ct applicable-when (fun test)
@ -114,6 +114,7 @@
(defmacro conj (&rest fns) (defmacro conj (&rest fns)
(let ((dat (gensym "dat"))) (let ((dat (gensym "dat")))
`(lambda (,dat) `(lambda (,dat)
(declare (ignorable ,dat))
(and ,@(mapcar (lambda (fn) (and ,@(mapcar (lambda (fn)
`(funcall ,fn ,dat)) `(funcall ,fn ,dat))
fns))))) fns)))))
@ -226,6 +227,13 @@
(apply f args)) (apply f args))
r))))) r)))))
(defun delay ()
"Return a function that always returns the last thing it was called with"
(let ((result nil))
(lambda (v)
(prog1 result
(setf result v)))))
(defun =>> (fun1 fun2) (defun =>> (fun1 fun2)
(lambda (i) (lambda (i)
(prog1 (funcall fun1 i) (prog1 (funcall fun1 i)

View File

@ -20,7 +20,7 @@
#:transform-head #:maximizing #:zipping #:applying #:transform-head #:maximizing #:zipping #:applying
#:splice-elt #:transform-elt #:denest #:op #:defalias #:<> #:splice-elt #:transform-elt #:denest #:op #:defalias #:<>
#:<>1 #:== #: #:suffixp #:functionalize #:inc #:group-by #:<>1 #:== #: #:suffixp #:functionalize #:inc #:group-by
#:keys #:conj #:disj)) #:keys #:conj #:disj #:delay))
(defpackage :data-lens.transducers.internals (defpackage :data-lens.transducers.internals
(:use :cl) (:use :cl)

View File

@ -6,17 +6,6 @@
(5am:def-suite :data-lens.lens) (5am:def-suite :data-lens.lens)
(5am:in-suite :data-lens.lens) (5am:in-suite :data-lens.lens)
(5am:def-test == (:suite :data-lens.lens)
(5am:is (equal t
(funcall (data-lens:== 1)
1)))
(5am:is (equal nil
(funcall (data-lens:== (list "1"))
(list "1"))))
(5am:is (equal t
(funcall (data-lens:== (list "1") :test #'equal)
(list "1")))))
(5am:def-test functionalize (:suite :data-lens.lens) (5am:def-test functionalize (:suite :data-lens.lens)
(5am:is (equal 2 (5am:is (equal 2
(funcall (data-lens:functionalize #'1+) 1))) (funcall (data-lens:functionalize #'1+) 1)))
@ -29,6 +18,214 @@
(alexandria:plist-hash-table '(1 8 2 4))) (alexandria:plist-hash-table '(1 8 2 4)))
1)))) 1))))
(5am:def-test == (:suite :data-lens.lens)
(5am:is (equal t
(funcall (data-lens:== 1)
1)))
(5am:is (equal nil
(funcall (data-lens:== (list "1"))
(list "1"))))
(5am:is (equal t
(funcall (data-lens:== (list "1") :test #'equal)
(list "1")))))
(5am:def-test delay (:suite :data-lens.lens)
(5am:is (equal '((nil 1)
(1 2)
(2 3)
(3 4))
(mapcar (data-lens:juxt (data-lens:delay)
'identity)
'(1 2 3 4)))))
(5am:def-test of-length (:suite :data-lens.lens)
(5am:is (equal t
(funcall (data-lens:of-length 3)
'(1 2 3))))
(5am:is (equal nil
(funcall (data-lens:of-length 3)
'(2 3))))
(5am:is (equal t
(funcall (data-lens:of-length 0)
'())))
(5am:is (equal t
(funcall (data-lens:of-length 1)
'(1)))))
(5am:def-test of-min-length (:suite :data-lens.lens)
(5am:is (equal t
(funcall (data-lens:of-min-length 3)
'(1 2 3 4 5))))
(5am:is (equal nil
(funcall (data-lens:of-min-length 3)
'(2 3))))
(5am:is (equal t
(funcall (data-lens:of-min-length 0)
'())))
(5am:is (equal t
(funcall (data-lens:of-min-length 0)
'(1)))))
(5am:def-test of-max-length (:suite :data-lens.lens)
(5am:is (equal nil
(funcall (data-lens:of-max-length 3)
'(1 2 3 4 5))))
(5am:is (equal t
(funcall (data-lens:of-max-length 3)
'(2 3))))
(5am:is (equal t
(funcall (data-lens:of-max-length 0)
'())))
(5am:is (equal nil
(funcall (data-lens:of-max-length 0)
'(1)))))
(5am:def-test applicable-when (:suite :data-lens.lens)
(5am:is (equal 1
(funcall (data-lens:applicable-when '1+ (constantly nil))
1)))
(5am:is (equal 2
(funcall (data-lens:applicable-when '1+ (constantly t))
1))))
(5am:def-test conj (:suite :data-lens.lens)
(5am:is (equal t
(not
(not
(eval `(funcall (data-lens:conj 'oddp 'identity)
1))))))
(5am:is (equal nil
(not
(not
(eval `(funcall (data-lens:conj 'oddp 'evenp)
1))))))
(5am:is (equal t
(not
(not
(eval `(funcall (data-lens:conj)
1)))))))
(5am:def-test disj (:suite :data-lens.lens)
(5am:is (equal t
(not
(not
(eval `(funcall (data-lens:disj 'oddp 'identity)
1))))))
(5am:is (equal t
(not
(not
(eval `(funcall (data-lens:disj 'oddp 'evenp)
1))))))
(5am:is (equal nil
(not
(not
(eval `(funcall (data-lens:disj)
1)))))))
(5am:def-test sorted (:suite :data-lens.lens)
(5am:is (equal '(1 2 3 4 5)
(funcall (data-lens:sorted '<)
'(5 4 3 2 1)))))
(5am:def-test element (:suite :data-lens.lens)
(5am:is (equal 1
(funcall (data-lens:element 1)
'(0 1 2 3))))
(5am:is (equal 1
(funcall (data-lens:element 1)
#(0 1 2 3)))))
(defclass my-map ()
((%a :initform 1 :reader a)
(%b :initform 2 :reader b)
(%c :initform 3 :reader c)
(%d :initform 4 :reader d)))
(defmethod data-lens:extract-key ((map my-map) key)
(string-case:string-case (key)
("a" (a map))
("b" (b map))
("c" (c map))
("d" (d map))))
(5am:def-test key (:suite :data-lens.lens)
(5am:is (equal 1
(funcall (data-lens:key "a")
(alexandria:alist-hash-table
'(("b" . 2)
("a" . 1)
("c" . 3))
:test 'equal))))
(5am:is (equal 1
(funcall (data-lens:key "a")
'(("b" . 2)
("a" . 1)
("c" . 3)))))
(5am:is (equal 1
(funcall (data-lens:key "a")
'("b" 2
"a" 1
"c" 3))))
(5am:is (equal 1
(funcall (data-lens:key "a")
(make-instance 'my-map)))))
(5am:def-test keys (:suite :data-lens.lens)
(5am:is (equal 4
(funcall (data-lens:keys "a" "b" "c" "d")
(list (cons "a"
(list "b"
(alexandria:alist-hash-table
(acons "c" (make-instance 'my-map) ())
:test 'equal))))))))
(5am:def-test regex-match (:suite :data-lens.lens)
(5am:is (serapeum:seq=
(list "acb" #("c"))
(multiple-value-list
(funcall (data-lens:regex-match "a(.)b")
"<acb>")))))
(5am:def-test include (:suite :data-lens.lens)
(5am:is (equal '(1 3 5)
(funcall (data-lens:include 'oddp)
'(1 2 3 4 5 6)))))
(5am:def-test exclude (:suite :data-lens.lens)
(5am:is (equal '(2 4 6)
(funcall (data-lens:exclude 'oddp)
'(1 2 3 4 5 6)))))
(5am:def-test pick (:suite :data-lens.lens)
(5am:is (equal '(1 2 3)
(funcall (data-lens:pick 'car)
'((1 2) (2 3) (3 4)))))
(5am:is (equal '()
(funcall (data-lens:pick 'car)
'()))))
(5am:def-test slice (:suite :data-lens.lens)
(5am:is (equal '(1)
(funcall (data-lens:slice 1 2)
'(0 1 2)))))
(5am:def-test update (:suite :data-lens.lens)
(5am:is-true (funcall (data-lens:suffixp "qwer")
"asdfqwer"))
(5am:is-true (funcall (data-lens:suffixp (mapcar 'copy-seq
(list "q" "w" "e" "r"))
:test 'equal)
'("a" "s" "d" "f" "q" "w" "e" "r")))
(5am:is-false (funcall (data-lens:suffixp "qwer")
"qwerasdf"))
(5am:is-false (funcall (data-lens:suffixp (mapcar 'copy-seq
(list "q" "w" "e" "r"))
:test 'equal)
'("q" "w" "e" "r" "a" "s" "d" "f"))))
(5am:def-test suffixp (:suite :data-lens.lens))
(5am:def-test on (:suite :data-lens.lens :depends-on (and functionalize)) (5am:def-test on (:suite :data-lens.lens :depends-on (and functionalize))
(5am:is (equal 2 (5am:is (equal 2
(funcall (data-lens:on '1+ 'car) (funcall (data-lens:on '1+ 'car)