From 7c68c84674d67d7bee9d78b99ce01ad789a77961 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sat, 4 Dec 2021 15:49:42 +0100
Subject: Silence byte-compiler in some tests

* test/lisp/dired-tests.el:
* test/lisp/emacs-lisp/cl-macs-tests.el:
* test/lisp/emacs-lisp/derived-tests.el:
* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el:
* test/lisp/emacs-lisp/generator-tests.el:
* test/lisp/emacs-lisp/lisp-tests.el:
* test/lisp/emacs-lisp/seq-tests.el (test-seq-let)
(test-seq-setq):
* test/lisp/emacs-lisp/subr-x-tests.el (subr-x-test-if-let*-false)
(subr-x-test-if-let*-and-laziness-is-preserved)
(subr-x-test-when-let*-false)
(subr-x-test-when-let*-and-laziness-is-preserved):
* test/lisp/emacs-lisp/timer-tests.el
(timer-tests-debug-timer-check):
* test/lisp/format-spec-tests.el (format-spec-do-flags-truncate)
(format-spec-do-flags-pad):
* test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27762):
* test/lisp/obsolete/cl-tests.el (labels-function-quoting):
* test/lisp/progmodes/elisp-mode-tests.el:
* test/lisp/replace-tests.el (replace-regexp-bug45973):
* test/lisp/ses-tests.el:
* test/lisp/subr-tests.el:
* test/lisp/tar-mode-tests.el (tar-mode-test-tar-grind-file-mode):
* test/src/data-tests.el (data-tests--set-default-per-buffer):
* test/src/search-tests.el
(test-replace-match-modification-hooks): Silence byte-compiler.
---
 test/lisp/emacs-lisp/cl-macs-tests.el           |  4 +++
 test/lisp/emacs-lisp/derived-tests.el           |  4 +--
 test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 40 ++++++++++++-------------
 test/lisp/emacs-lisp/generator-tests.el         |  3 +-
 test/lisp/emacs-lisp/lisp-tests.el              |  1 +
 test/lisp/emacs-lisp/seq-tests.el               | 20 ++++++++-----
 test/lisp/emacs-lisp/subr-x-tests.el            | 26 ++++++++--------
 test/lisp/emacs-lisp/timer-tests.el             |  3 +-
 8 files changed, 57 insertions(+), 44 deletions(-)

(limited to 'test/lisp/emacs-lisp')

diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index be2c0fa02b4..7c3afefaadd 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -668,6 +668,10 @@ collection clause."
                      #'len))
             (`(function (lambda (,_ ,_) . ,_)) t))))
 
+(with-suppressed-warnings ((lexical test) (lexical test1) (lexical test2))
+  (defvar test)
+  (defvar test1)
+  (defvar test2))
 (ert-deftest cl-macs--progv ()
   (should (= (cl-progv '(test test) '(1 2) test) 2))
   (should (equal (cl-progv '(test1 test2) '(1 2) (list test1 test2))
diff --git a/test/lisp/emacs-lisp/derived-tests.el b/test/lisp/emacs-lisp/derived-tests.el
index 9c8e6c33b4c..2647b86826a 100644
--- a/test/lisp/emacs-lisp/derived-tests.el
+++ b/test/lisp/emacs-lisp/derived-tests.el
@@ -24,13 +24,13 @@
 (define-derived-mode derived-tests--parent-mode prog-mode "P"
   :after-hook
   (let ((f (let ((x "S")) (lambda () x))))
-    (insert (format "AFP=%s " (let ((x "D")) (funcall f)))))
+    (insert (format "AFP=%s " (let ((x "D")) x (funcall f)))))
   (insert "PB "))
 
 (define-derived-mode derived-tests--child-mode derived-tests--parent-mode "C"
   :after-hook
   (let ((f (let ((x "S")) (lambda () x))))
-    (insert (format "AFC=%s " (let ((x "D")) (funcall f)))))
+    (insert (format "AFC=%s " (let ((x "D")) x (funcall f)))))
   (insert "CB "))
 
 (ert-deftest derived-tests-after-hook-lexical ()
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index ba2e5f7be4a..dfdfb63b584 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -172,7 +172,7 @@
   ;; Check that generic-p works
   (should (generic-p 'generic1))
 
-  (defmethod generic1 ((c class-a))
+  (defmethod generic1 ((_c class-a))
     "Method on generic1."
     'monkey)
 
@@ -240,12 +240,12 @@ Argument C is the class bound to this static method."
   (should (make-instance 'class-a :water 'cho))
   (should (make-instance 'class-b)))
 
-(defmethod class-cn ((a class-a))
+(defmethod class-cn ((_a class-a))
   "Try calling `call-next-method' when there isn't one.
 Argument A is object of type symbol `class-a'."
   (call-next-method))
 
-(defmethod no-next-method ((a class-a) &rest args)
+(defmethod no-next-method ((_a class-a) &rest _args)
   "Override signal throwing for variable `class-a'.
 Argument A is the object of class variable `class-a'."
   'moose)
@@ -254,7 +254,7 @@ Argument A is the object of class variable `class-a'."
   ;; Play with call-next-method
   (should (eq (class-cn eitest-ab) 'moose)))
 
-(defmethod no-applicable-method ((b class-b) method &rest args)
+(defmethod no-applicable-method ((_b class-b) _method &rest _args)
   "No need.
 Argument B is for booger.
 METHOD is the method that was attempting to be called."
@@ -264,38 +264,38 @@ METHOD is the method that was attempting to be called."
   ;; Non-existing methods.
   (should (eq (class-cn eitest-b) 'moose)))
 
-(defmethod class-fun ((a class-a))
+(defmethod class-fun ((_a class-a))
   "Fun with class A."
   'moose)
 
-(defmethod class-fun ((b class-b))
+(defmethod class-fun ((_b class-b))
   "Fun with class B."
   (error "Class B fun should not be called")
   )
 
-(defmethod class-fun-foo ((b class-b))
+(defmethod class-fun-foo ((_b class-b))
   "Foo Fun with class B."
   'moose)
 
-(defmethod class-fun2 ((a class-a))
+(defmethod class-fun2 ((_a class-a))
   "More fun with class A."
   'moose)
 
-(defmethod class-fun2 ((b class-b))
+(defmethod class-fun2 ((_b class-b))
   "More fun with class B."
   (error "Class B fun2 should not be called")
   )
 
-(defmethod class-fun2 ((ab class-ab))
+(defmethod class-fun2 ((_ab class-ab))
   "More fun with class AB."
   (call-next-method))
 
 ;; How about if B is the only slot?
-(defmethod class-fun3 ((b class-b))
+(defmethod class-fun3 ((_b class-b))
   "Even More fun with class B."
   'moose)
 
-(defmethod class-fun3 ((ab class-ab))
+(defmethod class-fun3 ((_ab class-ab))
   "Even More fun with class AB."
   (call-next-method))
 
@@ -314,17 +314,17 @@ METHOD is the method that was attempting to be called."
 
 
 (defvar class-fun-value-seq '())
-(defmethod class-fun-value :BEFORE ((a class-a))
+(defmethod class-fun-value :BEFORE ((_a class-a))
   "Return `before', and push `before' in `class-fun-value-seq'."
   (push 'before class-fun-value-seq)
   'before)
 
-(defmethod class-fun-value :PRIMARY ((a class-a))
+(defmethod class-fun-value :PRIMARY ((_a class-a))
   "Return `primary', and push `primary' in `class-fun-value-seq'."
   (push 'primary class-fun-value-seq)
   'primary)
 
-(defmethod class-fun-value :AFTER ((a class-a))
+(defmethod class-fun-value :AFTER ((_a class-a))
   "Return `after', and push `after' in `class-fun-value-seq'."
   (push 'after class-fun-value-seq)
   'after)
@@ -343,14 +343,14 @@ METHOD is the method that was attempting to be called."
 ;;
 
 (ert-deftest eieio-test-13-init-methods ()
-  (defmethod initialize-instance ((a class-a) &rest slots)
+  (defmethod initialize-instance ((a class-a) &rest _slots)
     "Initialize the slots of class-a."
     (call-next-method)
     (if (/= (oref a test-tag) 1)
 	(error "shared-initialize test failed."))
     (oset a test-tag 2))
 
-  (defmethod shared-initialize ((a class-a) &rest slots)
+  (defmethod shared-initialize ((a class-a) &rest _slots)
     "Shared initialize method for class-a."
     (call-next-method)
     (oset a test-tag 1))
@@ -369,7 +369,7 @@ METHOD is the method that was attempting to be called."
 
 (ert-deftest eieio-test-15-slot-missing ()
 
-  (defmethod slot-missing ((ab class-ab) &rest foo)
+  (defmethod slot-missing ((_ab class-ab) &rest _foo)
     "If a slot in AB is unbound, return something cool.  FOO."
     'moose)
 
@@ -425,7 +425,7 @@ METHOD is the method that was attempting to be called."
 
 (ert-deftest eieio-test-18-slot-unbound ()
 
-  (defmethod slot-unbound ((a class-a) &rest foo)
+  (defmethod slot-unbound ((_a class-a) &rest _foo)
     "If a slot in A is unbound, ignore FOO."
     'moose)
 
@@ -448,7 +448,7 @@ METHOD is the method that was attempting to be called."
   (should (eq (oref (class-a) water) 'penguin))
 
   ;; Revert the above
-  (defmethod slot-unbound ((a class-a) &rest foo)
+  (defmethod slot-unbound ((_a class-a) &rest _foo)
     "If a slot in A is unbound, ignore FOO."
     ;; Disable the old slot-unbound so we can run this test
     ;; more than once
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index 50b8cc53a28..492c4e40853 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -74,7 +74,7 @@ identical output."
 (cps-testcase cps-prog1-b (prog1 1))
 (cps-testcase cps-prog1-c (prog2 1 2 3))
 (cps-testcase cps-quote (progn 'hello))
-(cps-testcase cps-function (progn #'hello))
+(cps-testcase cps-function (progn #'message))
 
 (cps-testcase cps-and-fail (and 1 nil 2))
 (cps-testcase cps-and-succeed (and 1 2 3))
@@ -307,6 +307,7 @@ identical output."
                                             (1+ it)))))))
                  -2)))
 
+(defun generator-tests-edebug ()) ; silence byte-compiler
 (ert-deftest generator-tests-edebug ()
   "Check that Bug#40434 is fixed."
   (with-temp-buffer
diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el
index 8301d9906a2..7f4d50c5958 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -213,6 +213,7 @@
     (should-error (forward-sexp)))) ;; FIXME: Shouldn't be an error.
 
 ;; Test some core Elisp rules.
+(defvar c-e-x)
 (ert-deftest core-elisp-tests-1-defvar-in-let ()
   "Test some core Elisp rules."
   (with-temp-buffer
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index 8dc0b93b5af..8cfa3bdb862 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -172,17 +172,23 @@ Evaluate BODY for each created sequence.
   (should-not (seq-find #'null '(1 2 3)))
   (should (seq-find #'null '(1 2 3) 'sentinel)))
 
+;; Hack to work around the ERT limitation that we can't reliably use
+;; `with-suppressed-warnings' inside an `ert-deftest'.  (Bug#36568)
+(defun seq--contains (&rest args)
+  (with-suppressed-warnings ((obsolete seq-contains))
+    (apply #'seq-contains args)))
+
 (ert-deftest test-seq-contains ()
   (with-test-sequences (seq '(3 4 5 6))
-    (should (seq-contains seq 3))
-    (should-not (seq-contains seq 7)))
+    (should (seq--contains seq 3))
+    (should-not (seq--contains seq 7)))
   (with-test-sequences (seq '())
-    (should-not (seq-contains seq 3))
-    (should-not (seq-contains seq nil))))
+    (should-not (seq--contains seq 3))
+    (should-not (seq--contains seq nil))))
 
 (ert-deftest test-seq-contains-should-return-the-elt ()
   (with-test-sequences (seq '(3 4 5 6))
-    (should (= 5 (seq-contains seq 5)))))
+    (should (= 5 (seq--contains seq 5)))))
 
 (ert-deftest test-seq-contains-p ()
   (with-test-sequences (seq '(3 4 5 6))
@@ -404,7 +410,7 @@ Evaluate BODY for each created sequence.
   (let ((seq '(1 (2 (3 (4))))))
     (seq-let (_ (_ (_ (a)))) seq
       (should (= a 4))))
-  (let (seq)
+  (let ((seq nil))
     (seq-let (a b c) seq
       (should (null a))
       (should (null b))
@@ -428,7 +434,7 @@ Evaluate BODY for each created sequence.
         (seq '(1 (2 (3 (4))))))
     (seq-setq (_ (_ (_ (a)))) seq)
     (should (= a 4)))
-  (let (seq a b c)
+  (let ((seq nil) a b c)
     (seq-setq (a b c) seq)
     (should (null a))
     (should (null b))
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 69d59e84f6d..d8369506000 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -169,13 +169,13 @@
              "no")
            "no"))
   (should (equal
-           (let (z)
+           (let ((z nil))
              (if-let* (z (a 1) (b 2) (c 3))
                  "yes"
                "no"))
            "no"))
   (should (equal
-           (let (d)
+           (let ((d nil))
              (if-let* ((a 1) (b 2) (c 3) d)
                  "yes"
                "no"))
@@ -191,7 +191,7 @@
 
 (ert-deftest subr-x-test-if-let*-and-laziness-is-preserved ()
   "Test `if-let' respects `and' laziness."
-  (let (a-called b-called c-called)
+  (let ((a-called nil) (b-called nil) c-called)
     (should (equal
              (if-let* ((a nil)
                        (b (setq b-called t))
@@ -199,7 +199,7 @@
                  "yes"
                (list a-called b-called c-called))
              (list nil nil nil))))
-  (let (a-called b-called c-called)
+  (let ((a-called nil) (b-called nil) c-called)
     (should (equal
              (if-let* ((a (setq a-called t))
                        (b nil)
@@ -207,12 +207,12 @@
                  "yes"
                (list a-called b-called c-called))
              (list t nil nil))))
-  (let (a-called b-called c-called)
+  (let ((a-called nil) (b-called nil) c-called)
     (should (equal
              (if-let* ((a (setq a-called t))
-                      (b (setq b-called t))
-                      (c nil)
-                      (d (setq c-called t)))
+                       (b (setq b-called t))
+                       (c nil)
+                       (d (setq c-called t)))
                  "yes"
                (list a-called b-called c-called))
              (list t t nil)))))
@@ -329,12 +329,12 @@
              "no")
            nil))
   (should (equal
-           (let (z)
+           (let ((z nil))
              (when-let* (z (a 1) (b 2) (c 3))
                "no"))
            nil))
   (should (equal
-           (let (d)
+           (let ((d nil))
              (when-let* ((a 1) (b 2) (c 3) d)
                "no"))
            nil)))
@@ -348,7 +348,7 @@
 
 (ert-deftest subr-x-test-when-let*-and-laziness-is-preserved ()
   "Test `when-let' respects `and' laziness."
-  (let (a-called b-called c-called)
+  (let ((a-called nil) (b-called nil) (c-called nil))
     (should (equal
              (progn
                (when-let* ((a nil)
@@ -357,7 +357,7 @@
                  "yes")
                (list a-called b-called c-called))
              (list nil nil nil))))
-  (let (a-called b-called c-called)
+  (let ((a-called nil) (b-called nil) (c-called nil))
     (should (equal
              (progn
                (when-let* ((a (setq a-called t))
@@ -366,7 +366,7 @@
                  "yes")
                (list a-called b-called c-called))
              (list t nil nil))))
-  (let (a-called b-called c-called)
+  (let ((a-called nil) (b-called nil) (c-called nil))
     (should (equal
              (progn
                (when-let* ((a (setq a-called t))
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
index 7856c217f9e..0f5b1a71868 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -37,7 +37,8 @@
 (ert-deftest timer-tests-debug-timer-check ()
   ;; This function exists only if --enable-checking.
   (skip-unless (fboundp 'debug-timer-check))
-  (should (debug-timer-check)))
+  (when (fboundp 'debug-timer-check)    ; silence byte-compiler
+    (should (debug-timer-check))))
 
 (ert-deftest timer-test-multiple-of-time ()
   (should (time-equal-p
-- 
cgit v1.2.3


From de727b5886fb4a81df2dc17d9d094e915c1e9fb4 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sat, 4 Dec 2021 13:47:19 -0500
Subject: eieio-core.el: Allow assignment to cl-structs through `slot-value`

* lisp/emacs-lisp/eieio-core.el (eieio--validate-slot-value):
Obey the `:read-only` property of the slot.
(eieio-oset): Allow use on cl-structs as well.
(eieio-read-only): New error.

* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test--struct):
Make the last field read-only.
(eieio-test-defstruct-slot-value): Test that cl-struct slots can be
assigned via `slot-value`.
---
 doc/misc/eieio.texi                             |  3 +--
 etc/NEWS                                        |  2 +-
 lisp/emacs-lisp/eieio-core.el                   | 19 ++++++++++++-------
 test/lisp/emacs-lisp/eieio-tests/eieio-tests.el |  7 +++++--
 4 files changed, 19 insertions(+), 12 deletions(-)

(limited to 'test/lisp/emacs-lisp')

diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index 2b0b1f7fd67..8a4b914687c 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -703,8 +703,7 @@ This function retrieves the value of @var{slot} from @var{object}.
 It can also be used on objects defined by @code{cl-defstruct}.
 
 This is a generalized variable that can be used with @code{setf} to
-modify the value stored in @var{slot}, tho not for objects defined by
-@code{cl-defstruct}.
+modify the value stored in @var{slot}.
 @xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
 @end defun
 
diff --git a/etc/NEWS b/etc/NEWS
index 2b4eaaf8a1a..df5e6ef7904 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -423,7 +423,7 @@ representation as emojis.
 ** EIEIO
 
 +++
-*** 'slot-value' can now be used to read slots of 'cl-defstruct' objects.
+*** 'slot-value' can now be used to access slots of 'cl-defstruct' objects.
 
 ** align
 
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 7c5babcf54c..ca47ec77f76 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -450,7 +450,7 @@ See `defclass' for more information."
 	))
 
     ;; Now that everything has been loaded up, all our lists are backwards!
-    ;; Fix that up now and then them into vectors.
+    ;; Fix that up now and turn them into vectors.
     (cl-callf (lambda (slots) (apply #'vector (nreverse slots)))
         (eieio--class-slots newc))
     (cl-callf nreverse (eieio--class-initarg-tuples newc))
@@ -704,11 +704,15 @@ an error."
       nil
     ;; Trim off object IDX junk added in for the object index.
     (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
-    (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class)
-                                              slot-idx))))
-      (if (not (eieio--perform-slot-validation st value))
-	  (signal 'invalid-slot-type
-                  (list (eieio--class-name class) slot st value))))))
+    (let* ((sd (aref (eieio--class-slots class)
+                     slot-idx))
+           (st (cl--slot-descriptor-type sd)))
+      (cond
+       ((not (eieio--perform-slot-validation st value))
+	(signal 'invalid-slot-type
+                (list (eieio--class-name class) slot st value)))
+       ((alist-get :read-only (cl--slot-descriptor-props sd))
+        (signal 'eieio-read-only (list (eieio--class-name class) slot)))))))
 
 (defun eieio--validate-class-slot-value (class slot-idx value slot)
   "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
@@ -813,7 +817,7 @@ Fills in CLASS's SLOT with its default value."
 (defun eieio-oset (obj slot value)
   "Do the work for the macro `oset'.
 Fills in OBJ's SLOT with VALUE."
-  (cl-check-type obj eieio-object)
+  (cl-check-type obj (or eieio-object cl-structure-object))
   (cl-check-type slot symbol)
   (let* ((class (eieio--object-class obj))
          (c (eieio--slot-name-index class slot)))
@@ -1063,6 +1067,7 @@ method invocation orders of the involved classes."
 ;;
 (define-error 'invalid-slot-name "Invalid slot name")
 (define-error 'invalid-slot-type "Invalid slot type")
+(define-error 'eieio-read-only "Read-only slot")
 (define-error 'unbound-slot "Unbound slot")
 (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")
 
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index dfdfb63b584..6f6a1f4f19a 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -971,7 +971,7 @@ Subclasses to override slot attributes.")
 
 ;;;; Interaction with defstruct
 
-(cl-defstruct eieio-test--struct a b c)
+(cl-defstruct eieio-test--struct a b (c nil :read-only t))
 
 (ert-deftest eieio-test-defstruct-slot-value ()
   (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C)))
@@ -980,7 +980,10 @@ Subclasses to override slot attributes.")
     (should (eq (eieio-test--struct-b x)
                 (slot-value x 'b)))
     (should (eq (eieio-test--struct-c x)
-                (slot-value x 'c)))))
+                (slot-value x 'c)))
+    (setf (slot-value x 'a) 1)
+    (should (eq (eieio-test--struct-a x) 1))
+    (should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only)))
 
 (provide 'eieio-tests)
 
-- 
cgit v1.2.3


From 8bdea767208257599f6ab727e51dd94f0c1872e1 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sun, 5 Dec 2021 04:20:55 +0100
Subject: Remove hack from seq-tests.el for broken `with-suppressed-warnings'

* test/lisp/emacs-lisp/seq-tests.el: `with-suppressed-warnings'
now works better in erf-deftests, so remove hack that works around
it (bug#36568).
---
 test/lisp/emacs-lisp/seq-tests.el | 24 ++++++++++--------------
 1 file changed, 10 insertions(+), 14 deletions(-)

(limited to 'test/lisp/emacs-lisp')

diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index 8cfa3bdb862..4b940af81f1 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -172,23 +172,19 @@ Evaluate BODY for each created sequence.
   (should-not (seq-find #'null '(1 2 3)))
   (should (seq-find #'null '(1 2 3) 'sentinel)))
 
-;; Hack to work around the ERT limitation that we can't reliably use
-;; `with-suppressed-warnings' inside an `ert-deftest'.  (Bug#36568)
-(defun seq--contains (&rest args)
-  (with-suppressed-warnings ((obsolete seq-contains))
-    (apply #'seq-contains args)))
-
 (ert-deftest test-seq-contains ()
-  (with-test-sequences (seq '(3 4 5 6))
-    (should (seq--contains seq 3))
-    (should-not (seq--contains seq 7)))
-  (with-test-sequences (seq '())
-    (should-not (seq--contains seq 3))
-    (should-not (seq--contains seq nil))))
+  (with-suppressed-warnings ((obsolete seq-contains))
+    (with-test-sequences (seq '(3 4 5 6))
+      (should (seq-contains seq 3))
+      (should-not (seq-contains seq 7)))
+    (with-test-sequences (seq '())
+      (should-not (seq-contains seq 3))
+      (should-not (seq-contains seq nil)))))
 
 (ert-deftest test-seq-contains-should-return-the-elt ()
-  (with-test-sequences (seq '(3 4 5 6))
-    (should (= 5 (seq--contains seq 5)))))
+  (with-suppressed-warnings ((obsolete seq-contains))
+    (with-test-sequences (seq '(3 4 5 6))
+      (should (= 5 (seq-contains seq 5))))))
 
 (ert-deftest test-seq-contains-p ()
   (with-test-sequences (seq '(3 4 5 6))
-- 
cgit v1.2.3


From 722a8ebb71227a18feeff1121d5b30122a7856e5 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sun, 5 Dec 2021 12:49:52 +0100
Subject: Silence warnings about testing obsolete functions and macros

* test/lisp/emacs-lisp/cl-generic-tests.el:
* test/lisp/emacs-lisp/edebug-tests.el:
* test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el:
* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el: Silence
byte-compiler warnings about testing obsolete functions and macros.
---
 test/lisp/emacs-lisp/cl-generic-tests.el           |   9 +-
 test/lisp/emacs-lisp/edebug-tests.el               |   9 +-
 .../eieio-tests/eieio-test-methodinvoke.el         | 281 +++++++++--------
 test/lisp/emacs-lisp/eieio-tests/eieio-tests.el    | 347 +++++++++++----------
 4 files changed, 357 insertions(+), 289 deletions(-)

(limited to 'test/lisp/emacs-lisp')

diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index dd7511e9afe..9c285a9facf 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -200,9 +200,14 @@
   (fmakunbound 'cl--generic-1)
   (cl-defgeneric cl--generic-1 (x y))
   (cl-defmethod cl--generic-1 ((x t) y)
-    (list x y (cl-next-method-p)))
+    (list x y
+          (with-suppressed-warnings ((obsolete cl-next-method-p))
+            (cl-next-method-p))))
   (cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
-    (cl-list* "quatre" (cl-next-method-p) (cl-call-next-method)))
+    (cl-list* "quatre"
+              (with-suppressed-warnings ((obsolete cl-next-method-p))
+                (cl-next-method-p))
+              (cl-call-next-method)))
   (should (equal (cl--generic-1 4 5) '("quatre" t 4 5 nil))))
 
 (ert-deftest cl-generic-test-12-context ()
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 9285b2c945c..210bf24880b 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -860,7 +860,8 @@ test and possibly others should be updated."
    (let ((inhibit-read-only t))
      (delete-region (point-min) (point-max))
      (insert  "`1"))
-   (edebug-eval-defun nil)
+   (with-suppressed-warnings ((obsolete edebug-eval-defun))
+     (edebug-eval-defun nil))
    ;; `eval-defun' outputs its message to the echo area in a rather
    ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
    ;; there in separate pieces (via `print' rather than via `message').
@@ -870,7 +871,8 @@ test and possibly others should be updated."
 
    (setq edebug-initial-mode 'go)
    ;; In Bug#23651 Edebug would hang reading `1.
-   (edebug-eval-defun t)))
+   (with-suppressed-warnings ((obsolete edebug-eval-defun))
+     (edebug-eval-defun t))))
 
 (ert-deftest edebug-tests-trivial-comma ()
   "Edebug can read a trivial comma expression (Bug#23651)."
@@ -879,7 +881,8 @@ test and possibly others should be updated."
    (delete-region (point-min) (point-max))
    (insert  ",1")
    (read-only-mode)
-   (should-error (edebug-eval-defun t))))
+   (with-suppressed-warnings ((obsolete edebug-eval-defun))
+     (should-error (edebug-eval-defun t)))))
 
 (ert-deftest edebug-tests-circular-read-syntax ()
   "Edebug can instrument code using circular read object syntax (Bug#23660)."
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
index d1da066dc45..ee52d831d69 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -85,37 +85,40 @@
 (defclass eitest-B-base2 () ())
 (defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
 
-(defmethod eitest-F :BEFORE ((_p eitest-B-base1))
-  (eieio-test-method-store :BEFORE 'eitest-B-base1))
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric)
+                           (obsolete call-next-method)
+                           (obsolete next-method-p))
+  (defmethod eitest-F :BEFORE ((_p eitest-B-base1))
+    (eieio-test-method-store :BEFORE 'eitest-B-base1))
 
-(defmethod eitest-F :BEFORE ((_p eitest-B-base2))
-  (eieio-test-method-store :BEFORE 'eitest-B-base2))
+  (defmethod eitest-F :BEFORE ((_p eitest-B-base2))
+    (eieio-test-method-store :BEFORE 'eitest-B-base2))
 
-(defmethod eitest-F :BEFORE ((_p eitest-B))
-  (eieio-test-method-store :BEFORE 'eitest-B))
+  (defmethod eitest-F :BEFORE ((_p eitest-B))
+    (eieio-test-method-store :BEFORE 'eitest-B))
 
-(defmethod eitest-F ((_p eitest-B))
-  (eieio-test-method-store :PRIMARY 'eitest-B)
-  (call-next-method))
-
-(defmethod eitest-F ((_p eitest-B-base1))
-  (eieio-test-method-store :PRIMARY 'eitest-B-base1)
-  (call-next-method))
+  (defmethod eitest-F ((_p eitest-B))
+    (eieio-test-method-store :PRIMARY 'eitest-B)
+    (call-next-method))
 
-(defmethod eitest-F ((_p eitest-B-base2))
-  (eieio-test-method-store :PRIMARY 'eitest-B-base2)
-  (when (next-method-p)
+  (defmethod eitest-F ((_p eitest-B-base1))
+    (eieio-test-method-store :PRIMARY 'eitest-B-base1)
     (call-next-method))
-  )
 
-(defmethod eitest-F :AFTER ((_p eitest-B-base1))
-  (eieio-test-method-store :AFTER 'eitest-B-base1))
+  (defmethod eitest-F ((_p eitest-B-base2))
+    (eieio-test-method-store :PRIMARY 'eitest-B-base2)
+    (when (next-method-p)
+      (call-next-method)))
 
-(defmethod eitest-F :AFTER ((_p eitest-B-base2))
-  (eieio-test-method-store :AFTER 'eitest-B-base2))
+  (defmethod eitest-F :AFTER ((_p eitest-B-base1))
+    (eieio-test-method-store :AFTER 'eitest-B-base1))
 
-(defmethod eitest-F :AFTER ((_p eitest-B))
-  (eieio-test-method-store :AFTER 'eitest-B))
+  (defmethod eitest-F :AFTER ((_p eitest-B-base2))
+    (eieio-test-method-store :AFTER 'eitest-B-base2))
+
+  (defmethod eitest-F :AFTER ((_p eitest-B))
+    (eieio-test-method-store :AFTER 'eitest-B)))
 
 (ert-deftest eieio-test-method-order-list-3 ()
   (let ((eieio-test-method-order-list nil)
@@ -138,9 +141,11 @@
 
 ;;; Test static invocation
 ;;
-(defmethod eitest-H :STATIC ((_class eitest-A))
-  "No need to do work in here."
-  'moose)
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod eitest-H :STATIC ((_class eitest-A))
+    "No need to do work in here."
+    'moose))
 
 (ert-deftest eieio-test-method-order-list-4 ()
   ;; Both of these situations should succeed.
@@ -149,17 +154,19 @@
 
 ;;; Return value from :PRIMARY
 ;;
-(defmethod eitest-I :BEFORE ((_a eitest-A))
-  (eieio-test-method-store :BEFORE 'eitest-A)
-  ":before")
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod eitest-I :BEFORE ((_a eitest-A))
+    (eieio-test-method-store :BEFORE 'eitest-A)
+    ":before")
 
-(defmethod eitest-I :PRIMARY ((_a eitest-A))
-  (eieio-test-method-store :PRIMARY 'eitest-A)
-  ":primary")
+  (defmethod eitest-I :PRIMARY ((_a eitest-A))
+    (eieio-test-method-store :PRIMARY 'eitest-A)
+    ":primary")
 
-(defmethod eitest-I :AFTER ((_a eitest-A))
-  (eieio-test-method-store :AFTER 'eitest-A)
-  ":after")
+  (defmethod eitest-I :AFTER ((_a eitest-A))
+    (eieio-test-method-store :AFTER 'eitest-A)
+    ":after"))
 
 (ert-deftest eieio-test-method-order-list-5 ()
   (let ((eieio-test-method-order-list nil)
@@ -175,16 +182,18 @@
 (defclass C-base2 () ())
 (defclass C (C-base1 C-base2) ())
 
-;; Just use the obsolete name once, to make sure it also works.
-(defmethod constructor :STATIC ((_p C-base1) &rest _args)
-  (eieio-test-method-store :STATIC 'C-base1)
-  (if (next-method-p) (call-next-method))
-  )
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric)
+                           (obsolete next-method-p)
+                           (obsolete call-next-method))
+  ;; Just use the obsolete name once, to make sure it also works.
+  (defmethod constructor :STATIC ((_p C-base1) &rest _args)
+    (eieio-test-method-store :STATIC 'C-base1)
+    (if (next-method-p) (call-next-method)))
 
-(defmethod make-instance :STATIC ((_p C-base2) &rest _args)
-  (eieio-test-method-store :STATIC 'C-base2)
-  (if (next-method-p) (call-next-method))
-  )
+  (defmethod make-instance :STATIC ((_p C-base2) &rest _args)
+    (eieio-test-method-store :STATIC 'C-base2)
+    (if (next-method-p) (call-next-method))))
 
 (cl-defmethod make-instance ((_p (subclass C)) &rest _args)
   (eieio-test-method-store :STATIC 'C)
@@ -215,29 +224,32 @@
 (defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
 (defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
 
-(defmethod eitest-F ((_p D))
-  "D"
-  (eieio-test-method-store :PRIMARY 'D)
-  (call-next-method))
-
-(defmethod eitest-F ((_p D-base0))
-  "D-base0"
-  (eieio-test-method-store :PRIMARY 'D-base0)
-  ;; This should have no next
-  ;; (when (next-method-p) (call-next-method))
-  )
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric)
+                           (obsolete call-next-method)
+                           (obsolete next-method-p))
+  (defmethod eitest-F ((_p D))
+    "D"
+    (eieio-test-method-store :PRIMARY 'D)
+    (call-next-method))
 
-(defmethod eitest-F ((_p D-base1))
-  "D-base1"
-  (eieio-test-method-store :PRIMARY 'D-base1)
-  (call-next-method))
+  (defmethod eitest-F ((_p D-base0))
+    "D-base0"
+    (eieio-test-method-store :PRIMARY 'D-base0)
+    ;; This should have no next
+    ;; (when (next-method-p) (call-next-method))
+    )
 
-(defmethod eitest-F ((_p D-base2))
-  "D-base2"
-  (eieio-test-method-store :PRIMARY 'D-base2)
-  (when (next-method-p)
+  (defmethod eitest-F ((_p D-base1))
+    "D-base1"
+    (eieio-test-method-store :PRIMARY 'D-base1)
     (call-next-method))
-  )
+
+  (defmethod eitest-F ((_p D-base2))
+    "D-base2"
+    (eieio-test-method-store :PRIMARY 'D-base2)
+    (when (next-method-p)
+      (call-next-method))))
 
 (ert-deftest eieio-test-method-order-list-7 ()
   (let ((eieio-test-method-order-list nil)
@@ -258,25 +270,27 @@
 (defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
 (defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
 
-(defmethod eitest-F ((_p E))
-  (eieio-test-method-store :PRIMARY 'E)
-  (call-next-method))
-
-(defmethod eitest-F ((_p E-base0))
-  (eieio-test-method-store :PRIMARY 'E-base0)
-  ;; This should have no next
-  ;; (when (next-method-p) (call-next-method))
-  )
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete next-method-p)
+                           (obsolete call-next-method))
+  (defmethod eitest-F ((_p E))
+    (eieio-test-method-store :PRIMARY 'E)
+    (call-next-method))
 
-(defmethod eitest-F ((_p E-base1))
-  (eieio-test-method-store :PRIMARY 'E-base1)
-  (call-next-method))
+  (defmethod eitest-F ((_p E-base0))
+    (eieio-test-method-store :PRIMARY 'E-base0)
+    ;; This should have no next
+    ;; (when (next-method-p) (call-next-method))
+    )
 
-(defmethod eitest-F ((_p E-base2))
-  (eieio-test-method-store :PRIMARY 'E-base2)
-  (when (next-method-p)
+  (defmethod eitest-F ((_p E-base1))
+    (eieio-test-method-store :PRIMARY 'E-base1)
     (call-next-method))
-  )
+
+  (defmethod eitest-F ((_p E-base2))
+    (eieio-test-method-store :PRIMARY 'E-base2)
+    (when (next-method-p)
+      (call-next-method))))
 
 (ert-deftest eieio-test-method-order-list-8 ()
   (let ((eieio-test-method-order-list nil)
@@ -295,24 +309,31 @@
 (defclass eitest-Ja ()
   ())
 
-(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
-  ;(message "+Ja")
-  ;; FIXME: Using next-method-p in an after-method is invalid!
-  (when (next-method-p)
-    (call-next-method))
-  ;(message "-Ja")
-  )
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric)
+                           (obsolete next-method-p)
+                           (obsolete call-next-method))
+  (defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
+    ;;(message "+Ja")
+    ;; FIXME: Using next-method-p in an after-method is invalid!
+    (when (next-method-p)
+      (call-next-method))
+    ;;(message "-Ja")
+    ))
 
 (defclass eitest-Jb ()
   ())
 
-(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
-  ;(message "+Jb")
-  ;; FIXME: Using next-method-p in an after-method is invalid!
-  (when (next-method-p)
-    (call-next-method))
-  ;(message "-Jb")
-  )
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete next-method-p)
+                           (obsolete call-next-method))
+  (defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
+    ;;(message "+Jb")
+    ;; FIXME: Using next-method-p in an after-method is invalid!
+    (when (next-method-p)
+      (call-next-method))
+    ;;(message "-Jb")
+    ))
 
 (defclass eitest-Jc (eitest-Jb)
   ())
@@ -320,12 +341,16 @@
 (defclass eitest-Jd (eitest-Jc eitest-Ja)
   ())
 
-(defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
-  ;(message "+Jd")
-  (when (next-method-p)
-    (call-next-method))
-  ;(message "-Jd")
-  )
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric)
+                           (obsolete next-method-p)
+                           (obsolete call-next-method))
+  (defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
+    ;;(message "+Jd")
+    (when (next-method-p)
+      (call-next-method))
+    ;;(message "-Jd")
+    ))
 
 (ert-deftest eieio-test-method-order-list-9 ()
   (should (eitest-Jd)))
@@ -345,32 +370,36 @@
 (defclass CNM-2 (CNM-1-1 CNM-1-2)
   ())
 
-(defmethod CNM-M ((this CNM-0) args)
-  (push (cons 'CNM-0 (copy-sequence args))
-	eieio-test-call-next-method-arguments)
-  (when (next-method-p)
-    (call-next-method
-     this (cons 'CNM-0 args))))
-
-(defmethod CNM-M ((this CNM-1-1) args)
-  (push (cons 'CNM-1-1 (copy-sequence args))
-	eieio-test-call-next-method-arguments)
-  (when (next-method-p)
-    (call-next-method
-     this (cons 'CNM-1-1 args))))
-
-(defmethod CNM-M ((_this CNM-1-2) args)
-  (push (cons 'CNM-1-2 (copy-sequence args))
-	eieio-test-call-next-method-arguments)
-  (when (next-method-p)
-    (call-next-method)))
-
-(defmethod CNM-M ((this CNM-2) args)
-  (push (cons 'CNM-2 (copy-sequence args))
-	eieio-test-call-next-method-arguments)
-  (when (next-method-p)
-    (call-next-method
-     this (cons 'CNM-2 args))))
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric)
+                           (obsolete next-method-p)
+                           (obsolete call-next-method))
+  (defmethod CNM-M ((this CNM-0) args)
+    (push (cons 'CNM-0 (copy-sequence args))
+          eieio-test-call-next-method-arguments)
+    (when (next-method-p)
+      (call-next-method
+       this (cons 'CNM-0 args))))
+
+  (defmethod CNM-M ((this CNM-1-1) args)
+    (push (cons 'CNM-1-1 (copy-sequence args))
+          eieio-test-call-next-method-arguments)
+    (when (next-method-p)
+      (call-next-method
+       this (cons 'CNM-1-1 args))))
+
+  (defmethod CNM-M ((_this CNM-1-2) args)
+    (push (cons 'CNM-1-2 (copy-sequence args))
+          eieio-test-call-next-method-arguments)
+    (when (next-method-p)
+      (call-next-method)))
+
+  (defmethod CNM-M ((this CNM-2) args)
+    (push (cons 'CNM-2 (copy-sequence args))
+          eieio-test-call-next-method-arguments)
+    (when (next-method-p)
+      (call-next-method
+       this (cons 'CNM-2 args)))))
 
 (ert-deftest eieio-test-method-order-list-10 ()
   (let ((eieio-test-call-next-method-arguments nil))
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 6f6a1f4f19a..599d7900c30 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -160,30 +160,33 @@
   ;; error
   (should-error (abstract-class)))
 
-(defgeneric generic1 () "First generic function.")
+(with-suppressed-warnings ((obsolete defgeneric))
+  (defgeneric generic1 () "First generic function."))
 
 (ert-deftest eieio-test-03-generics ()
-  (defun anormalfunction () "A plain function for error testing." nil)
-  (should-error
-   (progn
-     (defgeneric anormalfunction ()
-       "Attempt to turn it into a generic.")))
-
-  ;; Check that generic-p works
-  (should (generic-p 'generic1))
-
-  (defmethod generic1 ((_c class-a))
-    "Method on generic1."
-    'monkey)
-
-  (defmethod generic1 (not-an-object)
-    "Method generic1 that can take a non-object."
-    not-an-object)
-
-  (let ((ans-obj (generic1 (class-a)))
-	(ans-num (generic1 666)))
-    (should (eq ans-obj 'monkey))
-    (should (eq ans-num 666))))
+  (with-suppressed-warnings ((obsolete defmethod)
+                             (obsolete defgeneric))
+    (defun anormalfunction () "A plain function for error testing." nil)
+    (should-error
+     (progn
+       (defgeneric anormalfunction ()
+         "Attempt to turn it into a generic.")))
+
+    ;; Check that generic-p works
+    (should (generic-p 'generic1))
+
+    (defmethod generic1 ((_c class-a))
+      "Method on generic1."
+      'monkey)
+
+    (defmethod generic1 (not-an-object)
+      "Method generic1 that can take a non-object."
+      not-an-object)
+
+    (let ((ans-obj (generic1 (class-a)))
+          (ans-num (generic1 666)))
+      (should (eq ans-obj 'monkey))
+      (should (eq ans-num 666)))))
 
 (defclass static-method-class ()
   ((some-slot :initform nil
@@ -191,11 +194,13 @@
 	      :documentation "A slot."))
   :documentation "A class used for testing static methods.")
 
-(defmethod static-method-class-method :STATIC ((c static-method-class) value)
-  "Test static methods.
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod static-method-class-method :STATIC ((c static-method-class) value)
+    "Test static methods.
 Argument C is the class bound to this static method."
-  (if (eieio-object-p c) (setq c (eieio-object-class c)))
-  (oset-default c some-slot value))
+    (if (eieio-object-p c) (setq c (eieio-object-class c)))
+    (oset-default c some-slot value)))
 
 (ert-deftest eieio-test-04-static-method ()
   ;; Call static method on a class and see if it worked
@@ -209,11 +214,13 @@ Argument C is the class bound to this static method."
     ()
     "A second class after the previous for static methods.")
 
-  (defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
-    "Test static methods.
+  (with-suppressed-warnings ((obsolete defmethod)
+                             (obsolete defgeneric))
+    (defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
+      "Test static methods.
 Argument C is the class bound to this static method."
-    (if (eieio-object-p c) (setq c (eieio-object-class c)))
-    (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
+      (if (eieio-object-p c) (setq c (eieio-object-class c)))
+      (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))))
 
   (static-method-class-method 'static-method-class-2 'class)
   (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
@@ -240,64 +247,71 @@ Argument C is the class bound to this static method."
   (should (make-instance 'class-a :water 'cho))
   (should (make-instance 'class-b)))
 
-(defmethod class-cn ((_a class-a))
-  "Try calling `call-next-method' when there isn't one.
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod class-cn ((_a class-a))
+    "Try calling `call-next-method' when there isn't one.
 Argument A is object of type symbol `class-a'."
-  (call-next-method))
+    (with-suppressed-warnings ((obsolete call-next-method))
+      (call-next-method)))
 
-(defmethod no-next-method ((_a class-a) &rest _args)
-  "Override signal throwing for variable `class-a'.
+  (defmethod no-next-method ((_a class-a) &rest _args)
+    "Override signal throwing for variable `class-a'.
 Argument A is the object of class variable `class-a'."
-  'moose)
+    'moose))
 
 (ert-deftest eieio-test-08-call-next-method ()
   ;; Play with call-next-method
   (should (eq (class-cn eitest-ab) 'moose)))
 
-(defmethod no-applicable-method ((_b class-b) _method &rest _args)
-  "No need.
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod no-applicable-method ((_b class-b) _method &rest _args)
+    "No need.
 Argument B is for booger.
 METHOD is the method that was attempting to be called."
-  'moose)
+    'moose))
 
 (ert-deftest eieio-test-09-no-applicable-method ()
   ;; Non-existing methods.
   (should (eq (class-cn eitest-b) 'moose)))
 
-(defmethod class-fun ((_a class-a))
-  "Fun with class A."
-  'moose)
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod class-fun ((_a class-a))
+    "Fun with class A."
+    'moose)
 
-(defmethod class-fun ((_b class-b))
-  "Fun with class B."
-  (error "Class B fun should not be called")
-  )
+  (defmethod class-fun ((_b class-b))
+    "Fun with class B."
+    (error "Class B fun should not be called"))
 
-(defmethod class-fun-foo ((_b class-b))
-  "Foo Fun with class B."
-  'moose)
+  (defmethod class-fun-foo ((_b class-b))
+    "Foo Fun with class B."
+    'moose)
 
-(defmethod class-fun2 ((_a class-a))
-  "More fun with class A."
-  'moose)
+  (defmethod class-fun2 ((_a class-a))
+    "More fun with class A."
+    'moose)
 
-(defmethod class-fun2 ((_b class-b))
-  "More fun with class B."
-  (error "Class B fun2 should not be called")
-  )
+  (defmethod class-fun2 ((_b class-b))
+    "More fun with class B."
+    (error "Class B fun2 should not be called"))
 
-(defmethod class-fun2 ((_ab class-ab))
-  "More fun with class AB."
-  (call-next-method))
+  (defmethod class-fun2 ((_ab class-ab))
+    "More fun with class AB."
+    (with-suppressed-warnings ((obsolete call-next-method))
+      (call-next-method)))
 
-;; How about if B is the only slot?
-(defmethod class-fun3 ((_b class-b))
-  "Even More fun with class B."
-  'moose)
+  ;; How about if B is the only slot?
+  (defmethod class-fun3 ((_b class-b))
+    "Even More fun with class B."
+    'moose)
 
-(defmethod class-fun3 ((_ab class-ab))
-  "Even More fun with class AB."
-  (call-next-method))
+  (defmethod class-fun3 ((_ab class-ab))
+    "Even More fun with class AB."
+    (with-suppressed-warnings ((obsolete call-next-method))
+      (call-next-method))))
 
 (ert-deftest eieio-test-10-multiple-inheritance ()
   ;; play with methods and mi
@@ -314,20 +328,22 @@ METHOD is the method that was attempting to be called."
 
 
 (defvar class-fun-value-seq '())
-(defmethod class-fun-value :BEFORE ((_a class-a))
-  "Return `before', and push `before' in `class-fun-value-seq'."
-  (push 'before class-fun-value-seq)
-  'before)
-
-(defmethod class-fun-value :PRIMARY ((_a class-a))
-  "Return `primary', and push `primary' in `class-fun-value-seq'."
-  (push 'primary class-fun-value-seq)
-  'primary)
-
-(defmethod class-fun-value :AFTER ((_a class-a))
-  "Return `after', and push `after' in `class-fun-value-seq'."
-  (push 'after class-fun-value-seq)
-  'after)
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod class-fun-value :BEFORE ((_a class-a))
+    "Return `before', and push `before' in `class-fun-value-seq'."
+    (push 'before class-fun-value-seq)
+    'before)
+
+  (defmethod class-fun-value :PRIMARY ((_a class-a))
+    "Return `primary', and push `primary' in `class-fun-value-seq'."
+    (push 'primary class-fun-value-seq)
+    'primary)
+
+  (defmethod class-fun-value :AFTER ((_a class-a))
+    "Return `after', and push `after' in `class-fun-value-seq'."
+    (push 'after class-fun-value-seq)
+    'after))
 
 (ert-deftest eieio-test-12-generic-function-call ()
   ;; Test value of a generic function call
@@ -343,20 +359,23 @@ METHOD is the method that was attempting to be called."
 ;;
 
 (ert-deftest eieio-test-13-init-methods ()
-  (defmethod initialize-instance ((a class-a) &rest _slots)
-    "Initialize the slots of class-a."
-    (call-next-method)
-    (if (/= (oref a test-tag) 1)
-	(error "shared-initialize test failed."))
-    (oset a test-tag 2))
-
-  (defmethod shared-initialize ((a class-a) &rest _slots)
-    "Shared initialize method for class-a."
-    (call-next-method)
-    (oset a test-tag 1))
-
-  (let ((ca (class-a)))
-    (should (= (oref ca test-tag) 2))))
+  (with-suppressed-warnings ((obsolete defmethod)
+                             (obsolete defgeneric)
+                             (obsolete call-next-method))
+    (defmethod initialize-instance ((a class-a) &rest _slots)
+      "Initialize the slots of class-a."
+      (call-next-method)
+      (if (/= (oref a test-tag) 1)
+          (error "shared-initialize test failed."))
+      (oset a test-tag 2))
+
+    (defmethod shared-initialize ((a class-a) &rest _slots)
+      "Shared initialize method for class-a."
+      (call-next-method)
+      (oset a test-tag 1))
+
+    (let ((ca (class-a)))
+      (should (= (oref ca test-tag) 2)))))
 
 
 ;;; Perform slot testing
@@ -368,10 +387,11 @@ METHOD is the method that was attempting to be called."
   (should (oref eitest-ab amphibian)))
 
 (ert-deftest eieio-test-15-slot-missing ()
-
-  (defmethod slot-missing ((_ab class-ab) &rest _foo)
-    "If a slot in AB is unbound, return something cool.  FOO."
-    'moose)
+  (with-suppressed-warnings ((obsolete defmethod)
+                             (obsolete defgeneric))
+    (defmethod slot-missing ((_ab class-ab) &rest _foo)
+      "If a slot in AB is unbound, return something cool.  FOO."
+      'moose))
 
   (should (eq (oref eitest-ab ooga-booga) 'moose))
   (should-error (oref eitest-a ooga-booga) :type 'invalid-slot-name))
@@ -391,17 +411,20 @@ METHOD is the method that was attempting to be called."
 (defclass virtual-slot-class ()
   ((base-value :initarg :base-value))
   "Class has real slot :base-value and simulated slot :derived-value.")
-(defmethod slot-missing ((vsc virtual-slot-class)
-			 slot-name operation &optional new-value)
-  "Simulate virtual slot derived-value."
-  (cond
-   ((or (eq slot-name :derived-value)
-	(eq slot-name 'derived-value))
-    (with-slots (base-value) vsc
-      (if (eq operation 'oref)
-	  (+ base-value 1)
-	(setq base-value (- new-value 1)))))
-   (t (call-next-method))))
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod slot-missing ((vsc virtual-slot-class)
+                           slot-name operation &optional new-value)
+    "Simulate virtual slot derived-value."
+    (cond
+     ((or (eq slot-name :derived-value)
+          (eq slot-name 'derived-value))
+      (with-slots (base-value) vsc
+        (if (eq operation 'oref)
+            (+ base-value 1)
+          (setq base-value (- new-value 1)))))
+     (t (with-suppressed-warnings ((obsolete call-next-method))
+          (call-next-method))))))
 
 (ert-deftest eieio-test-17-virtual-slot ()
   (setq eitest-vsca (virtual-slot-class :base-value 1))
@@ -424,35 +447,37 @@ METHOD is the method that was attempting to be called."
   (should (= (oref eitest-vscb :derived-value) 5)))
 
 (ert-deftest eieio-test-18-slot-unbound ()
-
-  (defmethod slot-unbound ((_a class-a) &rest _foo)
-    "If a slot in A is unbound, ignore FOO."
-    'moose)
-
-  (should (eq (oref eitest-a water) 'moose))
-
-  ;; Check if oset of unbound works
-  (oset eitest-a water 'moose)
-  (should (eq (oref eitest-a water) 'moose))
-
-  ;; oref/oref-default comparison
-  (should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
-
-  ;; oset-default -> oref/oref-default comparison
-  (oset-default (eieio-object-class eitest-a) water 'moose)
-  (should (eq (oref eitest-a water) (oref-default eitest-a water)))
-
-  ;; After setting 'water to 'moose, make sure a new object has
-  ;; the right stuff.
-  (oset-default (eieio-object-class eitest-a) water 'penguin)
-  (should (eq (oref (class-a) water) 'penguin))
-
-  ;; Revert the above
-  (defmethod slot-unbound ((_a class-a) &rest _foo)
-    "If a slot in A is unbound, ignore FOO."
-    ;; Disable the old slot-unbound so we can run this test
-    ;; more than once
-    (call-next-method)))
+  (with-suppressed-warnings ((obsolete defmethod)
+                             (obsolete defgeneric))
+    (defmethod slot-unbound ((_a class-a) &rest _foo)
+      "If a slot in A is unbound, ignore FOO."
+      'moose)
+
+    (should (eq (oref eitest-a water) 'moose))
+
+    ;; Check if oset of unbound works
+    (oset eitest-a water 'moose)
+    (should (eq (oref eitest-a water) 'moose))
+
+    ;; oref/oref-default comparison
+    (should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
+
+    ;; oset-default -> oref/oref-default comparison
+    (oset-default (eieio-object-class eitest-a) water 'moose)
+    (should (eq (oref eitest-a water) (oref-default eitest-a water)))
+
+    ;; After setting 'water to 'moose, make sure a new object has
+    ;; the right stuff.
+    (oset-default (eieio-object-class eitest-a) water 'penguin)
+    (should (eq (oref (class-a) water) 'penguin))
+
+    ;; Revert the above
+    (defmethod slot-unbound ((_a class-a) &rest _foo)
+      "If a slot in A is unbound, ignore FOO."
+      ;; Disable the old slot-unbound so we can run this test
+      ;; more than once
+      (with-suppressed-warnings ((obsolete call-next-method))
+        (call-next-method)))))
 
 (ert-deftest eieio-test-19-slot-type-checking ()
   ;; Slot type checking
@@ -617,12 +642,14 @@ METHOD is the method that was attempting to be called."
   ()
   "Protection testing baseclass.")
 
-(defmethod prot0-slot-2 ((s2 prot-0))
-  "Try to access slot-2 from this class which doesn't have it.
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod prot0-slot-2 ((s2 prot-0))
+    "Try to access slot-2 from this class which doesn't have it.
 The object S2 passed in will be of class prot-1, which does have
 the slot.  This could be allowed, and currently is in EIEIO.
 Needed by the eieio persistent base class."
-  (oref s2 slot-2))
+    (oref s2 slot-2)))
 
 (defclass prot-1 (prot-0)
   ((slot-1 :initarg :slot-1
@@ -640,26 +667,28 @@ Needed by the eieio persistent base class."
   nil
   "A class for testing the :protection option.")
 
-(defmethod prot1-slot-2 ((s2 prot-1))
-  "Try to access slot-2 in S2."
-  (oref s2 slot-2))
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod prot1-slot-2 ((s2 prot-1))
+    "Try to access slot-2 in S2."
+    (oref s2 slot-2))
 
-(defmethod prot1-slot-2 ((s2 prot-2))
-  "Try to access slot-2 in S2."
-  (oref s2 slot-2))
+  (defmethod prot1-slot-2 ((s2 prot-2))
+    "Try to access slot-2 in S2."
+    (oref s2 slot-2))
 
-(defmethod prot1-slot-3-only ((s2 prot-1))
-  "Try to access slot-3 in S2.
+  (defmethod prot1-slot-3-only ((s2 prot-1))
+    "Try to access slot-3 in S2.
 Do not override for `prot-2'."
-  (oref s2 slot-3))
+    (oref s2 slot-3))
 
-(defmethod prot1-slot-3 ((s2 prot-1))
-  "Try to access slot-3 in S2."
-  (oref s2 slot-3))
+  (defmethod prot1-slot-3 ((s2 prot-1))
+    "Try to access slot-3 in S2."
+    (oref s2 slot-3))
 
-(defmethod prot1-slot-3 ((s2 prot-2))
-  "Try to access slot-3 in S2."
-  (oref s2 slot-3))
+  (defmethod prot1-slot-3 ((s2 prot-2))
+    "Try to access slot-3 in S2."
+    (oref s2 slot-3)))
 
 (defvar eitest-p1 nil)
 (defvar eitest-p2 nil)
@@ -914,8 +943,10 @@ Subclasses to override slot attributes.")
 
 (defclass eieio--testing () ())
 
-(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
-  (list newname 2))
+(with-suppressed-warnings ((obsolete defmethod)
+                           (obsolete defgeneric))
+  (defmethod constructor :static ((_x eieio--testing) newname &rest _args)
+    (list newname 2)))
 
 (ert-deftest eieio-test-37-obsolete-name-in-constructor ()
   ;; FIXME repeated intermittent failures on hydra and elsewhere (bug#24503).
-- 
cgit v1.2.3


From d16db92cc790d0c3277e20a83030df6c4b5764e9 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sun, 5 Dec 2021 12:54:53 +0100
Subject: Silence byte-compiler in generator-tests.el

* test/lisp/emacs-lisp/generator-tests.el (cps-let*-shadow-empty)
(cps-let-shadow-empty, cps-let*-parallel): Silence byte-compiler.
---
 test/lisp/emacs-lisp/generator-tests.el | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

(limited to 'test/lisp/emacs-lisp')

diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index 492c4e40853..1d2aa7ab374 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -85,9 +85,9 @@ identical output."
 (cps-testcase cps-or-empty (or))
 
 (cps-testcase cps-let* (let* ((i 10)) i))
-(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i)))
+(cps-testcase cps-let*-shadow-empty (let* ((i 10)) i (let ((i nil)) i)))
 (cps-testcase cps-let (let ((i 10)) i))
-(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i)))
+(cps-testcase cps-let-shadow-empty (let ((i 10)) i (let ((i nil)) i)))
 (cps-testcase cps-let-novars (let nil 42))
 (cps-testcase cps-let*-novars (let* nil 42))
 
@@ -95,7 +95,7 @@ identical output."
   (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b))))
 
 (cps-testcase cps-let*-parallel
-  (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b))))
+  (let* ((a 5) (b 6)) a (let* ((a b) (b a)) (list a b))))
 
 (cps-testcase cps-while-dynamic
   (setq *cps-test-i* 0)
-- 
cgit v1.2.3