From a99115e11d1231c9f4e1d003797e5d9046906997 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 17 Nov 2019 15:07:56 +0100 Subject: [PATCH] test: Resurrect tests with module support. * mes/module/mes/misc.mes: Remove. * mes/module/srfi/srfi-26.mes: Remove. * module/mes/misc.scm (logf, stderr, pk, pke): Remove. (mes?, guile?, guile-1.8?, guile-2?): Move to... * module/mes/mes-0.mes: ...new file. * module/mes/mes-0.scm (%program, pmatch-car, pmatch-cdr): New variables. * tests/guile.test: Remove (mes misc) use. * tests/pmatch.test: Use (mes guile). * tests/data/bar.scm, tests/data/foo.scm,: New files. * tests/module.test: Use them to test basic Guile module support. * build-aux/check-mes.sh (TESTS): Move it up, also fluids.test, guile.test. * mes/module/srfi/srfi-26.mes: Remove. * mes/module/ice-9/rdelim.mes: New file. * tests/scm.test ("builtin? car", "builtin? car", "builtin? cdr", "builtin? cons", "builtin? cdr", "builtin? eq?", "builtin? eval"): Remove. --- build-aux/check-mes.sh | 5 +- mes/module/ice-9/rdelim.mes | 1 + mes/module/mes/boot-6.mes | 20 +++---- module/mes/guile.scm | 4 +- module/mes/mes-0.mes | 39 ++++++++++++++ module/mes/mes-0.scm | 9 +++- module/mes/misc.scm | 53 +++---------------- mes/module/mes/misc.mes => tests/data/bar.scm | 15 ++++-- .../srfi/srfi-26.mes => tests/data/foo.scm | 16 +++--- tests/guile.test | 1 - tests/module.test | 26 +++++++-- tests/pmatch.test | 1 + tests/scm.test | 8 --- tests/vector.test | 4 +- 14 files changed, 113 insertions(+), 89 deletions(-) create mode 100644 mes/module/ice-9/rdelim.mes create mode 100644 module/mes/mes-0.mes rename mes/module/mes/misc.mes => tests/data/bar.scm (78%) rename mes/module/srfi/srfi-26.mes => tests/data/foo.scm (76%) diff --git a/build-aux/check-mes.sh b/build-aux/check-mes.sh index 7b0c08fa..5008ed41 100755 --- a/build-aux/check-mes.sh +++ b/build-aux/check-mes.sh @@ -34,20 +34,21 @@ tests/quasiquote.test tests/let.test tests/closure.test tests/scm.test +tests/module.test +tests/guile.test tests/display.test tests/cwv.test tests/math.test tests/vector.test +tests/fluids.test tests/srfi-1.test tests/srfi-9.test tests/srfi-13.test tests/srfi-14.test tests/srfi-43.test tests/optargs.test -tests/fluids.test tests/catch.test tests/getopt-long.test -tests/guile.test tests/syntax.test tests/let-syntax.test tests/pmatch.test diff --git a/mes/module/ice-9/rdelim.mes b/mes/module/ice-9/rdelim.mes new file mode 100644 index 00000000..f1a3a735 --- /dev/null +++ b/mes/module/ice-9/rdelim.mes @@ -0,0 +1 @@ +(define-module (ice-9 rdelim)) diff --git a/mes/module/mes/boot-6.mes b/mes/module/mes/boot-6.mes index 391e6968..4e6795ca 100644 --- a/mes/module/mes/boot-6.mes +++ b/mes/module/mes/boot-6.mes @@ -88,7 +88,7 @@ (define (set-current-module m) (when (> %debug 2) - (format (current-error-port) "set-current-module: name=~a" (module-name m))) + (format (current-error-port) "set-current-module: name=~a\n" (module-name m))) (let ((o (guile:current-module))) (guile:current-module m) (set! *current-module* m) @@ -474,14 +474,14 @@ (set-port-revealed! port (+ (port-revealed port) 1)) (fileno port)) -(define (setenv name value) - (if value - (putenv (string-append name "=" value)) - (putenv name))) +;; (define (setenv name value) +;; (if value +;; (putenv (string-append name "=" value)) +;; (putenv name))) -(define (unsetenv name) - "Remove the entry for NAME from the environment." - (putenv name)) +;; (define (unsetenv name) +;; "Remove the entry for NAME from the environment." +;; (putenv name)) @@ -1736,7 +1736,7 @@ ((%search-load-path file) => (lambda (full) (with-fluids ((current-reader #f)) - (load-file 'primitive-load full))))))) + (load-file 'primitive-load full))))))) (lambda () (set-autoloaded! dir-hint name didit))) didit)))) @@ -2261,7 +2261,7 @@ `(let ((m (process-define-module (list ,@(compile-define-module-args args))))) (when (> %debug 3) - (format (current-error-port) "define-module: name=~s" m)) + (format (current-error-port) "define-module: name=~s\n" m)) (set-current-module m) ;; XXX For Mes -- how/where does Guile define this 'module-procedure? ,(let ((module (and (pair? args) (car args)))) diff --git a/module/mes/guile.scm b/module/mes/guile.scm index 242561f9..e0edbdaf 100644 --- a/module/mes/guile.scm +++ b/module/mes/guile.scm @@ -47,6 +47,7 @@ core:write-port core:type %compiler + %program equal2? keyword->string pmatch-car @@ -93,8 +94,7 @@ (define 15) (define %arch (car (string-split %host-type #\-))) (define %compiler "gnuc") - - (define %compiler "gnuc") + (define %program "the program text") (define keyword->string (compose symbol->string keyword->symbol)) (define (core:type x) diff --git a/module/mes/mes-0.mes b/module/mes/mes-0.mes new file mode 100644 index 00000000..b248aa87 --- /dev/null +++ b/module/mes/mes-0.mes @@ -0,0 +1,39 @@ +;;; -*-scheme-*- + +;;; GNU Mes --- Maxwell Equations of Software +;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen +;;; +;;; mes-0.scm: This file is part of GNU Mes. +;;; +;;; GNU Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Mes. If not, see . + +;;; Commentary: + +;;; mes-0.scm is the first file being loaded into Guile. It provides +;;; non-standard definitions that Mes modules and tests depend on. + +;;; Code: + +(define-module (mes mes-0) + #:export ( + mes? + guile? + guile-1.8? + guile-2? + )) + +(define mes? #t) +(define guile? #f) +(define guile-1.8? #f) +(define guile-2? #f) diff --git a/module/mes/mes-0.scm b/module/mes/mes-0.scm index 88f0b66f..de677ba2 100644 --- a/module/mes/mes-0.scm +++ b/module/mes/mes-0.scm @@ -29,7 +29,6 @@ #:export ( builtin? mes-use-module - EOF append2 mes? guile? @@ -37,7 +36,11 @@ guile-2? %arch %compiler + %program + pmatch-car + pmatch-cdr )) + (cond-expand (guile-2) (guile @@ -50,7 +53,9 @@ (define guile? #t) (define guile-1.8? (equal? (effective-version) "1.8")) (define guile-2? (equal? (major-version) "2")) -(define EOF (if #f #f)) (define append2 append) (define %arch (car (string-split %host-type #\-))) (define %compiler "gnuc") +(define %program "the program text") +(define pmatch-car car) +(define pmatch-cdr cdr) diff --git a/module/mes/misc.scm b/module/mes/misc.scm index 386476de..8fc5d21c 100644 --- a/module/mes/misc.scm +++ b/module/mes/misc.scm @@ -1,5 +1,5 @@ ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -18,54 +18,9 @@ (define-module (mes misc) #:use-module (srfi srfi-1) - #:export (%scheme - disjoin - guile? - mes? - pk - pke - warn - stderr + #:export (disjoin string-substitute)) -(cond-expand - (mes - (define %scheme "mes")) - (guile - (define %scheme "guile"))) - -(define guile? (equal? %scheme "guile")) -(define mes? (equal? %scheme "mes")) - -(define (logf port string . rest) - (apply format (cons* port string rest)) - (force-output port) - #t) - -(define (stderr string . rest) - (apply logf (cons* (current-error-port) string rest))) - -(define (pk . stuff) - (newline) - (display ";;; ") - (write stuff) - (newline) - (car (last-pair stuff))) - -(define (pke . stuff) - (display "\n" (current-error-port)) - (newline (current-error-port)) - (display ";;; " (current-error-port)) - (write stuff (current-error-port)) - (display "\n" (current-error-port)) - (car (last-pair stuff))) - -(define warn pke) - -(define (disjoin . predicates) - (lambda (. arguments) - (any (lambda (o) (apply o arguments)) predicates))) - (define (string-substitute string find replace) (let ((index (string-contains string find))) (if (not index) string @@ -75,3 +30,7 @@ (string-substitute (string-drop string (+ index (string-length find))) find replace))))) + +(define (disjoin . predicates) + (lambda (. arguments) + (any (lambda (o) (apply o arguments)) predicates))) diff --git a/mes/module/mes/misc.mes b/tests/data/bar.scm similarity index 78% rename from mes/module/mes/misc.mes rename to tests/data/bar.scm index b1749f5c..37fff7ab 100644 --- a/mes/module/mes/misc.mes +++ b/tests/data/bar.scm @@ -1,7 +1,5 @@ -;;; -*-scheme-*- - ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -18,4 +16,13 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Mes. If not, see . -(include-from-path "mes/misc.scm") +;;; Commentary: + +;;; bar.scm is used by tests/boot-6.test + +;;; Code: + +(define-module (data bar) + #:export (bar)) + +(define bar "bar") diff --git a/mes/module/srfi/srfi-26.mes b/tests/data/foo.scm similarity index 76% rename from mes/module/srfi/srfi-26.mes rename to tests/data/foo.scm index 69fd5e5e..f6fc23ef 100644 --- a/mes/module/srfi/srfi-26.mes +++ b/tests/data/foo.scm @@ -1,7 +1,5 @@ -;;; -*-scheme-*- - ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -20,9 +18,11 @@ ;;; Commentary: -;;; srfi-26.mes - cut, cute +;;; foo.scm is used by tests/boot-6.test -(mes-use-module (mes scm)) -(mes-use-module (mes guile)) -(mes-use-module (srfi srfi-1)) -(include-from-path "srfi/srfi-26.scm") +;;; Code: + +(define-module (data foo) + #:export (foo)) + +(define foo "foo") diff --git a/tests/guile.test b/tests/guile.test index f4e422b0..5804ee2f 100755 --- a/tests/guile.test +++ b/tests/guile.test @@ -32,7 +32,6 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests (cond-expand (mes (mes-use-module (mes test)) - (mes-use-module (mes misc)) (mes-use-module (mes guile))) (else)) diff --git a/tests/module.test b/tests/module.test index 09904f2c..1cde5465 100755 --- a/tests/module.test +++ b/tests/module.test @@ -1,12 +1,17 @@ #! /bin/sh # -*-scheme-*- +srcdir=${srcdir-.} +GUILE_LOAD_PATH=$srcdir/tests +export GUILE_LOAD_PATH +MES_BOOT=boot-5.mes +export MES_BOOT exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests module)' -s "$0" "$@" !# ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -24,12 +29,25 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests ;;; along with GNU Mes. If not, see . (define-module (tests module) - #:use-module (mes mes-0) + #:use-module (data foo) + #:use-module (data bar) #:use-module (mes test)) -(mes-use-module (mes test)) - (pass-if "first dummy" #t) (pass-if-not "second dummy" #f) +(pass-if "defined foo" + (defined? 'foo)) + +(pass-if-equal "foo" + "foo" + (and (defined? 'foo) foo)) + +(pass-if "defined bar" + (defined? 'bar)) + +(pass-if-equal "bar" + "bar" + (and (defined? 'bar) bar)) + (result 'report) diff --git a/tests/pmatch.test b/tests/pmatch.test index 504c5c6e..3f76f119 100755 --- a/tests/pmatch.test +++ b/tests/pmatch.test @@ -26,6 +26,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests (define-module (tests pmatch) #:use-module (system base pmatch) #:use-module (mes mes-0) + #:use-module (mes guile) #:use-module (mes test)) (cond-expand diff --git a/tests/scm.test b/tests/scm.test index 08a6c591..1ce8bdc0 100755 --- a/tests/scm.test +++ b/tests/scm.test @@ -99,14 +99,6 @@ exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot (pass-if-equal "assoc-set!" '((a . 0) (b . 2)) (assoc-set! '((a . 0) (b . 1)) 'b 2)) (pass-if-equal "assoc-set! new" '((b . 2) (a . 0)) (assoc-set! '((a . 0)) 'b 2)) -(pass-if "builtin? car" (builtin? car)) -(pass-if "builtin? cdr" (builtin? cdr)) -(pass-if "builtin? cons" (builtin? cons)) -(pass-if "builtin? eq?" (builtin? eq?)) -(pass-if "builtin? if" (builtin? eq?)) -(when (not guile?) - (pass-if "builtin? eval" (not (builtin? not)))) -(pass-if "procedure?" (procedure? builtin?)) (pass-if "procedure?" (procedure? procedure?)) (pass-if "gensym" (symbol? (gensym))) diff --git a/tests/vector.test b/tests/vector.test index 0bf8c185..4f51489d 100755 --- a/tests/vector.test +++ b/tests/vector.test @@ -39,7 +39,9 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests (pass-if "vector?" (vector? #(1 2 c))) (pass-if "vector-length" (seq? (vector-length #(1)) 1)) -(pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))) +(pass-if-equal "make-vector" + (list->vector (list *unspecified* *unspecified* *unspecified*)) + (make-vector 3)) (pass-if "make-vector 1" (sequal? (make-vector 3 0) #(0 0 0))) (pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1))