Changeset 38750 in project

Timestamp:

06/16/20 15:01:12 (4 weeks ago)

Author:

felix winkelmann

Message:

Omit C4-only module check, add cond-expand tests

(Patch provided by wasamasa)

Dropped some unnecessary compile-time conditionals.

Location:

release/5/r7rs

Files:

• tags/1.0.2 (copied) (copied from release/5/r7rs/trunk)
• tags/1.0.2/r7rs-compile-time.scm (modified) (1 diff)
• tags/1.0.2/tests/run.scm (modified) (1 diff)
• trunk/r7rs-compile-time.scm (modified) (1 diff)
• trunk/tests/run.scm (modified) (1 diff)

release/5/r7rs/tags/1.0.2/r7rs-compile-time.scm

@@ -12 +12 @@
          (sname2 (symbol->string name2)))
     (or (##sys#find-module name2 #f)
-        (memq name2 ##sys#core-library-modules)
-        (memq name2 ##sys#core-syntax-modules)
         (file-exists? (string-append sname2 ".import.so"))
         (file-exists? (string-append sname2 ".import.scm")))))

release/5/r7rs/tags/1.0.2/tests/run.scm

@@ -53 +53 @@
            (lambda () (include-ci "include-ci.scm"))))))
 
-#+full-numeric-tower
+(test-group "4.2.1: Conditionals"
+  (test-group "cond-expand"
+    (test "(scheme base)"
+          'scheme-base
+          (cond-expand
+           ((library (scheme base)) 'scheme-base)
+           (else #f)))
+    (test "(chicken base)"
+          'chicken-base
+          (cond-expand
+           ((library (chicken base)) 'chicken-base)
+           (else #f)))
+    (test "chicken.base"
+          'chicken.base
+          (cond-expand
+           ((library chicken.base) 'chicken.base)
+           (else #f)))
+    (test "(r7rs)"
+          'r7rs
+          (cond-expand
+           ((library (r7rs)) 'r7rs)
+           (else #f)))
+    (test "r7rs"
+          'r7rs
+          (cond-expand
+           ((library r7rs) 'r7rs)
+           (else #f)))
+    (test "(srfi 1)"
+          'srfi-1
+          (let ()
+            (import (srfi 1))
+            (cond-expand
+             ((library (srfi 1)) 'srfi-1)
+             (else #f))))
+    (test "srfi-1"
+          'srfi-1
+          (let ()
+            (import srfi-1)
+            (cond-expand
+             ((library srfi-1) 'srfi-1)
+             (else #f))))
+    (test "(bogus identifier)"
+          #f
+          (cond-expand
+           ((library (bogus identifier)) 'bogus-identifier)
+           (else #f)))))
+
 (test-group "6.2.6: numerical operations"
   (test-group "floor/...truncate-remainder"

release/5/r7rs/trunk/r7rs-compile-time.scm

@@ -12 +12 @@
          (sname2 (symbol->string name2)))
     (or (##sys#find-module name2 #f)
-        (memq name2 ##sys#core-library-modules)
-        (memq name2 ##sys#core-syntax-modules)
         (file-exists? (string-append sname2 ".import.so"))
         (file-exists? (string-append sname2 ".import.scm")))))

release/5/r7rs/trunk/tests/run.scm

@@ -53 +53 @@
            (lambda () (include-ci "include-ci.scm"))))))
 
-#+full-numeric-tower
+(test-group "4.2.1: Conditionals"
+  (test-group "cond-expand"
+    (test "(scheme base)"
+          'scheme-base
+          (cond-expand
+           ((library (scheme base)) 'scheme-base)
+           (else #f)))
+    (test "(chicken base)"
+          'chicken-base
+          (cond-expand
+           ((library (chicken base)) 'chicken-base)
+           (else #f)))
+    (test "chicken.base"
+          'chicken.base
+          (cond-expand
+           ((library chicken.base) 'chicken.base)
+           (else #f)))
+    (test "(r7rs)"
+          'r7rs
+          (cond-expand
+           ((library (r7rs)) 'r7rs)
+           (else #f)))
+    (test "r7rs"
+          'r7rs
+          (cond-expand
+           ((library r7rs) 'r7rs)
+           (else #f)))
+    (test "(srfi 1)"
+          'srfi-1
+          (let ()
+            (import (srfi 1))
+            (cond-expand
+             ((library (srfi 1)) 'srfi-1)
+             (else #f))))
+    (test "srfi-1"
+          'srfi-1
+          (let ()
+            (import srfi-1)
+            (cond-expand
+             ((library srfi-1) 'srfi-1)
+             (else #f))))
+    (test "(bogus identifier)"
+          #f
+          (cond-expand
+           ((library (bogus identifier)) 'bogus-identifier)
+           (else #f)))))
+
 (test-group "6.2.6: numerical operations"
   (test-group "floor/...truncate-remainder"