mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
1b10152215
Taken from r51 of <http://lalr-scm.googlecode.com/svn/trunk>. * module/Makefile.am (SYSTEM_BASE_SOURCES): Add `system/base/lalr.scm'. (NOCOMP_SOURCES): Add `system/base/lalr.upstream.scm'. * module/system/base/lalr.scm, module/system/base/lalr.upstream.scm: New files. * test-suite/Makefile.am (LALR_TESTS, LALR_EXTRA, TESTS, TESTS_ENVIRONMENT): New variables. (EXTRA_DIST): Add $(LALR_EXTRA). * test-suite/lalr/common-test.scm, test-suite/lalr/glr-test.scm, test-suite/lalr/test-glr-associativity.scm, test-suite/lalr/test-glr-basics-01.scm, test-suite/lalr/test-glr-basics-02.scm, test-suite/lalr/test-glr-basics-03.scm, test-suite/lalr/test-glr-basics-04.scm, test-suite/lalr/test-glr-basics-05.scm, test-suite/lalr/test-glr-script-expression.scm, test-suite/lalr/test-glr-single-expressions.scm, test-suite/lalr/test-lr-associativity-01.scm, test-suite/lalr/test-lr-associativity-02.scm, test-suite/lalr/test-lr-associativity-03.scm, test-suite/lalr/test-lr-associativity-04.scm, test-suite/lalr/test-lr-basics-01.scm, test-suite/lalr/test-lr-basics-02.scm, test-suite/lalr/test-lr-basics-03.scm, test-suite/lalr/test-lr-basics-04.scm, test-suite/lalr/test-lr-basics-05.scm, test-suite/lalr/test-lr-error-recovery-01.scm, test-suite/lalr/test-lr-error-recovery-02.scm, test-suite/lalr/test-lr-no-clause.scm, test-suite/lalr/test-lr-script-expression.scm, test-suite/lalr/test-lr-single-expressions.scm: New files.
119 lines
3 KiB
Scheme
119 lines
3 KiB
Scheme
;;; test-lr-script-expression.scm --
|
|
;;
|
|
;;Parse scripts, each line an expression.
|
|
;;
|
|
|
|
(load "common-test.scm")
|
|
|
|
(define (doit . tokens)
|
|
(let ((parser (lalr-parser (expect: 0)
|
|
(N O C T (left: A) (left: M) (nonassoc: U))
|
|
|
|
(script (lines) : (reverse $1))
|
|
|
|
(lines (lines line) : (cons $2 $1)
|
|
(line) : (list $1))
|
|
|
|
(line (T) : #\newline
|
|
(E T) : $1
|
|
(error T) : (list 'error-clause $2))
|
|
|
|
(E (N) : $1
|
|
(E A E) : ($2 $1 $3)
|
|
(E M E) : ($2 $1 $3)
|
|
(A E (prec: U)) : ($1 $2)
|
|
(O E C) : $2))))
|
|
(parser (make-lexer tokens) error-handler)))
|
|
|
|
;;; --------------------------------------------------------------------
|
|
;;; Correct input
|
|
|
|
(check
|
|
(doit (make-lexical-token 'T #f #\newline))
|
|
=> '(#\newline))
|
|
|
|
(check
|
|
(doit (make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'T #f #\newline))
|
|
=> '(1))
|
|
|
|
(check
|
|
(doit (make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'N #f 2)
|
|
(make-lexical-token 'T #f #\newline))
|
|
=> '(3))
|
|
|
|
(check
|
|
(doit (make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'N #f 2)
|
|
(make-lexical-token 'M #f *)
|
|
(make-lexical-token 'N #f 3)
|
|
(make-lexical-token 'T #f #\newline))
|
|
=> '(7))
|
|
|
|
(check
|
|
(doit (make-lexical-token 'O #f #\()
|
|
(make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'N #f 2)
|
|
(make-lexical-token 'C #f #\))
|
|
(make-lexical-token 'M #f *)
|
|
(make-lexical-token 'N #f 3)
|
|
(make-lexical-token 'T #f #\newline))
|
|
=> '(9))
|
|
|
|
(check
|
|
(doit (make-lexical-token 'O #f #\()
|
|
(make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'N #f 2)
|
|
(make-lexical-token 'C #f #\))
|
|
(make-lexical-token 'M #f *)
|
|
(make-lexical-token 'N #f 3)
|
|
(make-lexical-token 'T #f #\newline)
|
|
|
|
(make-lexical-token 'N #f 4)
|
|
(make-lexical-token 'M #f /)
|
|
(make-lexical-token 'N #f 5)
|
|
(make-lexical-token 'T #f #\newline))
|
|
=> '(9 4/5))
|
|
|
|
;;; --------------------------------------------------------------------
|
|
|
|
(check
|
|
;;Successful error recovery.
|
|
(doit (make-lexical-token 'O #f #\()
|
|
(make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'N #f 2)
|
|
(make-lexical-token 'M #f *)
|
|
(make-lexical-token 'N #f 3)
|
|
(make-lexical-token 'T #f #\newline)
|
|
|
|
(make-lexical-token 'N #f 4)
|
|
(make-lexical-token 'M #f /)
|
|
(make-lexical-token 'N #f 5)
|
|
(make-lexical-token 'T #f #\newline))
|
|
=> '((error-clause #f)
|
|
4/5))
|
|
|
|
(check
|
|
;;Unexpected end of input.
|
|
(let ((r (doit (make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'N #f 2))))
|
|
(cons r *error*))
|
|
=> '(#f (error-handler "Syntax error: unexpected end of input")))
|
|
|
|
(check
|
|
;;Unexpected end of input.
|
|
(let ((r (doit (make-lexical-token 'N #f 1)
|
|
(make-lexical-token 'A #f +)
|
|
(make-lexical-token 'T #f #\newline))))
|
|
(cons r *error*))
|
|
=> '(((error-clause #f))
|
|
(error-handler "Syntax error: unexpected token : " . T)))
|
|
|
|
;;; end of file
|