From d71c8407baec494ba5c132a50ef0b43011e5f6e7 Mon Sep 17 00:00:00 2001
From: Vasilij Schneidermann <mail@vasilij.de>
Date: Mon, 15 Jun 2020 22:59:37 +0200
Subject: [PATCH] Omit C4-only module check, add cond-expand tests
---
r7rs/1.0.1/r7rs-compile-time.scm | 8 ++++--
r7rs/1.0.1/tests/run.scm | 47 ++++++++++++++++++++++++++++++++
2 files changed, 53 insertions(+), 2 deletions(-)
diff --git a/r7rs/1.0.1/r7rs-compile-time.scm b/r7rs/1.0.1/r7rs-compile-time.scm
index 4bc2fe3..2d90dec 100644
a
|
b
|
|
11 | 11 | (let* ((name2 (parse-library-name name loc)) |
12 | 12 | (sname2 (symbol->string name2))) |
13 | 13 | (or (##sys#find-module name2 #f) |
14 | | (memq name2 ##sys#core-library-modules) |
15 | | (memq name2 ##sys#core-syntax-modules) |
| 14 | (cond-expand |
| 15 | (chicken-4 |
| 16 | (or |
| 17 | (memq name2 ##sys#core-library-modules) |
| 18 | (memq name2 ##sys#core-syntax-modules))) |
| 19 | (else #f)) |
16 | 20 | (file-exists? (string-append sname2 ".import.so")) |
17 | 21 | (file-exists? (string-append sname2 ".import.scm"))))) |
18 | 22 | |
diff --git a/r7rs/1.0.1/tests/run.scm b/r7rs/1.0.1/tests/run.scm
index b40f3a3..87d8b53 100644
a
|
b
|
|
52 | 52 | (with-output-to-string |
53 | 53 | (lambda () (include-ci "include-ci.scm")))))) |
54 | 54 | |
| 55 | (test-group "4.2.1: Conditionals" |
| 56 | (test-group "cond-expand" |
| 57 | (test "(scheme base)" |
| 58 | 'scheme-base |
| 59 | (cond-expand |
| 60 | ((library (scheme base)) 'scheme-base) |
| 61 | (else #f))) |
| 62 | (test "(chicken base)" |
| 63 | 'chicken-base |
| 64 | (cond-expand |
| 65 | ((library (chicken base)) 'chicken-base) |
| 66 | (else #f))) |
| 67 | (test "chicken.base" |
| 68 | 'chicken.base |
| 69 | (cond-expand |
| 70 | ((library chicken.base) 'chicken.base) |
| 71 | (else #f))) |
| 72 | (test "(r7rs)" |
| 73 | 'r7rs |
| 74 | (cond-expand |
| 75 | ((library (r7rs)) 'r7rs) |
| 76 | (else #f))) |
| 77 | (test "r7rs" |
| 78 | 'r7rs |
| 79 | (cond-expand |
| 80 | ((library r7rs) 'r7rs) |
| 81 | (else #f))) |
| 82 | (test "(srfi 1)" |
| 83 | 'srfi-1 |
| 84 | (let () |
| 85 | (import (srfi 1)) |
| 86 | (cond-expand |
| 87 | ((library (srfi 1)) 'srfi-1) |
| 88 | (else #f)))) |
| 89 | (test "srfi-1" |
| 90 | 'srfi-1 |
| 91 | (let () |
| 92 | (import srfi-1) |
| 93 | (cond-expand |
| 94 | ((library srfi-1) 'srfi-1) |
| 95 | (else #f)))) |
| 96 | (test "(bogus identifier)" |
| 97 | #f |
| 98 | (cond-expand |
| 99 | ((library (bogus identifier)) 'bogus-identifier) |
| 100 | (else #f))))) |
| 101 | |
55 | 102 | #+full-numeric-tower |
56 | 103 | (test-group "6.2.6: numerical operations" |
57 | 104 | (test-group "floor/...truncate-remainder" |