mescc: Mes C Library: Avoid type/size_t conflicts.
[mes.git] / tests / optargs.test
1 #! /bin/sh
2 # -*-scheme-*-
3 exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests optargs)' -s "$0" "$@"
4 !#
5
6 ;;; -*-scheme-*-
7
8 ;;; GNU Mes --- Maxwell Equations of Software
9 ;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
10 ;;;
11 ;;; This file is part of GNU Mes.
12 ;;;
13 ;;; GNU Mes is free software; you can redistribute it and/or modify it
14 ;;; under the terms of the GNU General Public License as published by
15 ;;; the Free Software Foundation; either version 3 of the License, or (at
16 ;;; your option) any later version.
17 ;;;
18 ;;; GNU Mes is distributed in the hope that it will be useful, but
19 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21 ;;; GNU General Public License for more details.
22 ;;;
23 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
25
26 (define-module (tests optargs)
27   #:use-module (mes optargs)
28   #:use-module (mes mes-0)
29   #:use-module (mes test))
30
31 (cond-expand
32  (mes
33   (mes-use-module (mes optargs))
34   (mes-use-module (mes test)))
35  (else))
36
37 (pass-if-equal "cond =>" 10
38   (cond
39    (5 => (lambda (p) (* p 2)))))
40 (pass-if-equal "cond => 2" 10
41   (cond
42    (#f (display "hallo") (newline))
43    (5 => (lambda (p) (* p 2)))
44    (#t (display "wereld" (newline)))))
45 (pass-if-equal "cond => last" 10
46   (cond
47    (#f (display "hallo") (newline))
48    (5 => (lambda (p) (* p 2)))))
49
50 (pass-if "keyword?" (keyword? #:foo))
51 (pass-if "keywords" (eq? #:foo #:foo))
52 (pass-if-equal "keyword->symbol" 'foo (keyword->symbol #:foo))
53 (pass-if-equal "symbol->keyword" #:foo (symbol->keyword 'foo))
54 (pass-if-not "keywords" (eq? #:foo ':foo))
55
56 (pass-if "optargs #:optional" ((lambda* (#:optional (x #f)) x) #t))
57 (pass-if-equal "optargs #:optional default" #f ((lambda* (#:optional (x #f)) x)))
58 (pass-if "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t))
59 (pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo)))
60
61 (define <info> '<info>)
62 (define <functions> '<functions>)
63 (define <globals> '<globals>)
64 (define <locals> '<locals>)
65 (define <text> '<text>)
66
67 (define* (make o #:key (functions '()) (globals '()) (locals '()) (text '()))
68   (list <info>
69         (cons <functions> functions)
70         (cons <globals> globals)
71         (cons <locals> locals)
72         (cons <text> text)))
73
74 (define (.functions o)
75   (assq-ref (cdr o) <functions>))
76
77 (define (.globals o)
78   (assq-ref (cdr o) <globals>))
79
80 (define (.locals o)
81   (assq-ref (cdr o) <locals>))
82
83 (define (.text o)
84   (assq-ref (cdr o) <text>))
85
86 (define (info? o)
87   (and (pair? o) (eq? (car o) <info>)))
88
89 (define (clone o . rest)
90   (cond ((info? o)
91          (let ((functions (.functions o))
92                (globals (.globals o))
93                (locals (.locals o))
94                (text (.text o)))
95            (let-keywords rest
96                          #f
97                          ((functions functions)
98                           (globals globals)
99                           (locals locals)
100                           (text text))
101                          (make <info> #:functions functions #:globals globals #:locals locals #:text text))))))
102
103 (pass-if-equal "clone <info>"
104     (make <info> #:functions '(0))
105   (clone (make <info>) #:functions '(0)))
106
107 (result 'report)