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

Last change on this file since 30448 was 30448, checked in by juergen, 6 years ago

tuples 1.2 with simple-test replaced by compound-test

File size: 2.9 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(define-test (tuples?)
13  (check
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(define-test (singles?)
64  (check
65    (single? (single 1))
66    (not (single? 3))
67    (define sgl (single 0))
68    (= (single-ref sgl) 0)
69    (= (begin (single-set! sgl 2) (single-ref sgl)) 2)
70    ))
71
72(define-test (couples?)
73  (check
74    (define cpl (couple 0 1))
75    (couple? cpl)
76    (not (triple? cpl))
77    (= (couple-left cpl) 0)
78    (= (couple-right cpl) 1)
79    ))
80
81(define-test (triples?)
82  (check
83    (define trp (triple 0 1 2))
84    (not (couple? trp))
85    (tuple? (couple->tuple cpl))
86    (not (tuple? trp))
87    (tuple? (triple->tuple trp))
88    (triple? trp)
89    (= (triple-left trp) 0)
90    (= (triple-middle trp) 1)
91    (= (triple-right trp) 2)
92  ))
93
94(compound-test (TUPLES)
95  (tuples?)
96  (singles?)
97  (couples?)
98  (triples?)
99  )
Note: See TracBrowser for help on using the repository browser.