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 | ||
1b101522 LC |
11 | (define-syntax check |
12 | (syntax-rules (=>) | |
13 | ((_ ?expr => ?expected-result) | |
14 | (check ?expr (=> equal?) ?expected-result)) | |
15 | ||
16 | ((_ ?expr (=> ?equal) ?expected-result) | |
17 | (let ((result ?expr) | |
18 | (expected ?expected-result)) | |
19 | (set! *error* '()) | |
20 | (when (not (?equal result expected)) | |
21 | (display "Failed test: \n") | |
22 | (pretty-print (quote ?expr))(newline) | |
23 | (display "\tresult was: ") | |
24 | (pretty-print result)(newline) | |
25 | (display "\texpected: ") | |
26 | (pretty-print expected)(newline) | |
27 | (exit 1)))))) | |
28 | ||
29 | ;;; -------------------------------------------------------------------- | |
30 | ||
31 | (define (display-result v) | |
32 | (if v | |
33 | (begin | |
34 | (display "==> ") | |
35 | (display v) | |
36 | (newline)))) | |
37 | ||
38 | (define eoi-token | |
39 | (make-lexical-token '*eoi* #f #f)) | |
40 | ||
41 | (define (make-lexer tokens) | |
42 | (lambda () | |
43 | (if (null? tokens) | |
44 | eoi-token | |
45 | (let ((t (car tokens))) | |
46 | (set! tokens (cdr tokens)) | |
47 | t)))) | |
48 | ||
49 | (define (error-handler message . args) | |
50 | (set! *error* (cons `(error-handler ,message . ,(if (pair? args) | |
51 | (lexical-token-category (car args)) | |
52 | '())) | |
53 | *error*)) | |
54 | (cons message args)) | |
55 | ||
56 | ;;; end of file |