Commit | Line | Data |
---|---|---|
012a3a75 MV |
1 | ; CONFIDENCE TEST FOR IMPLEMENTATION OF SRFI-26 |
2 | ; ============================================= | |
3 | ; | |
4 | ; Sebastian.Egner@philips.com, 3-Jun-2002. | |
5 | ; | |
6 | ; This file checks a few assertions about the implementation. | |
7 | ; If you run it and no error message is issued, the implementation | |
8 | ; is correct on the cases that have been tested. | |
9 | ; | |
10 | ; compliance: | |
11 | ; Scheme R5RS with | |
12 | ; SRFI-23: error | |
13 | ; | |
14 | ; loading this file into Scheme 48 0.57 after 'cut.scm' has been loaded: | |
15 | ; ,open srfi-23 | |
16 | ; ,load check.scm | |
17 | ||
18 | ; (check expr) | |
19 | ; evals expr and issues an error if it is not #t. | |
20 | ||
21 | (define-module (test-srfi-26) | |
22 | #:use-module (test-suite lib) | |
23 | #:use-module (srfi srfi-26)) | |
24 | ||
25 | (define (check expr) | |
26 | (pass-if "cut/cute" (eval expr (interaction-environment)))) | |
27 | ||
28 | ; (check-all) | |
29 | ; runs several tests on cut and reports. | |
30 | ||
31 | (define (check-all) | |
32 | (for-each | |
33 | check | |
34 | '( ; cuts | |
35 | (equal? ((cut list)) '()) | |
36 | (equal? ((cut list <...>)) '()) | |
37 | (equal? ((cut list 1)) '(1)) | |
38 | (equal? ((cut list <>) 1) '(1)) | |
39 | (equal? ((cut list <...>) 1) '(1)) | |
40 | (equal? ((cut list 1 2)) '(1 2)) | |
41 | (equal? ((cut list 1 <>) 2) '(1 2)) | |
42 | (equal? ((cut list 1 <...>) 2) '(1 2)) | |
43 | (equal? ((cut list 1 <...>) 2 3 4) '(1 2 3 4)) | |
44 | (equal? ((cut list 1 <> 3 <>) 2 4) '(1 2 3 4)) | |
45 | (equal? ((cut list 1 <> 3 <...>) 2 4 5 6) '(1 2 3 4 5 6)) | |
46 | (equal? (let* ((x 'wrong) (y (cut list x))) (set! x 'ok) (y)) '(ok)) | |
47 | (equal? | |
48 | (let ((a 0)) | |
49 | (map (cut + (begin (set! a (+ a 1)) a) <>) | |
50 | '(1 2)) | |
51 | a) | |
52 | 2) | |
53 | ; cutes | |
54 | (equal? ((cute list)) '()) | |
55 | (equal? ((cute list <...>)) '()) | |
56 | (equal? ((cute list 1)) '(1)) | |
57 | (equal? ((cute list <>) 1) '(1)) | |
58 | (equal? ((cute list <...>) 1) '(1)) | |
59 | (equal? ((cute list 1 2)) '(1 2)) | |
60 | (equal? ((cute list 1 <>) 2) '(1 2)) | |
61 | (equal? ((cute list 1 <...>) 2) '(1 2)) | |
62 | (equal? ((cute list 1 <...>) 2 3 4) '(1 2 3 4)) | |
63 | (equal? ((cute list 1 <> 3 <>) 2 4) '(1 2 3 4)) | |
64 | (equal? ((cute list 1 <> 3 <...>) 2 4 5 6) '(1 2 3 4 5 6)) | |
65 | (equal? | |
66 | (let ((a 0)) | |
67 | (map (cute + (begin (set! a (+ a 1)) a) <>) | |
68 | '(1 2)) | |
69 | a) | |
70 | 1)))) | |
71 | ||
72 | ; run the checks when loading | |
73 | (with-test-prefix "SRFI-26" | |
74 | (check-all)) |