diff --git a/build-aux/check-mes.sh b/build-aux/check-mes.sh index 7b0c08fa..6233ea72 100755 --- a/build-aux/check-mes.sh +++ b/build-aux/check-mes.sh @@ -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 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/guile/module.mes b/mes/module/mes/guile/module.mes index e0c73a03..da1087a1 100644 --- a/mes/module/mes/guile/module.mes +++ b/mes/module/mes/guile/module.mes @@ -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)) diff --git a/mes/module/mes/misc.mes b/mes/module/mes/misc.mes deleted file mode 100644 index b1749f5c..00000000 --- a/mes/module/mes/misc.mes +++ /dev/null @@ -1,21 +0,0 @@ -;;; -*-scheme-*- - -;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen -;;; -;;; 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 . - -(include-from-path "mes/misc.scm") diff --git a/mes/module/srfi/srfi-26.mes b/module/mes/mes-0.mes similarity index 60% rename from mes/module/srfi/srfi-26.mes rename to module/mes/mes-0.mes index 69fd5e5e..b248aa87 100644 --- a/mes/module/srfi/srfi-26.mes +++ b/module/mes/mes-0.mes @@ -1,9 +1,9 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen ;;; -;;; 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) diff --git a/module/mes/misc.scm b/module/mes/misc.scm index 386476de..8af2c89f 100644 --- a/module/mes/misc.scm +++ b/module/mes/misc.scm @@ -17,54 +17,56 @@ ;;; along with GNU Mes. If not, see . (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))) 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..e13f927e 100755 --- a/tests/module.test +++ b/tests/module.test @@ -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 +;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 . (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)