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/linker-test.csc | 128 ++++++++++++++++++++++++++--------------------------
 1 file changed, 65 insertions(+), 63 deletions(-)

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

diff --git a/csc/linker-test.csc b/csc/linker-test.csc
index d3481a9..70e5e31 100644
--- a/csc/linker-test.csc
+++ b/csc/linker-test.csc
@@ -1,71 +1,73 @@
-(import (scheme base)
-        (only (csc format)
-          sprintf)
-        (only (csc hash-map)
-          alist->map
-          hash-bytevector
-          make-comparer
-          make-map)
-        (only (csc list)
-          all)
-        (only (csc testing)
-          assert-equal
-          test)
-        (csc linker))
+(define-library (csc linker-test)
+  (import (scheme base)
+          (only (csc format)
+            sprintf)
+          (only (csc hash-map)
+            alist->map
+            hash-bytevector
+            make-comparer
+            make-map)
+          (only (csc list)
+            all)
+          (only (csc testing)
+            assert-equal
+            test)
+          (csc linker))
+  (begin
 
 
-(define compare-globals
-  (make-comparer
-    (lambda (x)
-      (hash-bytevector (string->utf8 (sprintf "{}" x))))
-    (lambda (x y)
-      (cond
-        ((equal? x y) 0)
-        ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1)
-        (else 1)))))
+    (define compare-globals
+      (make-comparer
+        (lambda (x)
+          (hash-bytevector (string->utf8 (sprintf "{}" x))))
+        (lambda (x y)
+          (cond
+            ((equal? x y) 0)
+            ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1)
+            (else 1)))))
 
 
-(test link-labels
-  (assert-equal
-    '((jmp (const 3))
-      (jmp (const 2))
-      (jmp (const 1))
-      (jmp (const 1)))
-    (link
-      '(((label 0)
-         (jmp (label 1))
-         (label 1)
-         (jmp (label 0))
-         (label init)
-         (jmp (label 0))))
-      (make-map compare-globals))))
+    (test link-labels
+      (assert-equal
+        '((jmp (const 3))
+          (jmp (const 2))
+          (jmp (const 1))
+          (jmp (const 1)))
+        (link
+          '(((label 0)
+             (jmp (label 1))
+             (label 1)
+             (jmp (label 0))
+             (label init)
+             (jmp (label 0))))
+          (make-map compare-globals))))
 
 
-(test link-labels-are-unique-per-program
-  (assert-equal
-    '((jmp (const 2))
-      (jmp (const 1))
-      (jmp (const 1))
-      (jmp (const 5))
-      (jmp (const 4))
-      (jmp (const 4)))
-    (link
-      '(((label 0)
-         (jmp (label 0))
-         (label init)
-         (jmp (label 0)))
-        ((label 0)
-         (jmp (label 0))
-         (label init)
-         (jmp (label 0))))
-      (make-map compare-globals))))
+    (test link-labels-are-unique-per-program
+      (assert-equal
+        '((jmp (const 2))
+          (jmp (const 1))
+          (jmp (const 1))
+          (jmp (const 5))
+          (jmp (const 4))
+          (jmp (const 4)))
+        (link
+          '(((label 0)
+             (jmp (label 0))
+             (label init)
+             (jmp (label 0)))
+            ((label 0)
+             (jmp (label 0))
+             (label init)
+             (jmp (label 0))))
+          (make-map compare-globals))))
 
 
-(test link-globals
-  (assert-equal
-    '((jmp (const 1))
-      (peek (local 0) (const 10)))
-    (link
-      '(((label init)
-         (peek (local 0) (global cons (csc based)))))
-      (alist->map compare-globals '(((global cons (csc based)) . 10))))))
+    (test link-globals
+      (assert-equal
+        '((jmp (const 1))
+          (peek (local 0) (const 10)))
+        (link
+          '(((label init)
+             (peek (local 0) (global cons (csc based)))))
+          (alist->map compare-globals '(((global cons (csc based)) . 10))))))))
-- 
cgit v1.3.1