Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 84 lines (60 sloc) 1.615 kb
1a7ad61 @schemeway Initial revision
authored
1 ;;;
2 ;;;; Tests for the GLR parser generator
3 ;;;
4 ;;
5 ;; @created "Fri Aug 19 11:23:48 EDT 2005"
6 ;;
7
8 (define (syntax-error msg . args)
9 (display msg (current-error-port))
10 (for-each (cut format (current-error-port) " ~A" <>) args)
11 (newline (current-error-port))
12 (throw 'misc-error))
13
14
15 (define (make-lexer words)
16 (let ((phrase words))
17 (lambda ()
18 (if (null? phrase)
19 '*eoi*
20 (let ((word (car phrase)))
21 (set! phrase (cdr phrase))
22 word)))))
23
24
25 ;;;
26 ;;;; Test 1
27 ;;;
28
29
30 (define parser-1
31 ;; Grammar taken from Tomita's "An Efficient Augmented-Context-Free Parsing Algorithm"
32 (lalr-parser
33 (driver: glr)
34 (expect: 2)
35 (*n *v *d *p)
36 (<s> (<np> <vp>)
37 (<s> <pp>))
38 (<np> (*n)
39 (*d *n)
40 (<np> <pp>))
41 (<pp> (*p <np>))
42 (<vp> (*v <np>))))
43
44
45 (define *phrase-1* '(*n *v *d *n *p *d *n *p *d *n *p *d *n))
46
47 (define (test-1)
48 (parser-1 (make-lexer *phrase-1*) syntax-error))
49
50
51 ;;;
52 ;;;; Test 2
53 ;;;
54
55
56 (define parser-2
57 ;; The dangling-else problem
58 (lalr-parser
59 (driver: glr)
60 (expect: 1)
61 ((nonassoc: if then else e s))
62 (<s> (s)
63 (if e then <s>)
64 (if e then <s> else <s>))))
65
66
67 (define *phrase-2* '(if e then if e then s else s))
68
69 (define (test-2)
70 (parser-2 (make-lexer *phrase-2*) syntax-error))
71
72
73
74
75 (define (assert-length l n test-name)
76 (display "Test '")
77 (display test-name)
78 (display (if (not (= (length l) n)) "' failed!" "' passed!"))
79 (newline))
80
81 (assert-length (test-1) 14 1)
82 (assert-length (test-2) 2 2)
83
Something went wrong with that request. Please try again.