test: Resurrect running boot tests on Guile.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 27 May 2019 20:57:44 +0000 (22:57 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 27 May 2019 20:57:44 +0000 (22:57 +0200)
* module/mes/guile.scm (keyword->string): New function.
* scaffold/boot/43-or.scm (foo): Add quoting.
* scaffold/boot/45-pass-if.scm (pass-if): Likewise.
* scaffold/boot/46-report.scm (pass-if): Likewise.
* scaffold/boot/47-pass-if-eq.scm (pass-if): Likewise.
* scaffold/boot/48-let.scm (map): Rename from map1.
* scaffold/boot/60-let-syntax-expanded.scm: Some work.

module/mes/guile.scm
scaffold/boot/43-or.scm
scaffold/boot/45-pass-if.scm
scaffold/boot/46-report.scm
scaffold/boot/47-pass-if-eq.scm
scaffold/boot/48-let.scm
scaffold/boot/51-module.scm
scaffold/boot/60-let-syntax-expanded.scm

index 451843b4aeff6ebd616b00bdbcfddb6a2410f469..26fc2cc7d0be1a7866383dc8c5b3c4191109c487 100644 (file)
@@ -47,6 +47,7 @@
             core:type
             %compiler
             equal2?
+            keyword->string
             pmatch-car
             pmatch-cdr
             )
@@ -85,6 +86,7 @@
   (define <cell:vector> 15)
 
   (define %compiler "gnuc")
+  (define keyword->string (compose symbol->string keyword->symbol))
 
   (define (core:type x)
     (cond ((guile:keyword? x) <cell:keyword>)
index bd8cb1d22b1c571dc1dfba9411e36875e8338266..1ad758ec4ce32ffc6e877d945824626361b511c8 100644 (file)
@@ -28,7 +28,7 @@
   (or #t a))
 
 (define-macro (foo bar)
-  (list f bar))
+  (list 'f bar))
 
 (foo 3)
 
index 1d8a30f51bb2851ed1b1f2ec4b1ea05227c753dd..31ccc7f2aab332450763e2aea81fcd83095bdd67 100644 (file)
@@ -26,6 +26,6 @@
   (list
    'begin
    (list core:display "test: ") (list core:display name)
-   (list result t)))
+   (list (quote result) t)))
 
 (pass-if "first dummy" #t)
index fa62ca0722495f30270d93c40c501b35f95408ab..2d262164d17ab9683f87d836ea7ff86ee9203151 100644 (file)
@@ -54,7 +54,7 @@
   (list
    'begin
    (list display "test: ") (list display name)
-   (list result t)))
+   (list (quote result) t)))
 
 (pass-if "first dummy" #t)
 
index 5c5807dc97daa5f1e28476aed489fed7c842af2a..c9e53dd642ca97fd94fd7e0587efc19419e0f804 100644 (file)
@@ -26,7 +26,7 @@
   (list
    'begin
    (list core:display "test: ") (list core:display name)
-   (list result t)))
+   (list (quote result) t)))
 
 (define-macro (pass-if-eq name expect . body)
   (list 'pass-if name (list eq? expect (cons 'begin body))))
index fecb2a39b1f376a72f5dd8af8f4a7e92b5779fd0..54b01ee1927c860a16ddfbdd8d93bfe050aaf3fa 100644 (file)
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(define (map1 f lst)
+(define (map f lst)
   (if (null? lst) (list)
-      (cons (f (car lst)) (map1 f (cdr lst)))))
+      (cons (f (car lst)) (map f (cdr lst)))))
 
 (define (cadr x) (car (cdr x)))
 
 (define-macro (let bindings . rest)
-  (cons (cons 'lambda (cons (map1 car bindings) rest))
-        (map1 cadr bindings)))
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
 
 (let ((x 0)) x)
 (let ((y 0)) y)
index 830401451e73bf8ce1b0b8d995825238a179b40c..7d3e30ae76fa233fb7efcf8f738621079e5f00b7 100644 (file)
@@ -17,8 +17,7 @@
 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 (cond-expand
- (guile
-  (set! %load-path (append %load-path '("mes/module"))))
+ (guile)
  (mes
   (define (cons* . rest)
     (if (null? (cdr rest)) (car rest)
index 52049287f44b55bd084ee6a19e2677fca3b0a185..cfb229fb72011c2d664b32fe568910541114bcee 100644 (file)
   (or (null? x)
       (and (pair? x) (list? (cdr x)))))
 
+(cond-expand
+ (guile)
+ (mes
+  (define (boolean? x)
+    (or (eq? x #f) (eq? x #t)))
+  (define (char? x)
+    (and (eq? (core:type x) <cell:char>)
+         (> (char->integer x) -1)))))
+
 ;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software