From 200e2968e40dce118ec1b1e68a824805b6766c2e Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sat, 26 Oct 2002 02:42:26 +0000
Subject: [PATCH] Added tests for simple loops; began adding tests for extended
 loops.

---
 ansi-tests/gclload2.lsp |   2 +
 ansi-tests/loop.lsp     |  53 +++++++++++++++++++++
 ansi-tests/loop1.lsp    | 100 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 155 insertions(+)
 create mode 100644 ansi-tests/loop.lsp
 create mode 100644 ansi-tests/loop1.lsp

diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp
index 78fd1503..73c1332f 100644
--- a/ansi-tests/gclload2.lsp
+++ b/ansi-tests/gclload2.lsp
@@ -73,6 +73,8 @@
 
 ;;; Tests of iteration forms
 (load "iteration.lsp")
+(load "loop.lsp")
+(load "loop1.lsp")
 
 ;;; Tests of conses
 
diff --git a/ansi-tests/loop.lsp b/ansi-tests/loop.lsp
new file mode 100644
index 00000000..2a362faa
--- /dev/null
+++ b/ansi-tests/loop.lsp
@@ -0,0 +1,53 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Fri Oct 25 18:48:59 2002
+;;;; Contains: Tests of LOOP
+
+(in-package :cl-test)
+
+;;; Simple loops
+(deftest sloop.1
+  (loop (return 'a))
+  a)
+
+(deftest sloop.2
+  (loop (return (values))))
+
+(deftest sloop.3
+  (loop (return (values 'a 'b 'c 'd)))
+  a b c d)
+
+(deftest sloop.4
+  (block nil
+    (loop (return 'a))
+    'b)
+  b)
+
+(deftest sloop.5
+  (let ((i 0) (x nil))
+    (loop
+     (when (>= i 4) (return x))
+     (incf i)
+     (push 'a x)))
+  (a a a a))
+
+(deftest sloop.6
+  (let ((i 0) (x nil))
+    (block foo
+      (tagbody
+       (loop
+	(when (>= i 4) (go a))
+	(incf i)
+	(push 'a x))
+       a
+       (return-from foo x))))
+  (a a a a))
+
+(deftest sloop.7
+  (catch 'foo
+    (let ((i 0) (x nil))
+    (loop
+     (when (>= i 4) (throw 'foo x))
+     (incf i)
+     (push 'a x))))
+  (a a a a))
diff --git a/ansi-tests/loop1.lsp b/ansi-tests/loop1.lsp
new file mode 100644
index 00000000..20883d93
--- /dev/null
+++ b/ansi-tests/loop1.lsp
@@ -0,0 +1,100 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Fri Oct 25 19:07:19 2002
+;;;; Contains: Tests of extended loop, part 1
+
+(in-package :cl-test)
+
+;;; Tests of variable initialization and stepping clauses
+
+;;; for-as-arithmetic
+
+(deftest loop.1.1
+  (loop for x from 1 to 10 collect x)
+  (1 2 3 4 5 6 7 8 9 10))
+
+(deftest loop.1.2
+  (loop for x from 6 downto 1 collect x)
+  (6 5 4 3 2 1))
+
+(deftest loop.1.3
+  (loop for x from 1 to 1 collect x)
+  (1))
+
+(deftest loop.1.4
+  (loop for x from 1 to 0 collect x)
+  nil)
+
+(deftest loop.1.5
+  (loop for x to 5 collect x)
+  (0 1 2 3 4 5))
+
+(deftest loop.1.6
+  (loop for x downfrom 5 to 0 collect x)
+  (5 4 3 2 1 0))
+
+(deftest loop.1.7
+  (loop for x upfrom 1 to 5 collect x)
+  (1 2 3 4 5))
+
+(deftest loop.1.8
+  (loop for x from 1.0 to 5.0 count x)
+  5)
+
+(deftest loop.1.9
+  (loop for x from 1 to 9 by 2 collect x)
+  (1 3 5 7 9))
+
+(deftest loop.1.10
+  (loop for x from 1 to 10 by 2 collect x)
+  (1 3 5 7 9))
+
+(deftest loop.1.11
+  (loop for x to 10 from 1 collect x)
+  (1 2 3 4 5 6 7 8 9 10))
+
+(deftest loop.1.12
+  (loop for x to 10 by 2 from 1 collect x)
+  (1 3 5 7 9))
+
+(deftest loop.1.13
+  (loop for x by 2 to 10 from 1 collect x)
+  (1 3 5 7 9))
+
+(deftest loop.1.14
+  (loop for x by 2 to 10 collect x)
+  (0 2 4 6 8 10))
+
+(deftest loop.1.15
+  (loop for x to 10 by 2 collect x)
+  (0 2 4 6 8 10))
+
+(deftest loop.1.16
+  (let ((n 0))
+    (loop for x from (incf n) to (+ n 5) collect x))
+  (1 2 3 4 5 6))
+
+(deftest loop.1.17
+  (let ((n 0))
+    (loop for x to (+ n 5) from (incf n) collect x))
+  (1 2 3 4 5))
+
+(deftest loop.1.18
+  (let ((n 0))
+    (loop for x from (incf n) to (+ n 9) by (incf n) collect x))
+  (1 3 5 7 9))
+
+(deftest loop.1.19
+  (let ((n 0))
+    (loop for x from (incf n) by (incf n) to (+ n 9) collect x))
+  (1 3 5 7 9 11))
+
+(deftest loop.1.20
+  (let ((a 0) (b 5) (c 1))
+    (loop for x from a to b by c
+	  collect (progn (incf a) (incf b 2) (incf c 3) x)))
+  (0 1 2 3 4 5))
+
+
+
+  
\ No newline at end of file
-- 
GitLab