source: project/release/4/tuples/trunk/tests/run.scm @ 29790

Last change on this file since 29790 was 29790, checked in by juergen, 7 years ago

minor code changes

File size: 2.6 KB
Line 
1; Author: Juergen Lorenz
2;         ju (at) jugilo (dot) de
3
4
5(require-library tuples simple-tests dbc)
6
7(import tuples triples couples singles simple-tests dbc)
8
9(contract-check-level 2)
10
11
12(compound-test ("TUPLES")
13(simple-test ("TUPLES")
14  (define tup (tuple 0 1 2 3))
15  (equal? (tuple->list tup) '(0 1 2 3))
16  (tuple-eql? = tup '#,(tuple 0 1 2 3))
17  (tuple-equal? tup (tuple 0 1 2 3))
18  (tuple? tup)
19  (= (tuple-length tup) 4)
20  (= (tuple-ref tup 2) 2)
21  (= (tuple-find (lambda (x) (= x 2)) tup) 2)
22  (not (tuple-find (cut = <> 4) tup))
23  (equal? (tuple->list (tuple-map add1 tup)) '(1 2 3 4))
24  (tuple-eqv? (tuple-map + tup (tuple 0 10 20 30) (tuple 0 100 200 300))
25              (tuple 0 111 222 333))
26  (equal?
27    (let ((result '()))
28      (tuple-for-each (lambda (x) (set! result (cons x result)))
29                      tup)
30      result)
31    '(3 2 1 0))
32  (receive (head tail) (tuple-split tup 2)
33    (and (equal? (tuple->list head) '(0 1))
34         (equal? (tuple->list tail) '(2 3))))
35  (equal? (tuple->list (tuple-copy tup)) '(0 1 2 3))
36  (equal? (tuple->list (tuple-from-upto tup 2 3)) '(2))
37  (equal? (tuple->list (tuple-from-upto tup 2)) '(2 3))
38  (equal? (tuple->list (tuple)) '())
39  (tuple-empty? (tuple))
40  ((tuple-of? even?) (tuple))
41  (not ((tuple-of? even?) (tuple 1 2 3)))
42  ((tuple-of? even?) (tuple 2 4 6))
43  (not (tuple? 3))
44  (= (tuple-length (tuple)) 0)
45  (not (tuple-find (cut = 3 <>) (tuple)))
46  (= (tuple-find (cut = 2 <>) tup) 2)
47  (not (tuple-equal? (tuple) (tuple 1)))
48  (tuple-eql? = (list->tuple '(0 1 2 3)) tup)
49  (tuple-eqv? (list->tuple '()) (tuple))
50  (tuple-eq? (tuple-map add1 (tuple)) (tuple))
51  (tuple-equal? (tuple-append (tuple 0 1 2) (tuple 3) (tuple 4 5))
52                (tuple 0 1 2 3 4 5))
53  (tuple-eqv? (tuple-butleft tup) (tuple 1 2 3))
54  (tuple-eqv? (tuple-butright tup) (tuple 0 1 2))
55  (tuple-eqv? (tuple-tail tup 2) (tuple 2 3))
56  (tuple-eqv? (tuple-head tup 2) (tuple 0 1))
57  (tuple-eqv? (tuple-cons-left 0 (tuple-butleft tup)) tup)
58  (tuple-eqv? (tuple-cons-right 3 (tuple-butright tup)) tup)
59  (not (tuple-empty? (tuple 1 2)))
60  (not (tuple-empty? 3))
61  )
62
63(simple-test ("MUTABLE SINGLES")
64  (single? (single 1))
65  (not (single? 3))
66  (define sgl (single 0))
67  (= (single-ref sgl) 0)
68  (= (begin (single-set! sgl 2) (single-ref sgl)) 2)
69  )
70
71(simple-test ("COUPLES")
72  (define cpl (couple 0 1))
73  (couple? cpl)
74  (not (triple? cpl))
75  (= (couple-left cpl) 0)
76  (= (couple-right cpl) 1)
77  )
78
79(simple-test ("TRIPLES")
80  (define trp (triple 0 1 2))
81  (not (couple? trp))
82  (tuple? (couple->tuple cpl))
83  (not (tuple? trp))
84  (tuple? (triple->tuple trp))
85  (triple? trp)
86  (= (triple-left trp) 0)
87  (= (triple-middle trp) 1)
88  (= (triple-right trp) 2)
89))
Note: See TracBrowser for help on using the repository browser.