1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
guile/test-suite/lalr/test-lr-error-recovery-01.scm
Ludovic Courtès 1b10152215 Add Boucher's lalr-scm' as the (system base lalr)' module.
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.
2010-03-31 00:41:59 +02:00

145 lines
4.7 KiB
Scheme

;;; test-lr-error-recovery-01.scm --
;;
;;Test error recovery with a terminator terminal.
;;
(load "common-test.scm")
(define (doit . tokens)
(let ((parser (lalr-parser
(expect: 0)
(NUMBER BAD NEWLINE)
(script (lines) : (reverse $1)
() : 0)
(lines (lines line) : (cons $2 $1)
(line) : (list $1))
(line (NEWLINE) : (list 'line $1)
(NUMBER NEWLINE) : (list 'line $1 $2)
(NUMBER NUMBER NEWLINE) : (list 'line $1 $2 $3)
;;This semantic action will cause "(recover $1
;;$2)" to be the result of the offending line.
(error NEWLINE) : (list 'recover $1 $2)))))
(parser (make-lexer tokens) error-handler)))
;;; --------------------------------------------------------------------
;;; No errors, grammar tests.
(check
(doit)
=> 0)
(check
(doit (make-lexical-token 'NEWLINE #f #\newline))
=> '((line #\newline)))
(check
(doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'NEWLINE #f #\newline))
=> '((line 1 #\newline)))
(check
(doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'NUMBER #f 2)
(make-lexical-token 'NEWLINE #f #\newline))
=> '((line 1 2 #\newline)))
(check
(doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 2)
(make-lexical-token 'NEWLINE #f #\newline))
=> '((line 1 #\newline)
(line 2 #\newline)))
(check
(doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 2)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 3)
(make-lexical-token 'NEWLINE #f #\newline))
=> '((line 1 #\newline)
(line 2 #\newline)
(line 3 #\newline)))
(check
(doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 2)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 3)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 41)
(make-lexical-token 'NUMBER #f 42)
(make-lexical-token 'NEWLINE #f #\newline))
=> '((line 1 #\newline)
(line 2 #\newline)
(line 3 #\newline)
(line 41 42 #\newline)))
;;; --------------------------------------------------------------------
;;; Successful error recovery.
(check
;;The BAD triggers an error, recovery happens, the first NEWLINE is
;;correctly parsed as recovery token; the second line is correct.
(let ((r (doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'BAD #f 'alpha)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 2)
(make-lexical-token 'NEWLINE #f #\newline))))
(cons r *error*))
=> '(((recover #f #f)
(line 2 #\newline))
(error-handler "Syntax error: unexpected token : " . BAD)))
(check
;;The first BAD triggers an error, recovery happens skipping the
;;second and third BADs, the first NEWLINE is detected as
;;synchronisation token; the second line is correct.
(let ((r (doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'BAD #f 'alpha)
(make-lexical-token 'BAD #f 'beta)
(make-lexical-token 'BAD #f 'delta)
(make-lexical-token 'NEWLINE #f #\newline)
(make-lexical-token 'NUMBER #f 2)
(make-lexical-token 'NEWLINE #f #\newline))))
(cons r *error*))
=> '(((recover #f #f)
(line 2 #\newline))
(error-handler "Syntax error: unexpected token : " . BAD)))
;;; --------------------------------------------------------------------
;;; Failed error recovery.
(check
;;End-of-input is found after NUMBER.
(let ((r (doit (make-lexical-token 'NUMBER #f 1))))
(cons r *error*))
=> '(#f (error-handler "Syntax error: unexpected end of input")))
(check
;;The BAD triggers the error, the stack is rewind up to the start,
;;then end-of-input happens while trying to skip tokens until the
;;synchronisation one is found. End-of-input is an acceptable token
;;after the start.
(let ((r (doit (make-lexical-token 'NUMBER #f 1)
(make-lexical-token 'BAD #f 'alpha)
(make-lexical-token 'BAD #f 'beta)
(make-lexical-token 'BAD #f 'delta))))
(cons r *error*))
=> '(0 (error-handler "Syntax error: unexpected token : " . BAD)))
(check
;;The BAD triggers the error, the stack is rewind up to the start,
;;then end-of-input happens while trying to skip tokens until the
;;synchronisation one is found. End-of-input is an acceptable token
;;after the start.
(let ((r (doit (make-lexical-token 'BAD #f 'alpha))))
(cons r *error*))
=> '(0 (error-handler "Syntax error: unexpected token : " . BAD)))
;;; end of file