From f1447abeb300ea194b05133a3282374846f5e848 Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Mon, 25 Apr 2022 10:30:25 -0600 Subject: [PATCH] tests: Fix tests to run on Guile. * scaffold/boot/17-open-input-string.scm: Test 'current-module' to see if we can lookup 'read-string' in a module. * scaffold/boot/gc.scm: Skip all tests on Guile. * tests/gc.test: Rename 'mes?' to 'mes-core?'; use 'current-module' to check if we need to use core Mes procedures; and adjust all tests accordingly. * tests/scm.test (iota -1): Skip on Guile. * tests/vector.test (make-vector): Adjust for Guile. --- scaffold/boot/17-open-input-string.scm | 2 +- scaffold/boot/gc.scm | 4 ++++ tests/gc.test | 10 +++++----- tests/scm.test | 5 +++-- tests/vector.test | 5 ++++- 5 files changed, 17 insertions(+), 9 deletions(-) diff --git a/scaffold/boot/17-open-input-string.scm b/scaffold/boot/17-open-input-string.scm index 7d437109..83f10502 100644 --- a/scaffold/boot/17-open-input-string.scm +++ b/scaffold/boot/17-open-input-string.scm @@ -32,5 +32,5 @@ (core:write-error port) (core:display-error "\n") (exit (if (equal2? string "foo bar\n") 0 1))) - ((if (pair? (current-environment)) read-string (@ (ice-9 rdelim) read-string)) port))) + ((if (current-module) (@ (ice-9 rdelim) read-string) read-string) port))) (open-input-string "foo bar\n")) diff --git a/scaffold/boot/gc.scm b/scaffold/boot/gc.scm index 24389ea5..7a601447 100644 --- a/scaffold/boot/gc.scm +++ b/scaffold/boot/gc.scm @@ -16,6 +16,10 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Mes. If not, see . +;; Do not run this test on Guile or if modules are booted. +(if (current-module) + (exit 0)) + (core:display "program:") (core:write %program) (core:display "\n") diff --git a/tests/gc.test b/tests/gc.test index 7276095e..fa516b51 100755 --- a/tests/gc.test +++ b/tests/gc.test @@ -28,13 +28,13 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -s "$0" "$@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Mes. If not, see . -(define mes? (pair? (current-environment))) +(define mes-core? (if (current-module) #f #t)) (gc) -((if mes? core:display display) (gc-stats)) -((if mes? core:display display) "\n") +((if mes-core? core:display display) (gc-stats)) +((if mes-core? core:display display) "\n") (define (loop n) (if (> n 0) (loop (- n 1)))) (loop 100000) (gc) -((if mes? core:display display) (gc-stats)) -((if mes? core:display display) "\n") +((if mes-core? core:display display) (gc-stats)) +((if mes-core? core:display display) "\n") diff --git a/tests/scm.test b/tests/scm.test index a19fcd16..a80c582e 100755 --- a/tests/scm.test +++ b/tests/scm.test @@ -130,8 +130,9 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests (pass-if-equal "iota 0" '() (iota 0)) -(pass-if-equal "iota -1" - '() (iota -1)) +(unless guile? + (pass-if-equal "iota -1" + '() (iota -1))) (pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes) (guile (display ": pass: *GUILE*") 'mes)) 'mes)) diff --git a/tests/vector.test b/tests/vector.test index 0bf8c185..b6313f79 100755 --- a/tests/vector.test +++ b/tests/vector.test @@ -39,7 +39,10 @@ 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 "make-vector" (sequal? (vector *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))