andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

test: module. WIP 

* mes/module/mes/misc.mes: Remove.
* tests/guile.test: Do not use it.
* tests/module.test: New file.
* build-aux/check-mes.sh (TESTS): Add it.
* mes/module/srfi/srfi-26.mes: Remove.
* mes/module/ice-9/rdelim.mes: New file.
* module/mes/mes-0.mes: New file.
This commit is contained in:
Jan Nieuwenhuizen 2019-11-17 15:07:56 +01:00 committed by Jan (janneke) Nieuwenhuizen
parent 5e4c085c63
commit b4f28d729b
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
8 changed files with 83 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
build-aux/check-mes.sh
View File

@ -38,16 +38,17 @@ tests/display.test
tests/cwv.test
tests/math.test
tests/vector.test
tests/fluids.test
tests/guile.test
tests/module.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

1
mes/module/ice-9/rdelim.mes Normal file
View File

@ -0,0 +1 @@
(define-module (ice-9 rdelim))

22
mes/module/mes/guile/module.mes
View File

@ -132,7 +132,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)
@ -486,14 +486,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))
@ -1779,7 +1779,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))))
@ -2001,6 +2001,8 @@
(force-output cep)
(throw 'abort key)))
;; FIXME: how does Guile exit 0?
(define core:exit exit)
(define (quit . args)
(apply throw 'quit args))
@ -2292,7 +2294,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)
m))

21
mes/module/mes/misc.mes
View File

@ -1,21 +0,0 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; 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/>.
(include-from-path "mes/misc.scm")

25
mes/module/srfi/srfi-26.mes → module/mes/mes-0.mes
View File

@ -1,9 +1,9 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;; 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
@ -20,9 +20,20 @@
;;; Commentary:
;;; srfi-26.mes - cut, cute
;;; mes-0.scm is the first file being loaded into Guile. It provides
;;; non-standard definitions that Mes modules and tests depend on.
(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 (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)

82
module/mes/misc.scm
View File

@ -17,54 +17,56 @@
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(define-module (mes misc)
#:use-module (srfi srfi-1)
#:export (%scheme
disjoin
guile?
mes?
pk
pke
warn
stderr
string-substitute))
;;#:use-module (srfi srfi-1)
#:export (
;; %scheme
;; disjoin
;; guile?
;; mes?
;; pk
;; pke
;; warn
;; stderr
string-substitute
))
(cond-expand
(mes
(define %scheme "mes"))
(guile
(define %scheme "guile")))
;; (cond-expand
;; (mes
;; (define %scheme "mes"))
;; (guile
;; (define %scheme "guile")))
(define guile? (equal? %scheme "guile"))
(define mes? (equal? %scheme "mes"))
;; (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 (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 (stderr string . rest)
;; (apply logf (cons* (current-error-port) string rest)))
(define (pk . stuff)
(newline)
(display ";;; ")
(write stuff)
(newline)
(car (last-pair stuff)))
;; (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 (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 warn pke)
(define (disjoin . predicates)
(lambda (. arguments)
(any (lambda (o) (apply o arguments)) predicates)))
;; (define (disjoin . predicates)
;; (lambda (. arguments)
;; (any (lambda (o) (apply o arguments)) predicates)))
(define (string-substitute string find replace)
(let ((index (string-contains string find)))

1
tests/guile.test
View File

@ -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))

11
tests/module.test
View File

@ -1,12 +1,16 @@
#! /bin/sh
# -*-scheme-*-
GUILE_LOAD_PATH=mes/module:module
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 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
@ -24,11 +28,10 @@ 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 (mes mes-0)
;; #:use-module (mes misc)
#:use-module (mes test))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)