ebc524d2c3f11496120b2d6375a85e6706369b58
[mes.git] / tests / base.test
1 #! /bin/sh
2 # -*-scheme-*-
3 MES=${MES-$(dirname $0)/../scripts/mes}
4 echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
5 #paredit:||
6 exit $?
7 !#
8
9 ;;; -*-scheme-*-
10
11 ;;; Mes --- Maxwell Equations of Software
12 ;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
13 ;;;
14 ;;; This file is part of Mes.
15 ;;;
16 ;;; Mes is free software; you can redistribute it and/or modify it
17 ;;; under the terms of the GNU General Public License as published by
18 ;;; the Free Software Foundation; either version 3 of the License, or (at
19 ;;; your option) any later version.
20 ;;;
21 ;;; Mes is distributed in the hope that it will be useful, but
22 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 ;;; GNU General Public License for more details.
25 ;;;
26 ;;; You should have received a copy of the GNU General Public License
27 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
28
29 (mes-use-module (mes test))
30
31 (pass-if "first dummy" #t)
32 (pass-if-not "second dummy" #f)
33
34 (pass-if "lambda" (symbol? 'lambda))
35
36 (cond-expand
37  (guile (define append2 append))
38  (mes))
39
40 (pass-if-equal "append" '(0 1) (append2 '(0) '(1)))
41 (pass-if-equal "append 2" '(0) (append2 '(0) '()))
42 (pass-if-equal "append 3" '(0 1 2) (append '(0) '(1) '(2)))
43
44 (pass-if-equal "cond #f" #t (cond (#f #f) (#t #t)))
45 (pass-if "cond #t" (cond (#t)))
46 (pass-if "cond #f" (cond (#f #f) (#t #t)))
47 (pass-if-equal "cond 2" *unspecified* (cond (#f)))
48 (pass-if-equal "cond 3" 0 (cond (#t 0)))
49 (pass-if-equal "cond 3a" 0 (cond (#f 1) (#t 0)))
50 (pass-if-equal "cond side effect"
51                1
52                ((lambda (i)
53                   (cond ((set! i (+ i 1)) i)))
54                 0))
55 (pass-if-equal "cond => "
56                0 ((lambda (lst)
57                     (define (next)
58                       ((lambda (r)
59                          (set! lst (cdr lst))
60                          r)
61                        (car lst)))
62                     (cond ((next) => identity)))
63                   '(0 1 2)))
64
65 (pass-if-equal "and" 1 (and 1))
66 (pass-if-not "and 2" (and 1 (= 0 1) #f))
67 (pass-if-not "or" (or))
68 (pass-if-equal "or 2" 1 (or 1))
69 (pass-if-equal "or 3" 3 (or #f (= 0 1) 3))
70 (pass-if "or 4" (or (= 0 0) (= 0 1)))
71 (pass-if "or 5" (or (= 0 1) (= 0 0)))
72 (pass-if-equal "or only once"
73                1
74                ((lambda ()
75                   (define read
76                     ((lambda (lst)
77                        (lambda ()
78                          ((lambda (r)
79                             (set! lst (cdr lst))
80                             r)
81                           (car lst))))
82                      '(1 0)))
83                   (or (read) #t))))
84
85 (pass-if-eq "let" 0 (let () 0))
86 (pass-if-eq "let 2" 0 (let ((x 0)) x))
87 (pass-if-eq "let 3" 11 (let ((p 5) (q 6)) (+ p q)))
88
89 (let () (define *top-let-define-a* '*top-let-define-a*) #t)
90 (pass-if-not "top let define " (defined? '*top-let-define-a*))
91
92 (pass-if "apply" (sequal? (apply list '(1)) '(1)))
93 (pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
94 (pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))
95 (begin
96   (define local-answer 41))
97 (pass-if-equal "begin 2" 41 (begin local-answer))
98
99 (pass-if-equal "primitive-load" 42 (primitive-load "tests/data/load.scm") the-answer)
100
101 (cond-expand
102  (guile)
103  (mes
104   (pass-if-equal "include" 42 (include "tests/data/load.scm") the-answer)))
105
106 (pass-if-eq "call/cc"
107     0
108     ((lambda (cont seen?)
109        (+ 1 (call/cc (lambda (c) (set! cont c) 1)))
110        (if seen? 0
111            (begin (set! seen? #t)
112                   (cont 2))))
113      #f #f))
114
115 (if (not guile?)
116     (pass-if-not "#<eof>"
117                  (char? (integer->char -1))))
118
119 (result 'report)