diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index d83edcf7b6fd19ab3352e2b74d9ae33c7db68a82..c225dee37c451d7f80c5742ba6a7d44190efc936 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -148,6 +148,12 @@ (copy-seq #()) #()) +(deftest copy-seq.18 + (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j))) + (y (copy-seq x))) + (equal-array x y)) + t) + ;;; Error tests (deftest copy-seq.error.1 diff --git a/ansi-tests/map-into.lsp b/ansi-tests/map-into.lsp index 1174f561e717e6482dddffad8f4e37e437cad306..5446da6888589865ca36ef8f4068cb49d7892d6d 100644 --- a/ansi-tests/map-into.lsp +++ b/ansi-tests/map-into.lsp @@ -123,14 +123,16 @@ (let ((a (make-array 6 :initial-element 'x :fill-pointer 3))) (map-into a #'identity '(1 2 3 4 5)) - a) + (and (eqlt (fill-pointer a) 5) + a)) #(1 2 3 4 5)) (deftest map-into-array.10 (let ((a (make-array 6 :initial-element 'x :fill-pointer 3))) (map-into a #'(lambda () 'y)) - a) + (and (eqlt (fill-pointer a) 6) + a)) #(y y y y y y)) ;;; mapping into strings @@ -156,6 +158,65 @@ t "1234") +(deftest map-into-string.4 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character + :fill-pointer 3))) + (map-into a #'identity "abcde") + (values + (fill-pointer a) + (aref a 5) + a)) + 5 + #\x + "abcde") + +(deftest map-into-string.5 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character + :fill-pointer 3))) + (map-into a #'(lambda () #\y)) + (values (fill-pointer a) + a)) + 6 + "yyyyyy") + +(deftest map-into-string.6 + (let ((a (make-array 6 :initial-element #\x + :element-type 'character))) + (map-into a #'(lambda () #\y)) + a) + "yyyyyy") + +(deftest map-into-string.7 + (let ((a (make-array 6 :initial-element #\x + :element-type 'base-char + :fill-pointer 3))) + (map-into a #'identity "abcde") + (values (fill-pointer a) + (aref a 5) + a)) + 5 + #\x + "abcde") + +(deftest map-into-string.8 + (let ((a (make-array 6 :initial-element #\x + :element-type 'base-char + :fill-pointer 3))) + (map-into a #'(lambda () #\y)) + (values (fill-pointer a) + a)) + 6 + "yyyyyy") + +(deftest map-into-string.9 + (let ((a (make-array 6 :initial-element #\x + :element-type 'base-char))) + (map-into a #'(lambda () #\y)) + a) + "yyyyyy") + (deftest map-into-error.1 (classify-error (map-into 'a #'(lambda () nil))) type-error) @@ -167,3 +228,4 @@ (deftest map-into-error.3 (classify-error (map-into (copy-seq '(a b c)) #'cons '(d e f) 100)) type-error) + diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp index b941a70640fb7259549428c2b3d6a2fe07d3fa92..092d50998af89e447e9609ca15d9132fd1ab92a0 100644 --- a/ansi-tests/map.lsp +++ b/ansi-tests/map.lsp @@ -175,3 +175,46 @@ (deftest map-error.3 (classify-error (map 'list #'identity '(a b . c))) type-error) + + +;;; Test mapping on arrays with fill pointers + +(deftest map.fill.1 + (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 8))) + (map 'list #'identity s1)) + (a b c d e f g h)) + +(deftest map.fill.2 + (let ((s1 (make-array '(10) :initial-contents '(a b c d e f g h i j) + :fill-pointer 8))) + (map 'list #'identity '(1 2 3 4 5 6 7 8 9 10) s1)) + (1 2 3 4 5 6 7 8)) + +(deftest map.fill.3 + (let ((s1 (make-array '(10) :initial-element #\a + :element-type 'character + :fill-pointer 8))) + (map 'string #'identity s1)) + "aaaaaaaa") + +(deftest map.fill.4 + (let ((s1 (make-array '(10) :initial-element #\a + :element-type 'base-char + :fill-pointer 8))) + (map 'list #'identity '(1 2 3 4 5 6 7 8 9 10) s1)) + (1 2 3 4 5 6 7 8)) + +(deftest map.fill.5 + (let ((s1 (make-array '(10) :initial-element 0 + :element-type 'bit + :fill-pointer 8))) + (map 'bit-vector #'identity s1)) + #*00000000) + +(deftest map.fill.6 + (let ((s1 (make-array '(10) :initial-element 1 + :element-type 'bit + :fill-pointer 8))) + (map 'list #'identity '(1 2 3 4 5 6 7 8 9 10) s1)) + (1 2 3 4 5 6 7 8)) diff --git a/ansi-tests/subseq.lsp b/ansi-tests/subseq.lsp index e198eef28eb83dd7442c59fa9bc994deb92e580c..5f8adb8a8af2e45f16c53f2b1fa2b7ab9be99b9c 100644 --- a/ansi-tests/subseq.lsp +++ b/ansi-tests/subseq.lsp @@ -30,7 +30,7 @@ (let ((y (subseq x i j))) (loop for e in y and k from i to (1- j) do - (unless (eql e k) (return-from done nil))))))) + (unless (eqlt e k) (return-from done nil))))))) t)) (deftest subseq-list-4 @@ -42,8 +42,8 @@ (let ((x (loop for i from 0 to 29 collect i))) (loop for i from 0 to 30 do - (unless (equal (subseq x i) - (loop for j from i to 29 collect j)) + (unless (equalt (subseq x i) + (loop for j from i to 29 collect j)) (return-from done nil)))) t)) @@ -60,7 +60,7 @@ and f on y and g in z do (when (or (not (eqt g e)) - (not (eql (car e) (car f))) + (not (eqlt (car e) (car f))) (car e) (eqt e f)) (return nil)) @@ -121,8 +121,8 @@ (return 1)) (unless (every #'(lambda (e) (eqt e 'a)) y) (return 2)) - (unless (eql (length x) 10) (return 3)) - (unless (eql (length y) 4) (return 4)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) (loop for i from 0 to 9 do (setf (aref x i) 'b)) (unless (every #'(lambda (e) (eqt e 'a)) y) (return 5)) @@ -139,18 +139,18 @@ (block nil (let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1)) (y (subseq x 4 8))) - (unless (every #'(lambda (e) (eql e 1)) x) + (unless (every #'(lambda (e) (eqlt e 1)) x) (return 1)) - (unless (every #'(lambda (e) (eql e 1)) y) + (unless (every #'(lambda (e) (eqlt e 1)) y) (return 2)) - (unless (eql (length x) 10) (return 3)) - (unless (eql (length y) 4) (return 4)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) (loop for i from 0 to 9 do (setf (aref x i) 2)) - (unless (every #'(lambda (e) (eql e 1)) y) + (unless (every #'(lambda (e) (eqlt e 1)) y) (return 5)) (loop for i from 0 to 3 do (setf (aref y i) 3)) (or - (not (not (every #'(lambda (e) (eql e 2)) x))) + (not (not (every #'(lambda (e) (eqlt e 2)) x))) 6)))) (deftest subseq-vector-2 @@ -165,8 +165,8 @@ (return 1)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 2)) - (unless (eql (length x) 10) (return 3)) - (unless (eql (length y) 4) (return 4)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) (loop for i from 0 to 9 do (setf (aref x i) 2.0)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 5)) @@ -187,8 +187,8 @@ (return 1)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 2)) - (unless (eql (length x) 10) (return 3)) - (unless (eql (length y) 4) (return 4)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) (loop for i from 0 to 9 do (setf (aref x i) 2.0d0)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 5)) @@ -209,8 +209,8 @@ (return 1)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 2)) - (unless (eql (length x) 10) (return 3)) - (unless (eql (length y) 4) (return 4)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) (loop for i from 0 to 9 do (setf (aref x i) 2.0s0)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 5)) @@ -220,7 +220,7 @@ 6)))) (deftest subseq-vector-5 - (subseq-vector-5-body) + (subseq-vector-5-body) t) (defun subseq-vector-6-body () @@ -231,8 +231,8 @@ (return 1)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 2)) - (unless (eql (length x) 10) (return 3)) - (unless (eql (length y) 4) (return 4)) + (unless (eqlt (length x) 10) (return 3)) + (unless (eqlt (length y) 4) (return 4)) (loop for i from 0 to 9 do (setf (aref x i) 2.0l0)) (unless (every #'(lambda (e) (= e 1.0)) y) (return 5)) @@ -242,14 +242,7 @@ 6)))) (deftest subseq-vector-6 - (subseq-vector-6-body) - t) - -;;; slipped this in here for the moment -(deftest copy-seq-vector-1 - (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j))) - (y (copy-seq x))) - (equal-array x y)) + (subseq-vector-6-body) t) (deftest subseq-vector-7 @@ -262,7 +255,7 @@ (let* ((x (make-array '(200) :initial-element 107 :element-type 'fixnum)) (y (subseq x 17 95))) - (and (eql (length y) (- 95 17)) + (and (eqlt (length y) (- 95 17)) (equal-array y (make-array (list (- 95 17)) :initial-element 107 @@ -275,7 +268,7 @@ (lo 164) (hi 873) (y (subseq x lo hi))) - (and (eql (length y) (- hi lo)) + (and (eqlt (length y) (- hi lo)) (equal-array y (make-array (list (- hi lo)) :initial-element 17.6e-1 @@ -288,10 +281,109 @@ (lo 731) (hi 1942) (y (subseq x lo hi))) - (and (eql (length y) (- hi lo)) + (and (eqlt (length y) (- hi lo)) (equal-array y (make-array (list (- hi lo)) :initial-element 3.1415927d4 :element-type 'double-float)))) t) +;;; subseq on strings + +(deftest subseq-string-1 + (let* ((s1 "abcdefgh") + (len (length s1))) + (loop for start from 0 below len + always + (string= (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'string)))) + t) + +(deftest subseq-string-2 + (let* ((s1 "abcdefgh") + (len (length s1))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (string= (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'string))))) + t) + +(deftest subseq-string-3 + (let* ((s1 (make-array '(10) :initial-contents + (coerce "abcdefghij" 'list) + :fill-pointer 8 + :element-type 'character)) + (len (length s1))) + (and + (eqlt len 8) + (loop for start from 0 below len + always + (string= (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'string))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (string= (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'string)))))) + t) + +;;; Tests on bit vectors + +(deftest subseq-bit-vector-1 + (let* ((s1 #*11001000) + (len (length s1))) + (loop for start from 0 below len + always + (equalp (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'bit-vector)))) + t) + +(deftest subseq-bit-vector-2 + (let* ((s1 #*01101011) + (len (length s1))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (equalp (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'bit-vector))))) + t) + +(deftest subseq-bit-vector-3 + (let* ((s1 (make-array '(10) :initial-contents + (coerce #*1101100110 'list) + :fill-pointer 8 + :element-type 'bit)) + (len (length s1))) + (and + (eqlt len 8) + (loop for start from 0 below len + always + (equalp (subseq s1 start) + (coerce (loop for i from start to (1- len) + collect (aref s1 i)) + 'bit-vector))) + (loop for start from 0 below len + always + (loop for end from (1+ start) to len + always + (equalp (subseq s1 start end) + (coerce (loop for i from start below end + collect (aref s1 i)) + 'bit-vector)))))) + t)