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) <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.

(cherry picked from commit 7b94c6b00b287d2b69d466380a05de7e0ec21ee9)

diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el
index 2eb4a7384d094b3833bef61decdd5e6bbba428d7..bb57650d88377a987a4298d542da6b33450ff48e 100644 (file)
--- 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 <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)

diff --git a/test/lisp/progmodes/peg-tests.el b/test/lisp/progmodes/peg-tests.el
index 864e09b4200af698ca042e9b252616d2ab7d2edb..e666e6f19d244ada4416a7ce16e90660e82d8c1b 100644 (file)
--- 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)))