From 1dc2103ff560c5917d92a1ca43755d6e248ea952 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 28 Aug 2004 22:05:54 +0000 Subject: [PATCH] Added loop for across tests for various specialized arrays --- ansi-tests/loop5.lsp | 46 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/ansi-tests/loop5.lsp b/ansi-tests/loop5.lsp index 325765f6..190276b6 100644 --- a/ansi-tests/loop5.lsp +++ b/ansi-tests/loop5.lsp @@ -143,6 +143,52 @@ (loop for e across da collect e)) (1 0 0 1 0)) +(deftest loop.5.39 + (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10) + :fill-pointer 6))) + (loop for x across v collect x)) + (1 2 3 4 5 6)) + +(deftest loop.5.40 + (loop for i from 1 to 40 + for type = `(unsigned-byte ,i) + for v = (make-array '(10) :initial-contents '(0 0 1 1 0 1 1 1 0 0) + :element-type type) + for r = (loop for x across v collect x) + unless (equal r '(0 0 1 1 0 1 1 1 0 0)) + collect (list i r)) + nil) + +(deftest loop.5.41 + (loop for i from 1 to 40 + for type = `(signed-byte ,i) + for v = (make-array '(10) :initial-contents '(0 0 -1 -1 0 -1 -1 -1 0 0) + :element-type type) + for r = (loop for x across v collect x) + unless (equal r '(0 0 -1 -1 0 -1 -1 -1 0 0)) + collect (list i r)) + nil) + +(deftest loop.5.42 + (let ((vals '(0 0 1 1 0 1 1 1 0 0))) + (loop for type in '(short-float single-float double-float long-float) + for fvals = (loop for v in vals collect (coerce v type)) + for v = (make-array '(10) :initial-contents fvals :element-type type) + for r = (loop for x across v collect x) + unless (equal r fvals) + collect (list i r))) + nil) + +(deftest loop.5.43 + (let ((vals '(0 0 1 1 0 1 1 1 0 0))) + (loop for etype in '(short-float single-float double-float long-float) + for type = `(complex ,etype) + for fvals = (loop for v in vals collect (coerce v type)) + for v = (make-array '(10) :initial-contents fvals :element-type type) + for r = (loop for x across v collect x) + unless (equal r fvals) + collect (list i r))) + nil) ;;; Error cases -- GitLab