From becfaeb778a3c8ba241e2155b998d6b27dcfad0c Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Tue, 26 Jul 2022 19:24:10 -0700
Subject: Fix a potential R7RS issue.

I was using the load procedure to load a program, but by a strict
reading of R7RS, load can only handle expressions and definitions, not
imports. So instead I'm defining each test as a library, and using the
environment procedure to load them at runtime.
---
 csc/loop-test.csc | 440 +++++++++++++++++++++++++++---------------------------
 1 file changed, 221 insertions(+), 219 deletions(-)

(limited to 'csc/loop-test.csc')

diff --git a/csc/loop-test.csc b/csc/loop-test.csc
index 9a74ad4..50090e0 100644
--- a/csc/loop-test.csc
+++ b/csc/loop-test.csc
@@ -1,292 +1,294 @@
-(import (scheme base)
-        (only (csc format) printf)
-        (only (csc testing)
-          assert-equal
-          test)
-        (csc loop))
+(define-library (csc loop-test)
+  (import (scheme base)
+          (only (csc format) printf)
+          (only (csc testing)
+            assert-equal
+            test)
+          (csc loop))
+  (begin
 
 
-(test loop-for-collect
-  (assert-equal
-    '(1 2 3 4 5)
-    (loop for x in '(1 2 3 4 5)
-          collect x)))
+    (test loop-for-collect
+      (assert-equal
+        '(1 2 3 4 5)
+        (loop for x in '(1 2 3 4 5)
+              collect x)))
+
+
+    (test loop-for-collect-add
+      (assert-equal
+        '(2 3 4 5 6)
+        (loop for x in '(1 2 3 4 5)
+              collect (+ 1 x))))
 
 
-(test loop-for-collect-add
-  (assert-equal
-    '(2 3 4 5 6)
-    (loop for x in '(1 2 3 4 5)
-          collect (+ 1 x))))
+    (test loop-collect-nothing
+      (assert-equal
+        '()
+        (loop for x in '()
+              collect x)))
+
 
+    (test loop-for-arithmetic
+      (assert-equal
+        '(1 2 3 4 5)
+        (loop for x from 1 to 5
+              collect x)))
 
-(test loop-collect-nothing
-  (assert-equal
-    '()
-    (loop for x in '()
-          collect x)))
 
+    (test loop-for-arithmetic-step
+      (assert-equal
+        '(1 3 5 7 9)
+        (loop for x from 1 to 10 by 2
+              collect x)))
 
-(test loop-for-arithmetic
-  (assert-equal
-    '(1 2 3 4 5)
-    (loop for x from 1 to 5
-          collect x)))
 
+    (test loop-finally-noop
+      (assert-equal
+        '(1 2 3)
+        (loop for x from 1 to 3
+              finally (if #f #f)
+              collect x)))
 
-(test loop-for-arithmetic-step
-  (assert-equal
-    '(1 3 5 7 9)
-    (loop for x from 1 to 10 by 2
-          collect x)))
 
+    (test loop-collect-into
+      (assert-equal
+        '((1 2 3) (1 2 3) (1 2 3))
+        (loop for x from 1 to 3
+              collect x into l
+              collect l)))
 
-(test loop-finally-noop
-  (assert-equal
-    '(1 2 3)
-    (loop for x from 1 to 3
-          finally (if #f #f)
-          collect x)))
 
+    (test loop-finally-set
+      (assert-equal
+        '(1 2 3)
+        (let ((res #f))
+          (loop for x from 1 to 3
+                collect x into l
+                finally (set! res l))
+          res)))
 
-(test loop-collect-into
-  (assert-equal
-    '((1 2 3) (1 2 3) (1 2 3))
-    (loop for x from 1 to 3
-          collect x into l
-          collect l)))
 
+    (test loop-do
+      (assert-equal
+        '(3 2 1)
+        (let ((res '()))
+          (loop for x from 1 to 3
+                do (set! res (cons x res)))
+          res)))
 
-(test loop-finally-set
-  (assert-equal
-    '(1 2 3)
-    (let ((res #f))
-      (loop for x from 1 to 3
-            collect x into l
-            finally (set! res l))
-      res)))
 
+    (test loop-return
+      (assert-equal
+        '(1 2 3)
+        (loop do (return '(1 2 3)))))
 
-(test loop-do
-  (assert-equal
-    '(3 2 1)
-    (let ((res '()))
-      (loop for x from 1 to 3
-            do (set! res (cons x res)))
-      res)))
 
+    (test loop-finally-return
+      (assert-equal
+        '(1 2 3)
+        (loop for x from 1 to 3
+              collect x into l
+              finally (return l))))
 
-(test loop-return
-  (assert-equal
-    '(1 2 3)
-    (loop do (return '(1 2 3)))))
 
+    (test loop-for-as-equals-then
+      (assert-equal
+        '((1 2 3) (2 3) (3))
+        (loop for i from 1 to 3
+              for tail = '(1 2 3) then (cdr tail)
+              collect tail)))
 
-(test loop-finally-return
-  (assert-equal
-    '(1 2 3)
-    (loop for x from 1 to 3
-          collect x into l
-          finally (return l))))
 
+    (test loop-for-as-equals
+      (assert-equal
+        '((1) (2) (3))
+        (loop for i from 1 to 3
+              for j = (list i)
+              collect j)))
 
-(test loop-for-as-equals-then
-  (assert-equal
-    '((1 2 3) (2 3) (3))
-    (loop for i from 1 to 3
-          for tail = '(1 2 3) then (cdr tail)
-          collect tail)))
 
+    (test loop-return-multiple-values
+      (let-values (((x1 x2) (loop do (return (values 1 2)))))
+        (assert-equal
+          1
+          x1)
+        (assert-equal
+          2
+          x2)))
 
-(test loop-for-as-equals
-  (assert-equal
-    '((1) (2) (3))
-    (loop for i from 1 to 3
-          for j = (list i)
-          collect j)))
 
+    (test nested-loops
+      (assert-equal
+        '(1 2 3)
+        (loop do (define x (loop do (return '(1 2 3))))
+                 (return x))))
 
-(test loop-return-multiple-values
-  (let-values (((x1 x2) (loop do (return (values 1 2)))))
-    (assert-equal
-      1
-      x1)
-    (assert-equal
-      2
-      x2)))
 
+    (test loop-with-return
+      (assert-equal
+        5
+        (loop with x = 5
+              return x)))
 
-(test nested-loops
-  (assert-equal
-    '(1 2 3)
-    (loop do (define x (loop do (return '(1 2 3))))
-             (return x))))
 
+    (test loop-for-x-on-l
+      (assert-equal
+        '((1 2 3) (2 3) (3))
+        (loop for x on '(1 2 3)
+              collect x)))
 
-(test loop-with-return
-  (assert-equal
-    5
-    (loop with x = 5
-          return x)))
 
+    (test loop-for-across
+      (assert-equal
+        '(1 2 3)
+        (loop for x across #(1 2 3)
+              collect x)))
 
-(test loop-for-x-on-l
-  (assert-equal
-    '((1 2 3) (2 3) (3))
-    (loop for x on '(1 2 3)
-          collect x)))
 
+    (test loop-for-downfrom
+      (assert-equal
+        '(3 2 1)
+        (loop for x to 1 downfrom 3
+              collect x)))
 
-(test loop-for-across
-  (assert-equal
-    '(1 2 3)
-    (loop for x across #(1 2 3)
-          collect x)))
 
+    (test loop-for-to
+      (assert-equal
+        '(0 1 2 3)
+        (loop for x to 3
+              collect x)))
 
-(test loop-for-downfrom
-  (assert-equal
-    '(3 2 1)
-    (loop for x to 1 downfrom 3
-          collect x)))
 
+    (test loop-for-downto
+      (assert-equal
+        '(3 2 1)
+        (loop for x downto 1 from 3
+              collect x)))
 
-(test loop-for-to
-  (assert-equal
-    '(0 1 2 3)
-    (loop for x to 3
-          collect x)))
 
+    (test loop-for-below
+      (assert-equal
+        '(0 1 2)
+        (loop for x below 3
+              collect x)))
 
-(test loop-for-downto
-  (assert-equal
-    '(3 2 1)
-    (loop for x downto 1 from 3
-          collect x)))
 
+    (test loop-for-above
+      (assert-equal
+        '(3 2 1)
+        (loop for x above 0 from 3
+              collect x)))
 
-(test loop-for-below
-  (assert-equal
-    '(0 1 2)
-    (loop for x below 3
-          collect x)))
 
+    (test loop-for-by
+      (assert-equal
+        '(0 2 4)
+        (loop for x by 2 to 4
+              collect x)))
 
-(test loop-for-above
-  (assert-equal
-    '(3 2 1)
-    (loop for x above 0 from 3
-          collect x)))
 
+    (test loop-append
+      (assert-equal
+        '(1 2 3 4)
+        (loop for x in '((1 2) (3 4))
+              append x)))
 
-(test loop-for-by
-  (assert-equal
-    '(0 2 4)
-    (loop for x by 2 to 4
-          collect x)))
 
+    (test loop-count
+      (assert-equal
+        50
+        (loop for x from 1 to 100
+              count (even? x))))
 
-(test loop-append
-  (assert-equal
-    '(1 2 3 4)
-    (loop for x in '((1 2) (3 4))
-          append x)))
 
+    (test loop-sum
+      (assert-equal
+        15
+        (loop for x from 1 to 5
+              sum x)))
 
-(test loop-count
-  (assert-equal
-    50
-    (loop for x from 1 to 100
-          count (even? x))))
 
+    (test loop-maximize
+      (assert-equal
+        10
+        (loop for x in '(3 10 1 4)
+              maximize x)))
 
-(test loop-sum
-  (assert-equal
-    15
-    (loop for x from 1 to 5
-          sum x)))
 
+    (test loop-maximize-none
+      (assert-equal
+        0
+        (loop for x in '()
+              maximize x)))
 
-(test loop-maximize
-  (assert-equal
-    10
-    (loop for x in '(3 10 1 4)
-          maximize x)))
 
+    (test loop-minimize
+      (assert-equal
+        1
+        (loop for x in '(3 10 1 4)
+              minimize x)))
 
-(test loop-maximize-none
-  (assert-equal
-    0
-    (loop for x in '()
-          maximize x)))
 
+    (test loop-minimize-none
+      (assert-equal
+        0
+        (loop for x in '()
+              minimize x)))
 
-(test loop-minimize
-  (assert-equal
-    1
-    (loop for x in '(3 10 1 4)
-          minimize x)))
 
+    (test loop-if
+      (assert-equal
+        5
+        (loop for x from 0
+              if (>= x 5) return x)))
 
-(test loop-minimize-none
-  (assert-equal
-    0
-    (loop for x in '()
-          minimize x)))
 
+    (test loop-when
+      (assert-equal
+        5
+        (loop for x from 0
+              when (>= x 5) return x)))
 
-(test loop-if
-  (assert-equal
-    5
-    (loop for x from 0
-          if (>= x 5) return x)))
 
+    (test loop-else
+      (assert-equal
+        '((0 2 4) . (1 3 5))
+        (loop for x to 5
+              if (even? x) collect x into evens
+              else collect x into odds
+              finally (return (cons evens odds)))))
 
-(test loop-when
-  (assert-equal
-    5
-    (loop for x from 0
-          when (>= x 5) return x)))
 
+    (test loop-if-compound
+      (assert-equal
+        '((0 2 4) . (1 3 5))
+        (loop for x to 5
+              if (even? x) collect x into list1
+              and collect (+ 1 x) into list2
+              finally (return (cons list1 list2)))))
 
-(test loop-else
-  (assert-equal
-    '((0 2 4) . (1 3 5))
-    (loop for x to 5
-          if (even? x) collect x into evens
-          else collect x into odds
-          finally (return (cons evens odds)))))
 
+    (test loop-if-end
+      (assert-equal
+        5
+        (loop for x from 0
+              if (>= x 5) return x end)))
 
-(test loop-if-compound
-  (assert-equal
-    '((0 2 4) . (1 3 5))
-    (loop for x to 5
-          if (even? x) collect x into list1
-          and collect (+ 1 x) into list2
-          finally (return (cons list1 list2)))))
 
+    (test loop-if-collect-and
+      (assert-equal
+        '(1 2 3 4 5 6 7 8 9 10)
+         (loop for i from 1 to 10
+               if (odd? i)
+                 collect i
+                 and collect (+ 1 i))))
 
-(test loop-if-end
-  (assert-equal
-    5
-    (loop for x from 0
-          if (>= x 5) return x end)))
 
-
-(test loop-if-collect-and
-  (assert-equal
-    '(1 2 3 4 5 6 7 8 9 10)
-     (loop for i from 1 to 10
-           if (odd? i)
-             collect i
-             and collect (+ 1 i))))
-
-
-(test loop-collect-advanced
-  (assert-equal
-    '(fred bob ken sue alice joe kris sunshine june)
-    (loop for name in '(fred sue alice joe june)
-          for kids in '((bob ken) () () (kris sunshine) ())
-          collect name
-          append kids)))
+    (test loop-collect-advanced
+      (assert-equal
+        '(fred bob ken sue alice joe kris sunshine june)
+        (loop for name in '(fred sue alice joe june)
+              for kids in '((bob ken) () () (kris sunshine) ())
+              collect name
+              append kids)))))
-- 
cgit v1.3.1