From 73bbf8d31249c786e406f03faac05c48bdc65ecf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Apr 2024 15:35:46 -0400 Subject: [PATCH] peg-tests.el: Fix test failures * lisp/progmodes/peg.el (peg-parse): Refine heuristic since unknown terminals are resolved at run-time rather than compile-time now. (peg--macroexpand) : 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. (cherry picked from commit 7b94c6b00b287d2b69d466380a05de7e0ec21ee9) --- lisp/progmodes/peg.el | 14 ++++++------- test/lisp/progmodes/peg-tests.el | 35 ++++++++++++++++++++++++-------- 2 files changed, 33 insertions(+), 16 deletions(-) diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index 2eb4a7384d0..bb57650d883 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -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 ;; Maintainer: Stefan Monnier @@ -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) diff --git a/test/lisp/progmodes/peg-tests.el b/test/lisp/progmodes/peg-tests.el index 864e09b4200..e666e6f19d2 100644 --- a/test/lisp/progmodes/peg-tests.el +++ b/test/lisp/progmodes/peg-tests.el @@ -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))) -- 2.39.5