DRAFT 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.
This commit is contained in:
Jan Nieuwenhuizen
Jan (janneke) Nieuwenhuizen
parent
6c6c6a07b3
commit
222e7d2cef
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
(define-module (ice-9 rdelim))
|
||||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -47,6 +47,7 @@
|
|||
core:write-port
|
||||
core:type
|
||||
%compiler
|
||||
%program
|
||||
equal2?
|
||||
keyword->string
|
||||
pmatch-car
|
||||
|
|
@ -93,8 +94,7 @@
|
|||
(define <cell:vector> 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)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,39 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; 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)
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; 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)))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
(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")
|
||||
|
|
@ -1,7 +1,5 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; 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")
|
||||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <janneke@gnu.org>
|
||||
;;; Copyright © 2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue