mes/tests/base.test
Jan Nieuwenhuizen ad135d3752 doc: Release udpate.
* HACKING: Update.
* INSTALL: Update.
* NEWS: Update.
* README: Update.
* doc/ANNOUNCE-0.12: New file.
* throughout: (janneke) coming out.
2017-11-21 19:22:26 +01:00

127 lines
3.7 KiB
Scheme
Executable file

#! /bin/sh
# -*-scheme-*-
MES=${MES-$(dirname $0)/../src/mes}
echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
#paredit:||
exit $?
!#
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; 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.
;;;
;;; 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 Mes. If not, see <http://www.gnu.org/licenses/>.
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if "lambda" (symbol? 'lambda))
(cond-expand
(guile (define append2 append))
(mes))
(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
(guile)
(mes
(pass-if-equal "include" 42 (include "tests/data/load.scm") the-answer)))
(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))
(if (not guile?)
(pass-if-not "#<eof>"
(char? (integer->char -1))))
(pass-if-equal "setenv, getenv"
"bar"
(begin
(setenv "foo" "bar")
(getenv "bar")
(getenv "foo")))
(result 'report)