Commit | Line | Data |
---|---|---|
1b101522 LC |
1 | ;;; common-test.scm -- |
2 | ;;; | |
3 | ||
4 | ;; Slightly modified for Guile by Ludovic Courtès <ludo@gnu.org>, 2010. | |
5 | ||
6 | (use-modules (system base lalr) | |
7 | (ice-9 pretty-print)) | |
8 | ||
9 | (define *error* '()) | |
10 | ||
11 | (define-syntax when | |
12 | (syntax-rules () | |
13 | ((_ ?expr ?body ...) | |
14 | (if ?expr | |
15 | (let () ?body ...) | |
16 | #f)))) | |
17 | ||
18 | (define-syntax check | |
19 | (syntax-rules (=>) | |
20 | ((_ ?expr => ?expected-result) | |
21 | (check ?expr (=> equal?) ?expected-result)) | |
22 | ||
23 | ((_ ?expr (=> ?equal) ?expected-result) | |
24 | (let ((result ?expr) | |
25 | (expected ?expected-result)) | |
26 | (set! *error* '()) | |
27 | (when (not (?equal result expected)) | |
28 | (display "Failed test: \n") | |
29 | (pretty-print (quote ?expr))(newline) | |
30 | (display "\tresult was: ") | |
31 | (pretty-print result)(newline) | |
32 | (display "\texpected: ") | |
33 | (pretty-print expected)(newline) | |
34 | (exit 1)))))) | |
35 | ||
36 | ;;; -------------------------------------------------------------------- | |
37 | ||
38 | (define (display-result v) | |
39 | (if v | |
40 | (begin | |
41 | (display "==> ") | |
42 | (display v) | |
43 | (newline)))) | |
44 | ||
45 | (define eoi-token | |
46 | (make-lexical-token '*eoi* #f #f)) | |
47 | ||
48 | (define (make-lexer tokens) | |
49 | (lambda () | |
50 | (if (null? tokens) | |
51 | eoi-token | |
52 | (let ((t (car tokens))) | |
53 | (set! tokens (cdr tokens)) | |
54 | t)))) | |
55 | ||
56 | (define (error-handler message . args) | |
57 | (set! *error* (cons `(error-handler ,message . ,(if (pair? args) | |
58 | (lexical-token-category (car args)) | |
59 | '())) | |
60 | *error*)) | |
61 | (cons message args)) | |
62 | ||
63 | ;;; end of file |