test-suite/lalr/glr-test.scm

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