From 2b7ce7a531298ef50fe6fd98126485cc56175b02 Mon Sep 17 00:00:00 2001 Message-Id: <2b7ce7a531298ef50fe6fd98126485cc56175b02.1716528989.git.mdw@distorted.org.uk> From: Mark Wooding Date: Thu, 26 May 2016 09:26:09 +0100 Subject: [PATCH] src/final.lisp: Improve `test-parser' for testing error reporting. Organization: Straylight/Edgeware From: Mark Wooding This is nearly a rewrite. By default, print errors and warnings encountered during the parse, so that I can test how well the various parsers cope with errors. The output has changed, and there's a new `:backtrace' keyword argument for disabling the error-trapping, to make it easier to track down unexpected errors. The new code is a little tricky. A `token-scanner' tries to lex its first token during initialization (`priming the pump'), and can therefore emit lexical errors at this point. We must therefore establish `count-and-report-errors' around construction of the token scanner; but it shouldn't be wrapped around the output stage -- partly because I think I want to debug errors in that in the traditional way, but mostly because the output includes the error counts. So declare the scanner variables early, but initialize them later, inside the body function. This leaves a further problem: if priming the pump fails badly, then `scanner' won't get set; so guard the final output item from silliness in this case. --- doc/misc.tex | 4 ++-- src/final.lisp | 50 ++++++++++++++++++++++++++++++++++---------------- 2 files changed, 36 insertions(+), 18 deletions(-) diff --git a/doc/misc.tex b/doc/misc.tex index 68fba6d..d672d42 100644 --- a/doc/misc.tex +++ b/doc/misc.tex @@ -547,8 +547,8 @@ These symbols are defined in the @!optparse| package. \end{describe} \begin{describe}{mac} - {test-parser (@) @ @ - @> @ @ @} + {test-parser (@ \&key :backtrace) @ @ + @> @ @ @} \end{describe} \begin{describe}{fun}{exercise} diff --git a/src/final.lisp b/src/final.lisp index 1b87c26..e7a3eb4 100644 --- a/src/final.lisp +++ b/src/final.lisp @@ -74,29 +74,47 @@ (defun test-parse-c-type (string) (values nil value))))))) (export 'test-parser) -(defmacro test-parser ((scanner &key) parser input) +(defmacro test-parser ((scanner &key backtrace) parser input) "Convenient macro for testing parsers at the REPL. This is a macro so that the parser can use the fancy syntax. The name SCANNER is bound to a `sod-token-scanner' reading tokens from the INPUT - string. Then the PARSER is invoked and three values are returned: a - `successp' flag indicating whether the parser succeeded; the result, - output or error indicator, of the parser; and a list consisting of the - lookahead token type and value, and a string containing the untokenized - remaining input." + string. Then the PARSER is invoked and three values are returned: the + result of the parse, or `nil' if the main parse failed; a list containing + the number of errors and warnings (respectively) reported during the + parse; and a list consisting of the lookahead token type and value, and a + string containing the untokenized remaining input. + + If BACKTRACE is nil (the default) then leave errors to the calling + environment to sort out (e.g., by entering the Lisp debugger); otherwise, + catch and report them as they happen so that you can test error recovery + strategies." (once-only (input) - (with-gensyms (char-scanner value winp consumedp where) - `(let* ((,char-scanner (make-string-scanner ,input)) - (,scanner (make-instance 'sod-token-scanner - :char-scanner ,char-scanner - :filename ""))) + (with-gensyms (char-scanner value winp body consumedp where nerror nwarn) + `(let ((,char-scanner nil) (,scanner nil)) (with-parser-context (token-scanner-context :scanner ,scanner) - (multiple-value-bind (,value ,winp ,consumedp) (parse ,parser) - (declare (ignore ,consumedp)) + (multiple-value-bind (,value ,nerror ,nwarn) + (flet ((,body () + (setf ,char-scanner (make-string-scanner ,input) + ,scanner (make-instance + 'sod-token-scanner + :char-scanner ,char-scanner)) + (multiple-value-bind (,value ,winp ,consumedp) + (parse ,parser) + (declare (ignore ,consumedp)) + (cond (,winp ,value) + (t (syntax-error ,scanner ,value) + nil))))) + (if ,backtrace (,body) + (count-and-report-errors () + (with-default-error-location (,scanner) + (,body))))) (let ((,where (scanner-capture-place ,char-scanner))) - (values ,winp ,value - (list (token-type ,scanner) (token-value ,scanner) - (subseq ,input ,where)))))))))) + (values ,value + (list ,nerror ,nwarn) + (and ,scanner (list (token-type ,scanner) + (token-value ,scanner) + (subseq ,input ,where))))))))))) ;;;-------------------------------------------------------------------------- ;;; Calisthenics. -- [mdw]