Untabify some test files.

[bpt/guile.git] / test-suite / lalr / glr-test.scm

":";exec snow -- "$0" "$@"\r
;;;\r
;;;; Tests for the GLR parser generator\r
;;;\r
;;\r
;; @created   "Fri Aug 19 11:23:48 EDT 2005"\r
;;\r
\r
(package* glr-test/v1.0.0\r
  (require: lalr/v2.4.0))\r
\r
\r
(define (syntax-error msg . args)\r
  (display msg (current-error-port))\r
  (for-each (cut format (current-error-port) " ~A" <>) args)\r
  (newline (current-error-port))\r
  (throw 'misc-error))\r
\r
\r
(define (make-lexer words)\r
  (let ((phrase words))\r
    (lambda ()\r
      (if (null? phrase)\r
          '*eoi*\r
          (let ((word (car phrase)))\r
            (set! phrase (cdr phrase))\r
            word)))))\r
\r
\r
;;;\r
;;;; Test 1\r
;;;\r
\r
\r
(define parser-1\r
  ;; Grammar taken from Tomita's "An Efficient Augmented-Context-Free Parsing Algorithm"\r
  (lalr-parser\r
   (driver: glr)\r
   (expect: 2)\r
   (*n *v *d *p)\r
   (<s>  (<np> <vp>)\r
         (<s> <pp>))\r
   (<np> (*n)\r
         (*d *n)\r
         (<np> <pp>))\r
   (<pp> (*p <np>))\r
   (<vp> (*v <np>))))\r
\r
\r
(define *phrase-1* '(*n *v *d *n *p *d *n *p *d *n *p *d *n))\r
\r
(define (test-1)\r
  (parser-1 (make-lexer *phrase-1*) syntax-error))\r
\r
\r
;;;\r
;;;; Test 2\r
;;;\r
\r
\r
(define parser-2\r
  ;; The dangling-else problem\r
  (lalr-parser\r
   (driver: glr)\r
   (expect: 1)\r
   ((nonassoc: if then else e s))\r
   (<s> (s)\r
        (if e then <s>)\r
        (if e then <s> else <s>))))\r
\r
\r
(define *phrase-2* '(if e then if e then s else s))\r
\r
(define (test-2)\r
  (parser-2 (make-lexer *phrase-2*) syntax-error))\r
\r
\r
\r
\r
(define (assert-length l n test-name)\r
  (display "Test '") \r
  (display test-name)\r
  (display (if (not (= (length l) n)) "' failed!" "' passed!"))\r
  (newline))\r
\r
(assert-length (test-1) 14 1)\r
(assert-length (test-2) 2 2)\r
\r