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