kylekrein/live-bootstrap
1
0
Fork 0
mirror of https://github.com/fosslinux/live-bootstrap.git synced 2026-03-13 23:05:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add mes and mescc-tools-extra

Browse source 
mescc-tools-extra contains two important tools:
- cp
- chmod

mes first builds itself from a mes 0.21 seed as used by guix, and then
builds a mes 0.22 and then mes 0.22 using that created mes 0.22.

It does /not/ use bootstrap.sh as we don't have a proper shell at this
point, it has been manually adapted for kaem.
This commit is contained in:
fosslinux 2020-12-25 18:40:14 +11:00
parent 2706e07556
commit 649d7b68dc
1029 changed files with 120985 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

145
sysa/mes-0.22/tests/base.test Executable file
View file

@ -0,0 +1,145 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
MES_BOOT=boot-03.scm exec ${MES-mes} < $0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests base)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "lambda" (symbol? 'lambda))
(pass-if-equal "append" '(0 1) (append2 '(0) '(1)))
(pass-if-equal "append 2" '(0) (append2 '(0) '()))
(pass-if-equal "append 3" '(0 1 2) (append '(0) '(1) '(2)))
(pass-if-equal "cond #f" #t (cond (#f #f) (#t #t)))
(pass-if "cond #t" (cond (#t)))
(pass-if "cond #f" (cond (#f #f) (#t #t)))
(pass-if-equal "cond 2" *unspecified* (cond (#f)))
(pass-if-equal "cond 3" 0 (cond (#t 0)))
(pass-if-equal "cond 3a" 0 (cond (#f 1) (#t 0)))
(pass-if-equal "cond side effect"
1
((lambda (i)
(cond ((set! i (+ i 1)) i)))
0))
(pass-if-equal "cond => "
0 ((lambda (lst)
(define (next)
((lambda (r)
(set! lst (cdr lst))
r)
(car lst)))
(cond ((next) => identity)))
'(0 1 2)))
(pass-if-equal "and" 1 (and 1))
(pass-if-not "and 2" (and 1 (= 0 1) #f))
(pass-if-not "or" (or))
(pass-if-equal "or 2" 1 (or 1))
(pass-if-equal "or 3" 3 (or #f (= 0 1) 3))
(pass-if "or 4" (or (= 0 0) (= 0 1)))
(pass-if "or 5" (or (= 0 1) (= 0 0)))
(pass-if-equal "or only once"
1
((lambda ()
(define read
((lambda (lst)
(lambda ()
((lambda (r)
(set! lst (cdr lst))
r)
(car lst))))
'(1 0)))
(or (read) #t))))
(pass-if-eq "let" 0 (let () 0))
(pass-if-eq "let 2" 0 (let ((x 0)) x))
(pass-if-eq "let 3" 11 (let ((p 5) (q 6)) (+ p q)))
(let () (define *top-let-define-a* '*top-let-define-a*) #t)
(pass-if-not "top let define " (defined? '*top-let-define-a*))
(pass-if "apply" (sequal? (apply list '(1)) '(1)))
(pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
(pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))
(begin
(define local-answer 41))
(pass-if-equal "begin 2" 41 (begin local-answer))
(pass-if-equal "primitive-load" 42 (primitive-load "tests/data/load.scm") the-answer)
(cond-expand
(mes
(pass-if-equal "include" 42 (include "tests/data/load.scm") the-answer))
(else))
(pass-if-eq "call/cc"
0
((lambda (cont seen?)
(+ 1 (call/cc (lambda (c) (set! cont c) 1)))
(if seen? 0
(begin (set! seen? #t)
(cont 2))))
#f #f))
(cond-expand
(mes
(pass-if-not "#<eof>"
(char? (integer->char -1))))
(else))
(pass-if-eq "reader: \\n"
#\newline
(car (string->list "\n")))
(pass-if-eq "reader: \\a"
#\alarm
(car (string->list "\a")))
(pass-if-eq "reader: \\x08"
#\backspace
(car (string->list "\x08")))
(pass-if-equal "setenv, getenv"
"bar"
(begin
(setenv "foo" "bar")
(getenv "bar")
(getenv "foo")))
(result 'report)

61
sysa/mes-0.22/tests/boot.test Executable file
View file

@ -0,0 +1,61 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
MES_BOOT=boot-02.scm exec ${MES-mes} < $0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$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/>.
(define-module (tests boot)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-eq "begin" 3 (begin 'a 'b (+ 1 2)))
(define *top-define-a* '*top-define-a*)
(begin (define *top-begin-define-a* '*top-begin-define-a*))
(pass-if-eq "top define " '*top-define-a* *top-define-a*)
(pass-if "eq?" (eq? 0 '0))
(pass-if-eq "if" 'true (if #t 'true))
(pass-if-eq "if 2" *unspecified* (if #f #f))
(pass-if-eq "if 3" 'true (if #t 'true))
(pass-if-eq "if 4" 'true (if (eq? 0 '0) 'true))
(pass-if-eq "if 5" 'false (if (= 1 2) 'true 'false))
(pass-if-eq "append2 1" '0 (append2 '() 0))
(pass-if-eq "append2 3" 0 (append 0))
(pass-if-eq "append2 4" 'cons (append2 (cdr '(c)) (car '(cons))))
(result 'report)

70
sysa/mes-0.22/tests/catch.test Executable file
View file

@ -0,0 +1,70 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests catch)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define-module (tests base)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes catch))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "catch"
789
(catch #t
(lambda ()
(throw 'test-exception "foo!")
#f)
(lambda (key . args)
789)))
(define (throw-22)
(throw 'twenty-two "hahah"))
(pass-if-equal "catch 22"
789
(catch #t
(lambda ()
(throw-22)
#f)
(lambda (key . args)
789)))
(pass-if-equal "catch feel"
1
(catch 'twenty-two
(lambda _
(catch 'boo
(lambda ()
(throw-22)
11)
(lambda (key . args)
(exit 1))))
(lambda (key . args)
1)))
(result 'report)

120
sysa/mes-0.22/tests/closure.test Executable file
View file

@ -0,0 +1,120 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests closure)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests closure)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define b 0)
(define x (lambda () b))
(define (x) b)
(pass-if-equal "closure" 0 (x))
(display "===>") (display (x)) (newline)
(define (c b)
(x))
(pass-if "closure 2" (seq? (c 1) 0))
(define (x)
(define b 1)
(define (y) b)
(set! b 0)
(list b
(let ((b 2))
(y))))
(pass-if "closure 3" (sequal? (x) '(0 0)))
(pass-if "closure 4 "
(seq? (let ()
(let ((count (let ((counter 0))
(lambda ()
counter))))
(count)))
0))
(pass-if "closure 5 "
(seq?
(let ()
(define name? 2)
(define (foo)
(define name? 0)
(lambda () name?))
((foo)))
0))
(pass-if "closure 6 "
(seq?
(let ()
(define foo
(lambda ()
(define name? symbol?)
(lambda ()
(name? 'boo))))
((foo)))
#t))
(define-macro (foo? q+q)
#t)
(foo? 'cons)
(pass-if-equal "closure 7" #f (defined? 'q+q))
(let ((x 0))
(pass-if-equal "closure 8" #f (not (defined? 'x))))
((lambda ()
(define sc-expand #f)
((lambda (g38)
(set! sc-expand
((lambda ()
(lambda ()
(list g38))))))
"noexpand")
(pass-if "closure 9" (sc-expand))))
(pass-if "closure is procedure"
(procedure? (lambda () #t)))
(pass-if-not "closure is not a pair"
(pair? (lambda () #t)))
(define shared
(let ((x 0))
(lambda () (set! x (+ 1 x)) x)))
(define-macro (share)
(list 'begin
(list 'shared)))
(pass-if-equal "shared variable macro access"
2
(begin
(share)
(shared)))
(result 'report)

80
sysa/mes-0.22/tests/cwv.test Executable file
View file

@ -0,0 +1,80 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests cwv)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define-module (tests cwv)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes scm))
(mes-use-module (mes test))
(if (not guile-1.8?)
(pass-if "values" (seq? (values 0 1) 0)))
(if (not guile-1.8?)
(pass-if "values 2" (seq? ((lambda (x) x) (values 1 2 3)) 1)))
(if (not guile-1.8?)
(pass-if "values 3" (seq? 1 ((lambda (x) x) (values 1 2 3)))))
(pass-if "call-with-values" (seq? (call-with-values (lambda () (values 1 2 3))
(lambda (a b c) (+ a b c)))
6))
(pass-if-equal "lambda"
'(1 2 3 4 5)
((lambda (x)
(x 1 2 3 4 5))
(lambda (one two three four five)
(list one two three four five))))
(pass-if-equal "values 5"
'(1 2 3 4 5)
(call-with-values
(lambda ()
(values 1 2 3 4 5))
(lambda (one two three four five)
(list one two three four five))))
(pass-if-equal "values rests"
1
(call-with-values
(lambda ()
(values 1 2 3 4 5))
(lambda (one . rest)
one)))
(pass-if-equal "values 4a 4b"
'(1 2 3 four-a 5)
((lambda (one two three four five)
(append
(list one two three)
(call-with-values
(lambda () four)
(lambda (4a . 4b)
;;(cons 4a 4b) FIXME: non-compliancy?
(list 4a)
))
(list five)))
1 2 3 (values 'four-a 'four-b) 5))
(result 'report)

21
sysa/mes-0.22/tests/data/load.scm Normal file
View file

@ -0,0 +1,21 @@
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define the-answer 42)

93
sysa/mes-0.22/tests/display.test Executable file
View file

@ -0,0 +1,93 @@
#! /bin/sh
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests display)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests display)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes display))
(mes-use-module (mes guile))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "display"
"0"
(with-output-to-string (lambda () (display 0))))
(pass-if-equal "display"
"A"
(with-output-to-string (lambda () (display #\A))))
(pass-if-equal "write"
"#\\A"
(with-output-to-string (lambda () (write #\A))))
(if (or mes? guile-2?)
(pass-if-equal "write alarm"
"#\\alarm"
(with-output-to-string (lambda () (write #\alarm)))))
(pass-if-equal "write string"
"\"BOO\\n\""
(with-output-to-string (lambda () (write "BOO\n"))))
(pass-if-equal "display string"
"BOO\n"
(with-output-to-string (lambda () (display "BOO\n"))))
(pass-if-equal "display symbol"
"Bah"
(with-output-to-string (lambda () (display 'Bah))))
(pass-if-equal "display number"
"486"
(with-output-to-string (lambda () (display 486))))
(if (or mes? guile-1.8?)
(pass-if-equal "display closure"
"#<procedure #f (a b c)>"
(with-output-to-string (lambda () (display (lambda (a b c) #t))))))
(if (or mes? guile-2?)
(pass-if-equal "display builtin thunk"
"#<procedure gc ()>"
(with-output-to-string (lambda () (display gc)))))
(if (or mes? guile-2?)
(pass-if-equal "display builtin procedure"
"#<procedure acons (_ _ _)>"
(with-output-to-string (lambda () (display acons)))))
(pass-if-equal "s-exp"
"(lambda (a b . c) #t)"
(with-output-to-string (lambda () (display '(lambda (a b . c) #t)))))
(if mes?
(pass-if-equal "vector nest"
"#(0 #(...) 2 3)"
(with-output-to-string (lambda () (display #(0 #(1) 2 3))))))
(result 'report)

69
sysa/mes-0.22/tests/fluids.test Executable file
View file

@ -0,0 +1,69 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests fluids)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define-module (tests fluids)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes fluids))
(mes-use-module (mes test))
(define a (make-fluid))
(define b (make-fluid))
(define c #f)
(pass-if "fluid?" (fluid? a))
(pass-if-not "fluid? not" (fluid? c))
(pass-if-not "fluid-ref"
(fluid-ref a))
(pass-if "with-fluid*"
(with-fluid* a #t (lambda () (fluid-ref a))))
(pass-if-not "with-fluid* reset"
(begin
(with-fluid* a #t (lambda () (fluid-ref a)))
(fluid-ref a)))
;; (pass-if-equal "with fluids*"
;; 0 (with-fluids* (list a b) '(0 1)
;; (lambda () (fluid-ref a))))
(pass-if-eq "with-fluids"
0 (with-fluids ((a 1)
(a 2)
(a 3))
(fluid-set! a 0)
(fluid-ref a)))
(pass-if-eq "with-fluids"
#f (begin
(with-fluids ((a 1)
(b 2))
(fluid-set! a 0)
(display "X:") (display (fluid-ref a)) (newline))
(fluid-ref a)))
(result 'report)

61
sysa/mes-0.22/tests/getopt-long.test Executable file
View file

@ -0,0 +1,61 @@
#! /bin/sh
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests getopt-long)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2017,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/>.
(define-module (tests getopt-long)
#:use-module (mes mes-0)
#:use-module (mes test)
#:use-module (mes getopt-long))
(cond-expand
(mes
(mes-use-module (mes getopt-long))
(mes-use-module (mes test)))
(else))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define option-spec '((help (single-char #\h))
(include (single-char #\I) (value #t))
(version (single-char #\V))))
(pass-if-equal "getopt" '((() "bar"))
(getopt-long '("foo" "bar") option-spec))
(pass-if-equal "getopt2" '((() "bar" "baz"))
(getopt-long '("foo" "bar" "baz") option-spec))
(pass-if-equal "getopt --help" '((()) (help . #t))
(getopt-long '("foo" "--help") option-spec))
(pass-if-equal "getopt -hVI5d" '((()) (include . "5d") (version . #t) (help . #t))
(getopt-long '("foo" "-hVI5d") option-spec))
(pass-if-equal "getopt -I." '((()) (include . "."))
(getopt-long '("foo" "-I.") option-spec))
(pass-if-equal "getopt -I foo ..." '((()) (include . "lib") (include . "include"))
(getopt-long '("foo" "-I" "include" "-I" "lib") option-spec))
(result 'report)

117
sysa/mes-0.22/tests/guile.test Executable file
View file

@ -0,0 +1,117 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests guile)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2017,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/>.
(define-module (tests guile)
#:use-module (ice-9 rdelim)
#:use-module (mes mes-0)
#:use-module (mes misc)
#:use-module (mes test))
(cond-expand
(mes
(mes-use-module (mes test))
(mes-use-module (mes misc))
(mes-use-module (mes guile)))
(else))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "read-string" "bla"
(with-input-from-string "bla"
(lambda () (read-string))))
(pass-if-equal "open-input-string" "bla"
(let* ((port (current-input-port))
(foo (open-input-string "bla")))
(set-current-input-port foo)
(let ((s (read-string)))
(set-current-input-port port)
s)))
;; NYACC
;; === input stack =====================
(define *input-stack* (make-fluid '()))
(define (reset-input-stack)
(fluid-set! *input-stack* '()))
(define (push-input port)
(let ((curr (current-input-port))
(ipstk (fluid-ref *input-stack*)))
(fluid-set! *input-stack* (cons curr ipstk))
(set-current-input-port port)))
;; Return #f if empty
(define (pop-input)
(let ((ipstk (fluid-ref *input-stack*)))
(if (null? ipstk) #f
(begin
(set-current-input-port (car ipstk))
(fluid-set! *input-stack* (cdr ipstk))))))
(pass-if-equal "push-input"
"bla"
(let ()
(push-input (open-input-string "bla"))
(let ((ch (read-char)))
(unread-char ch))
(let ((x (read-string)))
(let ((pop (pop-input)))
x))))
(pass-if-equal "input-stack/1"
"hello world!"
(with-output-to-string
(lambda ()
(with-input-from-string "hello X!"
(lambda ()
(let iter ((ch (read-char)))
(unless (eq? ch #\X) (write-char ch) (iter (read-char))))
(push-input (open-input-string "world"))
(let iter ((ch (read-char)))
(unless (eof-object? ch) (write-char ch) (iter (read-char))))
(pop-input)
(let iter ((ch (read-char)))
(unless (eof-object? ch) (write-char ch) (iter (read-char)))))))))
(pass-if "input-stack/2"
(let ((sp (open-input-string "abc")))
(push-input sp)
(and (pop-input) (not (pop-input)))))
(pass-if-equal "with-input-from-string peek"
#\X
(with-input-from-string "X"
(lambda () (peek-char))))
(pass-if-equal "open-input-string peek"
#\X
(let ((port (open-input-string "X")))
(set-current-input-port port)
(peek-char)))
(result 'report)

63
sysa/mes-0.22/tests/let-syntax.test Executable file
View file

@ -0,0 +1,63 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests let-syntax)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests let-syntax)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes syntax))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "let-syntax"
(seq?
(let-syntax ((xwhen (syntax-rules ()
((xwhen condition exp ...)
(if (not condition)
(begin exp ...))))))
(xwhen #f 3))
3))
(pass-if "let-syntax no-leak"
(seq?
(when #f 3)
*unspecified*))
(pass-if "let-syntax"
(sequal?
(let-syntax ((when (syntax-rules ()
((when condition exp ...)
(if (not condition)
(begin exp ...)))))
(unless (syntax-rules ()
((when condition exp ...)
(if condition
(begin exp ...))))))
(list (when #f 0) (unless #t 1)))
'(0 1)))
(result 'report)

67
sysa/mes-0.22/tests/let.test Executable file
View file

@ -0,0 +1,67 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests let)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests let)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes let))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "let " 1
(let ((x 1)) 1))
(let () (define *let-define* '*let-define*) #f)
(pass-if-equal "let define "
#f
(and (defined? '*let-define*) *let-define*))
(begin (define *begin-define* '*begin-define*) #f)
(pass-if-equal "begin define" '*begin-define*
(and (defined? '*begin-define*) *begin-define*))
(pass-if-equal "let loop" '(3 2 1)
(let loop ((lst '(3 2 1)))
(cond ((null? lst) '())
(#t (cons (car lst) (loop (cdr lst)))))))
(pass-if-equal "let* comments" 5
(let* ((aa 2)
(bb (+ aa 3))
#! boo !#
;;(bb 4)
)
bb))
(pass-if-equal "letrec" 24
(letrec ((factorial (lambda (n)
(cond ((= n 1) 1)
(#t (* n (factorial (- n 1))))))))
(factorial 4)))
(result 'report)

105
sysa/mes-0.22/tests/macro.test Executable file
View file

@ -0,0 +1,105 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
export MES_BOOT=boot-02.scm
MES=${MES-$(dirname $0)/../bin/mes}
$MES < $0
exit $?
else
exit 0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests macro)' -s "$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/>.
(define-module (tests boot)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define gensym
((lambda (symbols)
(lambda (. rest)
((lambda (head tail)
(set! symbols tail)
head)
(car symbols)
(cdr symbols))))
'(g0 g1 g2 g3 g4)))
;; type-0.mes
(define (string . lst)
(list->string lst))
;; scm.mes
(define (symbol-append . rest)
(string->symbol (apply string-append (map symbol->string rest))))
(define-macro (make-fluid . default)
((lambda (fluid)
(list
'begin
(list
'module-define!
(list 'boot-module)
(list 'quote fluid)
(list
(lambda (v)
(lambda ( . rest)
(if (null? rest) v
(set! v (car rest)))))
(and (pair? default) (car default))))
(list 'quote fluid)))
(symbol-append 'fluid: (gensym))))
(define fluid (make-fluid 42))
(pass-if-eq "fluid" 42 (fluid))
(fluid 0)
(pass-if-eq "fluid 0" 0 (fluid))
(fluid '())
(pass-if-eq "fluid null" '() (fluid))
(define (fluid-ref fluid)
(fluid))
(define (fluid-set! fluid value)
(fluid value))
(fluid-set! fluid 0)
(pass-if-eq "fluid 0" 0 (fluid-ref fluid))
(fluid-set! fluid '())
(pass-if-eq "fluid null" '() (fluid-ref fluid))
(result 'report)

119
sysa/mes-0.22/tests/match.test Executable file
View file

@ -0,0 +1,119 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests match)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests match)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes match))
(mes-use-module (mes test))
(cond-expand
(guile
(use-modules (ice-9 match)))
(mes))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "match symbol"
(seq?
(match 'bla
('bla 'bla))
'bla))
(pass-if "match no symbol"
(sequal?
(match 'foo
('bla 'bla)
(_ "no match: foo"))
"no match: foo"))
(pass-if "match symbol?"
(seq?
(match 'foo
((? symbol?) 'symbol)
(_ "no match: symbol")
)
'symbol))
(pass-if "match list"
(sequal?
(match '(0)
((0) '(0))
(_ "no match: (0)"))
'(0)))
(pass-if "match list 2"
(sequal?
(match (list 1 2 3) ((1 b c) (list b c)))
'(2 3)))
(pass-if "match unquote"
(sequal?
(match (list 1 2 3) (`(1 ,b ,c) (list b c)))
'(2 3)))
(pass-if "match x-hygiene"
(seq?
(match '(0 1 2)
((0 x y) (+ x y))
(_ "no match: 0 1 2"))
3))
(pass-if "match ellipsis"
(sequal?
(match '(1 2)
((t ...) t)
(_ "no match: (1 2)"))
'(1 2)))
(pass-if-equal "match nyacc 0"
'(rest)
(match '(first rest)
((first . rest)
rest)))
(pass-if-equal "match nyacc 1"
'(#\. rest)
(match '(first #\. rest)
(('first . rest)
rest)))
(let ((tkl0-simple '((ident . type) rest)))
(pass-if-equal "match nyacc simple"
(cons (cdar tkl0-simple) (cdr tkl0-simple))
(match tkl0-simple
((('ident . val) . rest)
(cons val rest)))))
(let ((tkl0 '((ident . "type") #\. #\] (arg . "0") #\[ (ident . "g_cells"))))
(pass-if-equal "match nyacc tkl0"
(cdr tkl0)
(match tkl0
((('ident . val) . rest)
rest))))
(result 'report (if mes? 2 0))

96
sysa/mes-0.22/tests/math.test Executable file
View file

@ -0,0 +1,96 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests math)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2018,2019 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/>.
(define-module (tests math)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes test))
(pass-if-equal "string->number" 42 (string->number "42"))
(pass-if-equal "string->number neg" -42 (string->number "-42"))
(pass-if-equal "string->number #hex" 170 (string->number "#xaa"))
(pass-if-not "string->number hex" (string->number "aa"))
(pass-if-equal "string->number hex" 170 (string->number "aa" 16))
(pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0")))
(pass-if-equal "+" 6 (+ 1 2 3))
(pass-if-equal "*" 27 (* 3 3 3))
(pass-if-equal "/" 3 (/ 9 3))
(pass-if-equal "remainder" 2 (remainder 11 3))
(pass-if-equal "modulo" 2 (modulo 11 3))
(pass-if-equal "expt" 8 (expt 2 3))
(pass-if-equal "logior" 7 (logior 0 1 2 4))
(pass-if-equal "logxor" -2 (logxor 1 -1))
(pass-if-equal "ash"
8 (ash 1 3))
(pass-if-equal "ash -1"
5 (ash 10 -1))
(pass-if-equal "=" 3 '3)
(pass-if "= 2" (not (= 3 '4)))
(pass-if "=" (=))
(pass-if "= 1" (= 0))
(pass-if "= 2" (= 0 0))
(pass-if "= 3" (= 0 0))
(pass-if-not "= 4" (= 0 1 0))
(pass-if "<" (<))
(pass-if "< 1" (< 0))
(pass-if "< 2" (< 0 1))
(pass-if-not "< 3" (< 1 0))
(pass-if "< 4" (< 0 1 2))
(pass-if-not "< 5" (< 0 2 1))
(pass-if "< INT-MIN" (< -2147483648))
(pass-if "< INT-MIN" (< -2147483648 0))
(pass-if "< INT-MAX" (< 2147483647))
(pass-if ">" (>))
(pass-if "> 1" (> 0))
(pass-if "> 2" (> 1 0))
(pass-if-not "> 3" (> 0 1))
(pass-if "> 4" (> 2 1 0))
(pass-if-not "> 5" (> 1 2 0))
(pass-if "> INT-MAX" (> 2147483647))
(pass-if "> INT-MAX 0" (> 2147483647 0))
(pass-if "> INT-MIN" (> -2147483648))
(pass-if ">=" (>= 3 2 1))
(pass-if-not ">= 2" (>= 1 2 3))
(pass-if-not "<=" (<= 3 2 1))
(pass-if "<= 2" (<= 1 2 3))
(pass-if-equal "max" 0 (max 0))
(pass-if-equal "max 1" 1 (max 0 1))
(pass-if-equal "max 2" 2 (max 1 0 2))
(pass-if-equal "min" 0 (min 0))
(pass-if-equal "min 1" 0 (min 0 1))
(pass-if-equal "min 2" 0 (min 1 0 2))
(pass-if-equal "#x-10" -16 #x-10)
(result 'report)

35
sysa/mes-0.22/tests/module.test Executable file
View file

@ -0,0 +1,35 @@
#! /bin/sh
# -*-scheme-*-
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>
;;;
;;; 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/>.
(define-module (tests module)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(result 'report)

107
sysa/mes-0.22/tests/optargs.test Executable file
View file

@ -0,0 +1,107 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests optargs)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests optargs)
#:use-module (mes optargs)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(mes-use-module (mes optargs))
(mes-use-module (mes test)))
(else))
(pass-if-equal "cond =>" 10
(cond
(5 => (lambda (p) (* p 2)))))
(pass-if-equal "cond => 2" 10
(cond
(#f (display "hallo") (newline))
(5 => (lambda (p) (* p 2)))
(#t (display "wereld" (newline)))))
(pass-if-equal "cond => last" 10
(cond
(#f (display "hallo") (newline))
(5 => (lambda (p) (* p 2)))))
(pass-if "keyword?" (keyword? #:foo))
(pass-if "keywords" (eq? #:foo #:foo))
(pass-if-equal "keyword->symbol" 'foo (keyword->symbol #:foo))
(pass-if-equal "symbol->keyword" #:foo (symbol->keyword 'foo))
(pass-if-not "keywords" (eq? #:foo ':foo))
(pass-if "optargs #:optional" ((lambda* (#:optional (x #f)) x) #t))
(pass-if-equal "optargs #:optional default" #f ((lambda* (#:optional (x #f)) x)))
(pass-if "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t))
(pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo)))
(define <info> '<info>)
(define <functions> '<functions>)
(define <globals> '<globals>)
(define <locals> '<locals>)
(define <text> '<text>)
(define* (make o #:key (functions '()) (globals '()) (locals '()) (text '()))
(list <info>
(cons <functions> functions)
(cons <globals> globals)
(cons <locals> locals)
(cons <text> text)))
(define (.functions o)
(assq-ref (cdr o) <functions>))
(define (.globals o)
(assq-ref (cdr o) <globals>))
(define (.locals o)
(assq-ref (cdr o) <locals>))
(define (.text o)
(assq-ref (cdr o) <text>))
(define (info? o)
(and (pair? o) (eq? (car o) <info>)))
(define (clone o . rest)
(cond ((info? o)
(let ((functions (.functions o))
(globals (.globals o))
(locals (.locals o))
(text (.text o)))
(let-keywords rest
#f
((functions functions)
(globals globals)
(locals locals)
(text text))
(make <info> #:functions functions #:globals globals #:locals locals #:text text))))))
(pass-if-equal "clone <info>"
(make <info> #:functions '(0))
(clone (make <info>) #:functions '(0)))
(result 'report)

71
sysa/mes-0.22/tests/peg.test Executable file
View file

@ -0,0 +1,71 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests peg)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define-module (tests peg)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(mes-use-module (mes peg))
(mes-use-module (mes test)))
(guile-2.2
(use-modules (ice-9 peg)))
(guile
(use-modules (ice-9 syncase))
(display "guile 2.0: no PEG\n" (current-error-port))
(exit 0)))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define *etc-passwd*
"root:x:0:0:root:/root:/bin/bash
daemon:x:1:1:daemon:/usr/sbin:/bin/sh
bin:x:2:2:bin:/bin:/bin/sh
sys:x:3:3:sys:/dev:/bin/sh
nobody:x:65534:65534:nobody:/nonexistent:/bin/sh
messagebus:x:103:107::/var/run/dbus:/bin/false")
(define-peg-string-patterns
"string-passwd <- entry* !.
entry <-- (! NL .)* NL*
NL < '\n'")
(pass-if-equal "peg-tree"
(map (lambda (x) (list 'entry x)) (string-split *etc-passwd* #\newline))
(peg:tree (match-pattern string-passwd *etc-passwd*)))
(define-peg-pattern passwd body (and (* entry) (not-followed-by peg-any)))
(define-peg-pattern entry all (and (* (and (not-followed-by NL) peg-any))
(* NL)))
(define-peg-pattern NL none "\n")
(define-peg-pattern passwd body (peg "entry* !."))
(pass-if-equal "peg-tree"
(map (lambda (x) (list 'entry x)) (string-split *etc-passwd* #\newline))
(peg:tree (match-pattern passwd *etc-passwd*)))
(result 'report)

56
sysa/mes-0.22/tests/perform.test Executable file
View file

@ -0,0 +1,56 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
MES=${MES-$(dirname $0)/../bin/mes}
MES_BOOT=boot-02.scm exec $MES < $0
exit $?
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests perform)' -s "$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/>.
(define-module (tests boot)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(define (round x) x)
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-timeout "loop 1M"
100
((lambda (loop)
(set! loop
(lambda (i)
(if (> i 0)
(loop (- i 1)))))
(loop 100000))
*unspecified*))
(result 'report 1) ; at least until we have bogomips, to fail

74
sysa/mes-0.22/tests/pmatch.test Executable file
View file

@ -0,0 +1,74 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests pmatch)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2017,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/>.
(define-module (tests pmatch)
#:use-module (system base pmatch)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(mes-use-module (mes test))
(mes-use-module (mes pmatch)))
(else))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "pmatch" 0
(let ((o 0))
(pmatch o
(_ o))))
(pass-if-equal "pmatch nyacc minimal" "main"
(let* ((ast '(("main") PARAM-LIST))
(mets (pmatch ast
(((,name) _) name))))
;;(format (current-error-port) "mets: ~s\n" mets)
mets))
(pass-if-equal "pmatch nyacc" "main"
(let ((ast '(fctn-defn
(decl-spec-list (type-spec (fixed-type "int")))
(ftn-declr
(ident "main")
(param-list
(param-decl
(decl-spec-list (type-spec (fixed-type "int")))
(param-declr (ident "argc")))
(param-decl
(decl-spec-list (type-spec (fixed-type "char")))
(param-declr
(ptr-declr (pointer) (array-of (ident "argv")))))))
(compd-stmt
(block-item-list
(if (gt (p-expr (ident "argc")) (p-expr (fixed "1")))
(return (p-expr (ident "argc"))))
(return (p-expr (fixed "42"))))))))
(pmatch ast
((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
(_ 'bla))))
(result 'report)

40
sysa/mes-0.22/tests/posix.test Executable file
View file

@ -0,0 +1,40 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-13)' -s "$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/>.
(define-module (tests srfi-13)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (srfi srfi-13))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-eq "system*" 0 (system* "true"))
(pass-if-eq "system*" 256 (system* "false"))
(result 'report)

234
sysa/mes-0.22/tests/psyntax.test Executable file
View file

@ -0,0 +1,234 @@
#! /bin/sh
# -*-scheme-*-
MES_ARENA=${MES_ARENA-10000000} exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests psyntax)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests psyntax)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(mes-use-module (mes psyntax))
(mes-use-module (mes test)))
(guile-2.2
(define sc-expand identity)
(define syntax-object->datum syntax->datum)
(define datum->syntax-object datum->syntax))
(guile-2
(define sc-expand identity)
(define syntax-object->datum syntax->datum)
(define datum->syntax-object datum->syntax)
(define-macro (with-ellipsis . stuff) #t))
(guile
(use-modules (ice-9 syncase))
(define sc-expand identity)))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(cond-expand
(guile)
(mes
(pass-if "andmap"
(seq? (andmap (lambda (x) (> x 0)) '(3 2 1)) #t))
(pass-if "andmap 2"
(seq? (andmap (lambda (x) (> x 0)) '(3 2 1 0)) #f))
(pass-if "putprop" (putprop 'foo '*sc-expander 'bar))
(pass-if "getprop"
(seq? (getprop 'foo '*sc-expander) 'bar)))
)
(pass-if "syntax-case"
(sequal? (let* ((sexp '(syntax-case '((1 2) (3 4)) ()
(((x ...) ...) (syntax (x ... ...)))))
(expanded (sc-expand sexp)))
(primitive-eval expanded))
'(1 2 3 4)))
(pass-if "sc-expand"
(sequal? (let ()
(syntax-case '((1 2) (3 4)) ()
(((x ...) ...) (syntax (x ... ...)))))
'(1 2 3 4)))
(pass-if "syntax-object->datum"
(sequal? (syntax-object->datum (syntax (set! a b)))
'(set! a b)))
(pass-if-equal "syntax-case swap!"
'((lambda (temp)
(set! a b)
(set! b temp))
a)
(syntax-object->datum
(let ((exp '(set! a b)))
(syntax-case exp ()
((swap! a b)
(syntax
((lambda (temp)
(set! a b)
(set! b temp))
a)))))))
(pass-if-equal "syntax-case swap! let"
'(let ((temp a)) (set! a b) (set! b temp))
(syntax-object->datum
(let ((exp '(set! a b)))
(syntax-case exp ()
((swap! a b)
(syntax
(let ((temp a))
(set! a b)
(set! b temp))))))))
(cond-expand
(guile)
(mes
(pass-if-equal "syntax-case manual swap!"
'("bar" "foo")
(let* ((sc (sc-expand '(syntax-case exp () ((swap! a b) (syntax (let ((temp a)) (set! a b) (set! b temp)))))))
(exp '(swap foo bar))
(foo "foo")
(bar "bar")
(s (eval sc (current-module)))
(d (syntax-object->datum s))
(e (core:macro-expand d)))
(eval e (current-module))
(list foo bar)))))
(pass-if-equal "define-syntax swap! [syntax-case]"
(list "bar" "foo")
(let ()
(define-syntax swap!
(lambda (exp)
(syntax-case exp ()
((swap! a b)
(syntax
((lambda (temp)
(set! a b)
(set! b temp)) a))))))
(let ((foo "foo")
(bar "bar"))
(swap! foo bar)
(list foo bar))))
(pass-if-equal "define-syntax swap! [syntax-case+let]"
(list "bar" "foo")
(let ()
(define-syntax swap!
(lambda (exp)
(syntax-case exp ()
((swap! a b)
(syntax
(let ((temp a))
(set! a b)
(set! b temp)))))))
(let ((foo "foo")
(bar "bar"))
(swap! foo bar)
(list foo bar))))
(pass-if-equal "define-syntax sr:when [syntax-rules]"
"if not now, then?"
(let ()
(define-syntax sr:when
(syntax-rules ()
((sc:when condition exp ...)
(if condition
(begin exp ...)))))
(let ()
(sr:when #t "if not now, then?"))))
(pass-if-equal "define-syntax-rule"
"if not now, then?"
(let ()
(define-syntax-rule (sre:when c e ...)
(if c (begin e ...)))
(let ()
(sre:when #t "if not now, then?"))))
(pass-if-equal "syntax-rules plus"
(+ 1 2 3)
(let ()
(define-syntax plus
(syntax-rules ()
((plus x ...) (+ x ...))))
(plus 1 2 3)))
(cond-expand
(guile
(pass-if-equal "macro with quasisyntax"
'("foo" "foo")
(let ()
(define-syntax string-let
(lambda (stx)
(syntax-case stx ()
((_ id body ...)
#`(let ((id #,(symbol->string (syntax->datum #'id))))
body ...)))))
(string-let foo (list foo foo)))))
(mes))
;; (pass-if-equal "custom ellipsis within normal ellipsis"
;; '((((a x) (a y) (a …))
;; ((b x) (b y) (b …))
;; ((c x) (c y) (c …)))
;; (((a x) (b x) (c x))
;; ((a y) (b y) (c y))
;; ((a …) (b …) (c …))))
;; (let ()
;; (define-syntax foo
;; (syntax-rules ()
;; ((_ y ...)
;; (syntax-rules … ()
;; ((_ x …)
;; '((((x y) ...) …)
;; (((x y) …) ...)))))))
;; (define-syntax bar (foo x y …))
;; (bar a b c)))
(let ()
(define-syntax define-quotation-macros
(lambda (x)
(syntax-case x ()
((_ (macro-name head-symbol) ...)
#'(begin (define-syntax macro-name
(lambda (x)
(with-ellipsis :::
(syntax-case x ()
((_ x :::)
#'(quote (head-symbol x :::)))))))
...)))))
(define-quotation-macros (quote-a a) (quote-b b) (quote-c c))
(pass-if-equal "with-ellipsis"
'(a 1 2 3)
(quote-a 1 2 3)))
(result 'report (if (and guile?
(equal? (effective-version) "2.0")) 1
0))

98
sysa/mes-0.22/tests/quasiquote.test Executable file
View file

@ -0,0 +1,98 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
MES_BOOT=boot-03.scm exec ${MES-mes} < $0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests quasiquote)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "quasiquote" `#t)
(pass-if-not "quasiquote 2" `#f)
(pass-if "quasiquote 3" (seq? `1 1))
(pass-if "quasiquote 4" (sequal? '`0 '(quasiquote 0)))
(pass-if "unquote" (let ((x 0)) (sequal? `,x 0)))
(pass-if "unquote 1" (let ((b 1)) (sequal? `(a ,b c) '(a 1 c))))
(pass-if "unquote 2" (sequal? `,(list 1 2 3 4) '(1 2 3 4)))
(pass-if "unquote 3" (sequal? `(1 2 '(,(+ 1 2))) '(1 2 '(3))))
(pass-if "unquote-splicing" (let ((b 1) (c '(2 3))) (sequal? `(a ,b ,@c) '(a 1 2 3))))
(pass-if "unquote-splicing 2" (sequal? `('boo ,@'(bah baz) 1 2) '((quote boo) bah baz 1 2)))
(pass-if "unquote-splicing 3" (sequal? `(1 ,@(list 2 3) 4) '(1 2 3 4)))
(pass-if "unquote-splicing 4" (sequal? (let ((s-r '(2 3))) `(1 ,@s-r 4)) '(1 2 3 4)))
;; From R6RS spec
(pass-if-equal "qq 0" '(list 3 4)
`(list ,(+ 1 2) 4))
(pass-if-equal "qq 1" '(list a (quote a))
(let ((name 'a))
`(list ,name ',name)) )
(define (>= . rest)
(or (apply > rest)
(apply = rest)))
(define (abs x)
(if (>= x 0) x (- x)))
(pass-if-equal "qq 2" '(a 3 4 5 6 b)
`(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
(pass-if-equal "qq 3" '((foo 7) . cons)
`((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
(define (remainder x y)
(- x (* (quotient x y) y)))
(define (even? x)
(= 0 (remainder x 2)))
(pass-if-equal "qq 4" '#(10 5 #t #t #f #f #f 8)
`#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8))
;; (pass-if-equal "qq 5" '(foo foo foo)
;; (let ((name 'foo))
;; `((unquote name name name))))
;; (pass-if-equal "qq 6" '(foo foo foo)
;; (let ((name '(foo)))
;; `((unquote-splicing name name name))))
;; (pass-if-equal "qq 7" '`(foo (unquote (append x y) (even? 9)))
;; (let ((q '((append x y) (even? 9))))
;; ``(foo ,,@q)))
;; (pass-if-equal "qq 8" '(foo (2 3 4 5) #f)
;; (let ((x '(2 3))
;; (y '(4 5)))
;; `(foo (unquote (append x y) (even? 9)))))
;; (pass-if-equal "qq 9" '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
;; `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
;; (pass-if-equal "qq 10" '(a `(b ,x ,'y d) e)
;; (let ((name1 'x)
;; (name2 'y))
;; `(a `(b ,,name1 ,',name2 d) e)))
(result 'report)

84
sysa/mes-0.22/tests/read.test Executable file
View file

@ -0,0 +1,84 @@
#! /bin/sh
# -*-scheme-*-
# For use as a scaffolded sexp reader test
# ***REMOVE THIS BLOCK COMMENT INITIALLY***
# GNU Mes --- Maxwell Equations of Software
# Copyright © 2016, 2017,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/>.
if [ "$MES" != guile ]; then
MES=${MES-$(dirname $0)/../bin/mes}
MES_BOOT=boot-02.scm exec $MES < $0
fi
exec ${MES-mes} --no-auto-compile -s $0
!#
0
cons
(cons 0 1)
(display 0) (newline)
#t
#f
(display #t) (newline)
(display #f) (newline)
'foo
(display 'foo) (newline)
(display #o77) (newline)
(display #o-6) (newline)
(display #x16) (newline)
(display #x-16) (newline)
(display #\A) (newline)
(display #\newline) (newline)
#\alarm
#\backspace
#\tab
#\newline
#\vtab
#\page
#\return
#\space
(display "\"")
(display "\\")
(display "\\\"\"\\")
(display 'foo)(newline)
(display '(foo))(newline)
(display '('foo))(newline)
(display (cdr '(car . cdr))) (newline)
(display "foo bar") (newline)
;;barf
#!
barf
!#
#|
burp
|#
#;(bla) (display "must see!\n")
(display
(lambda (x)
#;()#t)
)
(display #(0 1 2)) (newline)
(display (list '(foo
#! boo !#
;;(bb 4)
)
))
(newline)
;; TODO: syntax, unsyntax, unsyntax-splicing

159
sysa/mes-0.22/tests/scm.test Executable file
View file

@ -0,0 +1,159 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
MES_BOOT=boot-03.scm exec ${MES-mes} < $0
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018,2019 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/>.
(define-module (tests scm)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "when" (seq? (when #t 'true) 'true))
(pass-if "when 2" (seq? (when #f 'true) *unspecified*))
(pass-if "map" (sequal? (map identity '(1 2 3 4)) '(1 2 3 4)))
(pass-if "map 2 " (sequal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
'((1 . a) (2 . b) (3 . c) (4 . d))))
(pass-if "for-each" (sequal? (let ((acc '())) (for-each (lambda (x) (set! acc (cons x acc))) '(1 2 3 4)) acc) '(4 3 2 1)))
(define xxxa 0)
(pass-if "set! " (seq? (begin (set! xxxa 1) xxxa) 1))
(pass-if "set! 2" (seq? (let ((a 0)) (set! a 1) a) 1))
(pass-if "list-ref" (seq? (list-ref '(0 1 2) 1) 1))
(pass-if "do" (sequal? (let ((acc '())) (do ((i 0 (+ i 1))) ((>= i 3)) (set! acc (cons i acc))) acc) '(2 1 0)))
(pass-if ">=" (>= 3 2 1))
(pass-if-equal "string-length"
0
(string-length ""))
(pass-if-equal "string-length 2"
3
(string-length (string-append "a" "b" "c")))
(pass-if-equal "string->list"
'()
(string->list ""))
(pass-if-equal "string->list 2"
'(#\a #\b #\c #\newline)
(string->list "abc\n"))
(pass-if "string-append" (sequal? (string-append "a" "b" "c") "abc"))
(pass-if "substring" (sequal? (substring "hello world" 6) "world"))
(pass-if "substring 2" (sequal? (substring "hello world" 4 7) "o w"))
(pass-if "string-ref" (seq? (string-ref "hello world" 4) #\o))
(pass-if "eq?" (not (eq? (string-append "a" "b" "c") "abc")))
(pass-if "char" (seq? (char->integer #\A) 65))
(pass-if "char 2" (seq? (char->integer #\101) (char->integer #\A)))
(pass-if "char 3" (seq? (integer->char 10) #\newline))
(pass-if "char 4" (seq? (integer->char 32) #\space))
(pass-if "string " (sequal? (string #\a #\space #\s #\t #\r #\i #\n #\g) "a string"))
(pass-if "length" (seq? (length '()) 0))
(pass-if "length 2" (seq? (length '(a b c)) 3))
(pass-if "make-list" (seq? (make-list 0) '()))
(pass-if "make-list 1" (sequal? (make-list 1 0) '(0)))
(pass-if "memq" (sequal? (memq 'a '(a b c)) '(a b c)))
(pass-if "memq" (sequal? (memq 'b '(a b c)) '(b c)))
(pass-if "memq" (seq? (memq 'd '(a b c)) #f))
(pass-if "member" (sequal? (member '(a) '((a) b c)) '((a) b c)))
(pass-if "assq-ref" (seq? (assq-ref '((b . 1) (c . 2)) 'c) 2))
(pass-if "assq-ref 2" (seq? (assq-ref '((b . 1) (c . 2)) 'a) #f))
(pass-if "assq-set!" (sequal? (assq-set! '((b . 1)) 'a 0) '((a . 0) (b . 1))))
(pass-if "assq-set! 2" (sequal? (assq-set! '((a . 0)) 'a 1) '((a . 1))))
(pass-if "assoc" (sequal? (assoc '(a . 0) '((a . 0) (b . 1) ((a . 0) aa))) '((a . 0) aa)))
(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)))
(pass-if "gensym 1"
(not (eq? (gensym) (gensym))))
(pass-if "gensym 2"
(not (eq? (gensym) (gensym))))
(pass-if "last-pair " (sequal? (last-pair '(1 2 3 4)) '(4)))
(pass-if "last-pair 2" (seq? (last-pair '()) '()))
;; (pass-if "circular-list? "
;; (seq?
;; (let ((x (list 1 2 3 4)))
;; (set-cdr! (last-pair x) (cddr x))
;; (circular-list? x))
;; #t))
(pass-if-equal "iota"
'(0 1 2) (iota 3))
(pass-if-equal "iota 0"
'() (iota 0))
(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))
(pass-if "apply identity" (seq? (apply identity '(0)) 0))
(pass-if "apply identity 2" (sequal? (apply identity '((0 1))) '(0 1)))
(pass-if "apply append" (sequal? (apply append '((1 2) (3 4))) '(1 2 3 4)))
(pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t))
(pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f))
(pass-if-equal "compose" 1 ((compose car cdr car) '((0 1 2))))
(if (not guile?)
(pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
(pass-if "make-vector 2" (sequal? (make-vector 3 1) #(1 1 1)))
(pass-if-equal "binary" 5 #b101)
(pass-if-equal "octal" 65 #o101)
(pass-if-equal "hex" 257 #x101)
(pass-if-equal "negate" #t ((negate eq?) 0 1))
(pass-if-equal "const" 42 ((const 42) 1 2 3 4))
(result 'report)

48
sysa/mes-0.22/tests/srfi-0.test Executable file
View file

@ -0,0 +1,48 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
export MES_BOOT=boot-02.scm
MES=${MES-$(dirname $0)/../bin/mes}
$MES < $0
exit $?
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$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/>.
(define-module (tests srfi-0)
#:use-module (mes mes-0)
#:use-module (mes test))
(display "srfi-0...\n")
(cond-expand
(mes
(display "mes\n")
(exit 0))
(guile
(display "guile\n")
(exit guile?))
(else
(exit 1)))
(exit 1)

90
sysa/mes-0.22/tests/srfi-1.test Executable file
View file

@ -0,0 +1,90 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-1)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define-module (tests srfi-1)
#:use-module (srfi srfi-1)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (srfi srfi-1))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "map 1,2"
'((0 . a))
(map (lambda (x y) (cons x y)) '(0) '(a b)))
(pass-if-equal "map 2,1"
'((0 . a))
(map (lambda (x y) (cons x y)) '(0 1) '(a)))
(pass-if "for-each 1,2"
(for-each (lambda (x y) (cons x y)) '(0) '(a b)))
(pass-if "for-each 2,1"
(for-each (lambda (x y) (cons x y)) '(0 1) '(a)))
(pass-if-equal "fold"
'(3 2 1)
(fold cons '() '(1 2 3)))
(pass-if-equal "fold-right"
'(1 2 3)
(fold-right cons '() '(1 2 3)))
(pass-if-equal "unfold"
'(4 3 2 1 foo)
(unfold zero? identity 1- 4 (const '(foo))))
(pass-if-equal "remove"
'(1 3)
(remove even? '(1 2 3)))
(pass-if-equal "append-reverse"
'(3 2 1 4 5 6)
(append-reverse '(1 2 3) '(4 5 6)))
(pass-if-equal "member lambda"
'(4)
(member 2 '(1 4) (lambda (x y) (even? y))))
(pass-if-not "member ="
(member 2 '(1 4) =))
(pass-if-equal "append-map"
'(0 0 1)
(append-map iota '(1 2)))
(pass-if-equal "fold-3"
'(1 A a 2 B b 3 C c)
(fold cons* '() '(3 2 1) '(C B A) '(c b a)))
(pass-if-equal "fold-right-3"
'(1 A a 2 B b 3 C c)
(fold-right cons* '() '(1 2 3) '(A B C) '(a b c)))
(result 'report)

144
sysa/mes-0.22/tests/srfi-13.test Executable file
View file

@ -0,0 +1,144 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-13)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,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/>.
(define-module (tests srfi-13)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (srfi srfi-13))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "string=?"
(string=? "foo" "foo"))
(pass-if "string=?"
(let ((empty ""))
(string=? "" empty)))
(pass-if-equal "string-join"
"foo bar"
(string-join '("foo" "bar")))
(pass-if-equal "string-join infix"
"foo+bar"
(string-join '("foo" "bar") "+"))
(pass-if-equal "string-join prefix"
",foo,bar"
(string-join '("foo" "bar") "," 'prefix))
(pass-if-equal "string-join suffix"
"foo,bar,"
(string-join '("foo" "bar") "," 'suffix))
(pass-if-equal "string-split"
'("foo")
(string-split "foo" #\:))
(pass-if-equal "string-split 2"
'("foo" "")
(string-split "foo:" #\:))
(pass-if-equal "string-split 3"
'("foo" "bar" "baz")
(string-split "foo:bar:baz" #\:))
(pass-if-equal "string-index"
3
(string-index "foo:bar" #\:))
(pass-if-equal "string->number" 42 (string->number "42"))
(pass-if-equal "string->number INT-MAX" 2147483647 (string->number "2147483647"))
(pass-if-equal "string->number INT-MIN" -2147483648 (string->number "-2147483648"))
(pass-if-equal "number->string" "16" (number->string 16))
(pass-if-equal "number->string INT-MAX" "2147483647" (number->string 2147483647))
(pass-if-equal "number->string INT-MIN" "-2147483648" (number->string -2147483648))
(pass-if-equal "number->string" "-4" (number->string -4))
(pass-if-eq "string->list" #\A
(car (string->list "A")))
(pass-if-eq "string->list high" #\xff
(car (string->list (list->string (list (integer->char 255))))))
(pass-if-eq "string->list high" #xff
(char->integer (car (string->list (list->string (list (integer->char 255)))))))
(pass-if-equal "string-fold"
"oof"
(list->string (string-fold cons '() "foo")))
(pass-if-equal "string-fold-right"
"f-o-o-:"
(list->string (string-fold-right (lambda (e p) (cons e (cons #\- p))) '(#\:) "foo")))
(pass-if-equal "string-drop" "bar"
(string-drop "foobar" 3))
(pass-if-equal "string-drop-right" "foo"
(string-drop-right "foobar" 3))
(pass-if-equal "string-contains" 3
(string-contains "foobar" "bar"))
(pass-if-not "string-contains not"
(string-contains "fuba" "bar"))
(pass-if-equal "string-trim" "foo "
(string-trim " foo "))
(pass-if-equal "string-trim-right" " foo"
(string-trim-right " foo "))
(pass-if-equal "string-trim-both" "foo"
(string-trim-both " foo "))
(pass-if-equal "string-map" "fuubar"
(string-map (lambda (c) (if (eq? c #\o) #\u c)) "foobar"))
(pass-if-equal "string-replace" "fubar"
(string-replace "foobar" "u" 1 3))
(pass-if-equal "reverse" '(3 2 1)
(reverse '(1 2 3)))
(pass-if-equal "reverse fresh" '(1 2 3)
(let ((list '(1 2 3)))
(reverse list)
list))
(pass-if-equal "reverse!" '(1)
(let ((list '(1 2 3)))
(reverse! list)
list))
(pass-if-equal "reverse! ()" '()
(reverse! '()))
(result 'report (if (and (or #t (equal? %compiler "gnuc")) (equal? %arch "x86")) 1 0))

52
sysa/mes-0.22/tests/srfi-14.test Executable file
View file

@ -0,0 +1,52 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-14)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 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/>.
(define-module (tests srfi-14)
#:use-module (srfi srfi-14)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (srfi srfi-14))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "char-set="
(char-set= (char-set #\a #\b #\c) (char-set #\a #\b #\c)))
(pass-if "char-set= 2"
(char-set= (char-set #\a #\b #\c) (string->char-set "abc")))
(pass-if "char-set-contains?"
(char-set-contains? char-set:whitespace #\space))
(pass-if "list->char-set!"
(char-set= (char-set #\a #\b #\c) (list->char-set '(#\a #\b #\c))))
(pass-if "string->char-set!"
(char-set= (char-set #\a #\b #\c #\d) (string->char-set! "d" (string->char-set "abc"))))
(result 'report)

46
sysa/mes-0.22/tests/srfi-16.test Executable file
View file

@ -0,0 +1,46 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-16)' -s "$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/>.
(define-module (tests srfi-16)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (srfi srfi-16))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "case-lambda" 0
((case-lambda
(() 0)
((x) 1))))
(pass-if-equal "case-lambda" 1
((case-lambda
(() 0)
((x) 1)) #f))
(result 'report)

47
sysa/mes-0.22/tests/srfi-43.test Executable file
View file

@ -0,0 +1,47 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-43)' -s "$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/>.
(define-module (tests srfi-43)
#:use-module (srfi srfi-43)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (srfi srfi-43))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "vector-map"
#(0 2 4)
(vector-map (lambda (i e) (+ i e)) #(0 1 2)))
(pass-if-equal "vector-for-each"
4
(let ((g 0))
(vector-for-each (lambda (i e) (set! g (+ i e))) #(0 1 2))
g))
(result 'report)

56
sysa/mes-0.22/tests/srfi-9.test Executable file
View file

@ -0,0 +1,56 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests srfi-9)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (tests srfi-9)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(mes-use-module (srfi srfi-9))
(mes-use-module (srfi srfi-9 gnu))
(mes-use-module (mes test)))
(else))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define-record-type lexical-token
(make-lexical-token category source value)
lexical-token?
(category lexical-token-category)
(source lexical-token-source)
(value lexical-token-value))
(pass-if "record"
(lexical-token? (make-lexical-token 'x 'y 'z)))
(pass-if-equal "set-field" "baar"
(let ((token (make-lexical-token 'foo "bar" 'baz)))
(lexical-token-category (set-field token (lexical-token-category) "baar"))))
(result 'report)

87
sysa/mes-0.22/tests/syntax.test Executable file
View file

@ -0,0 +1,87 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests syntax)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,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/>.
(define-module (tests syntax)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes test))
(mes-use-module (mes syntax))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(define-syntax sr:when
(syntax-rules ()
((sr:when condition exp ...)
(if condition
(begin exp ...)))))
(sr:when #t
(display "hallo\n")
(display "daar\n"))
;; FIXME: macro inside let
(define-syntax sr:when
(syntax-rules ()
((sc:when condition exp ...)
(if condition
(begin exp ...)))))
(pass-if "define-syntax when"
(sequal?
(let ()
(define-syntax sr:when
(syntax-rules ()
((sc:when condition exp ...)
(if condition
(begin exp ...)))))
(let ()
(sr:when #t "if not now, then?")))
"if not now, then?"))
;; FIXME: macro inside let
(define-syntax-rule (sre:when c e ...)
(if c (begin e ...)))
(pass-if "define-syntax-rule"
(sequal?
(let ()
(define-syntax-rule (sre:when c e ...)
(if c (begin e ...)))
(let ()
(sre:when #t "if not now, then?")))
"if not now, then?"))
(pass-if-equal "syntax-rules plus"
(+ 1 2 3)
(let ()
(define-syntax plus
(syntax-rules ()
((plus x ...) (+ x ...))))
(plus 1 2 3)))
(result 'report)

61
sysa/mes-0.22/tests/vector.test Executable file
View file

@ -0,0 +1,61 @@
#! /bin/sh
# -*-scheme-*-
exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests vector)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,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/>.
(define-module (tests vector)
#:use-module (mes mes-0)
#:use-module (mes test))
(mes-use-module (mes scm))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "equal?" (sequal? #(1) #(1)))
(pass-if "equal?" (not (equal? #() #(1))))
(pass-if "vector" (sequal? #(vector 0 1 2) #(vector 0 1 2)))
(pass-if "vector?" (vector? #(1 2 c)))
(pass-if "vector-length" (seq? (vector-length #(1)) 1))
(if (not guile?)
(pass-if "core:make-vector" (sequal? (core:make-vector 3) #(*unspecified* *unspecified* *unspecified*))))
(pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1))
(pass-if "vector-set!" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))
(pass-if "vector-set! 2" (not (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #())))
(pass-if "vector-set! 3" (sequal? (let ((v1 #(0))
(v2 #(1)))
(vector-set! v2 0 (cons 0 (vector-ref v1 0)))
(vector-set! v1 0 'mwhuharhararrrg)
v2)
#((0 . 0))))
(pass-if "list->vector" (sequal? (list->vector '(a b c)) #(a b c)))
(pass-if "vector list" (let ((v #(0))
(l '(a b c)))
(vector-set! v 0 l)
(set-cdr! l '())
(sequal? (vector->list v) '((a)))))
(result 'report)