7db631c1cf60
Add array tests
author | Steve Losh <steve@stevelosh.com> |
---|---|
date | Sun, 17 Jun 2018 17:10:27 -0700 |
parents | a0c69729ade3 |
children | 6dbc64f70f9b |
branches/tags | (none) |
files | losh.asd src/arrays.lisp test/arrays.lisp |
Changes
--- a/losh.asd Sun Jun 17 16:50:40 2018 -0700 +++ b/losh.asd Sun Jun 17 17:10:27 2018 -0700 @@ -73,6 +73,7 @@ :serial t :components ((:file "package") (:file "base") + (:file "arrays") (:file "control-flow")))) :perform (asdf:test-op (op system)
--- a/src/arrays.lisp Sun Jun 17 16:50:40 2018 -0700 +++ b/src/arrays.lisp Sun Jun 17 17:10:27 2018 -0700 @@ -1,7 +1,5 @@ (in-package :losh.arrays) - -;;;; Arrays ------------------------------------------------------------------- (declaim (ftype (function ((array * *) t)) fill-multidimensional-array) (ftype (function ((array t *) t)) fill-multidimensional-array-t)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/arrays.lisp Sun Jun 17 17:10:27 2018 -0700 @@ -0,0 +1,77 @@ +(in-package :losh.test) + + +(define-test do-array + (let ((a (make-array 4 :initial-contents '(1 2 3 4))) + (mda (make-array (list 2 2) :initial-contents '((1 2) (3 4))))) + (is (equal '(1 2 3 4) + (gathering + (do-array (x a) + (gather x))))) + (do-array (x mda) + (incf x)) + (is (equal '(2 3 4 5) + (gathering + (do-array (x mda) + (gather x))))))) + +(define-test fill-multidimensional-array + (let ((mda (make-array (list 2 2) :initial-contents '((1 2) (3 4))))) + (is (equalp #2A((1 2) (3 4)) mda)) + (fill-multidimensional-array mda 9) + (is (equalp #2A((9 9) (9 9)) mda))) + + (let ((mda (make-array (list 2 2) + :initial-contents '((1 2) (3 4)) + :element-type t))) + (is (equalp #2A((1 2) (3 4)) mda)) + (fill-multidimensional-array-t mda 9) + (is (equalp #2A((9 9) (9 9)) mda))) + + (let ((mda (make-array (list 2 2) + :initial-contents '((1 2) (3 4)) + :element-type 'fixnum))) + (is (equalp #2A((1 2) (3 4)) mda)) + (fill-multidimensional-array-fixnum mda 9) + (is (equalp #2A((9 9) (9 9)) mda))) + + (let ((mda (make-array (list 2 2) + :initial-contents '((1.0 2.0) (3.0 4.0)) + :element-type 'single-float))) + (is (equalp #2A((1.0 2.0) (3.0 4.0)) mda)) + (fill-multidimensional-array-single-float mda 9.0) + (is (equalp #2A((9.0 9.0) (9.0 9.0)) mda)))) + +(define-test vector-last + (is (equal '(nil nil) + (multiple-value-list (vector-last #())))) + (is (equal '(nil t) + (multiple-value-list (vector-last #(nil))))) + (let ((v (make-array 4 + :initial-contents '(1 2 3 4) + :fill-pointer t))) + (is (equal '(4 t) + (multiple-value-list (vector-last v)))) + (setf (fill-pointer v) 2) + (is (equal '(2 t) + (multiple-value-list (vector-last v)))) + (setf (fill-pointer v) 0) + (is (equal '(nil nil) + (multiple-value-list (vector-last v)))))) + + +(define-test bisect-left + (let ((v #(10 12 14 16 18 20))) + (is (equal '(14 2) (multiple-value-list (bisect-left #'<= v 15)))) + (is (equal '(14 2) (multiple-value-list (bisect-left #'<= v 14)))) + (is (equal '(20 5) (multiple-value-list (bisect-left #'<= v 999)))) + (is (equal '(10 0) (multiple-value-list (bisect-left #'<= v 11)))) + (is (equal '(nil nil) (multiple-value-list (bisect-left #'<= v 0)))))) + +(define-test bisect-right + (let ((v #(10 12 14 16 18 20))) + (is (equal '(16 3) (multiple-value-list (bisect-right #'<= v 15)))) + (is (equal '(16 3) (multiple-value-list (bisect-right #'<= v 14)))) + (is (equal '(nil nil) (multiple-value-list (bisect-right #'<= v 999)))) + (is (equal '(12 1) (multiple-value-list (bisect-right #'<= v 11)))) + (is (equal '(10 0) (multiple-value-list (bisect-right #'<= v 0))))))