procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

peg-tests.el: Fix test failures

Browse source 
* lisp/progmodes/peg.el (peg-parse): Refine heuristic since unknown
terminals are resolved at run-time rather than compile-time now.
(peg--macroexpand) <stack-action>: Avoid generating a `let` with an
empty body.
(peg--translate-rule-body): Adjust to name change of
`macroexp-warn-and-return` and the fact that it's always available.

* test/lisp/progmodes/peg-tests.el (peg-parse-string):
Add `indent` declaration.
(peg-test): Check that the compiler emits the warnings we expect.
This commit is contained in:
Stefan Monnier 2024-04-13 15:35:46 -04:00
parent 17e26cf57e
commit 7b94c6b00b
2 changed files with 33 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lisp/progmodes/peg.el
View file

@ -1,6 +1,6 @@
;;; peg.el --- Parsing Expression Grammars in Emacs Lisp -*- lexical-binding:t -*-
;; Copyright (C) 2008-2023 Free Software Foundation, Inc.
;; Copyright (C) 2008-2024 Free Software Foundation, Inc.
;;
;; Author: Helmut Eller <eller.helmut@gmail.com>
;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca>
@ -320,7 +320,8 @@ moving point along the way.
PEXS can also be a list of PEG rules, in which case the first rule is used."
(if (and (consp (car pexs))
(symbolp (caar pexs))
(not (ignore-errors (peg-normalize (car pexs)))))
(not (ignore-errors
(not (eq 'call (car (peg-normalize (car pexs))))))))
;; `pexs' is a list of rules: use the first rule as entry point.
`(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure))
`(peg-run (peg ,@pexs) #'peg-signal-failure)))
@ -544,7 +545,8 @@ rulesets defined previously with `define-peg-ruleset'."
(let ((args (cdr (member '-- (reverse form))))
(values (cdr (member '-- form))))
(let ((form `(let ,(mapcar (lambda (var) `(,var (pop peg--stack))) args)
,@(mapcar (lambda (val) `(push ,val peg--stack)) values))))
,@(or (mapcar (lambda (val) `(push ,val peg--stack)) values)
'(nil)))))
`(action ,form))))
(defvar peg-char-classes
@ -642,11 +644,7 @@ rulesets defined previously with `define-peg-ruleset'."
(code (peg-translate-exp exp)))
(cond
((null msg) code)
((fboundp 'macroexp--warn-and-return)
(macroexp--warn-and-return msg code))
(t
(message "%s" msg)
code))))
(t (macroexp-warn-and-return msg code)))))
;; This is the main translation function.
(defun peg-translate-exp (exp)

35
test/lisp/progmodes/peg-tests.el
View file

@ -1,6 +1,6 @@
;;; peg-tests.el --- Tests of PEG parsers -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2023 Free Software Foundation, Inc.
;; Copyright (C) 2008-2024 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@ -30,6 +30,7 @@
"Parse STRING according to PEX.
If NOERROR is non-nil, push nil resp. t if the parse failed
resp. succeeded instead of signaling an error."
(declare (indent 1))
(let ((oldstyle (consp (car-safe pex)))) ;PEX is really a list of rules.
`(with-temp-buffer
(insert ,string)
@ -105,15 +106,33 @@ resp. succeeded instead of signaling an error."
(substring [0-9]))))
"ab0cd1ef2gh")
'("2")))
;; The PEG rule `other' doesn't exist, which will cause a byte-compiler
;; The PEG rule `doesntexist' doesn't exist, which will cause a byte-compiler
;; warning, but not an error at run time because the rule is not actually
;; used in this particular case.
(should (equal (peg-parse-string ((s (substring (or "a" other)))
;; Unused left-recursive rule, should
;; cause a byte-compiler warning.
(r (* "a") r))
"af")
'("a")))
(let* ((testfun '(lambda ()
(peg-parse-string ((s (substring (or "a" doesntexist)))
;; Unused left-recursive rule, should
;; cause a byte-compiler warning.
(r (* "a") r))
"af")))
(compiledfun
(progn
(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer)))
(let ((lexical-binding t)) (byte-compile testfun)))))
(with-current-buffer (get-buffer-create "*Compile-Log*")
(goto-char (point-min))
(should
;; FIXME: The byte-compiler emits "not known to be defined"
;; warnings when compiling a file but not from `byte-compile'.
;; Instead, we have to dig it out of the mess it leaves behind. 🙂
(or (assq 'peg-rule\ doesntexist byte-compile-unresolved-functions)
(should (re-search-forward
"peg-rule.? doesntexist.*not known to be defined" nil t))))
(goto-char (point-min))
(should (re-search-forward "left recursion.*r -> r" nil t)))
(should (equal (funcall compiledfun) '("a"))))
(should (equal (peg-parse-string ((s (list x y))
(x `(-- 1))
(y `(-- 2)))