Merge from origin/emacs-26

134edc1 Warn about wrong number of args for subrs (Bug#35767)
5f01af6 Use plain symbols for eieio type descriptors (Bug#29220)
4b24b01 Pacify GCC 9 -Wredundant-decls

lisp/emacs-lisp/bytecomp.el

@@ -1401,7 +1401,7 @@ when printing the error message."
 (defun byte-compile-callargs-warn (form)
   (let* ((def (or (byte-compile-fdefinition (car form) nil)
 		  (byte-compile-fdefinition (car form) t)))
-	 (sig (byte-compile--function-signature def))
+         (sig (byte-compile--function-signature (or def (car form))))
 	 (ncall (length (cdr form))))
     ;; Check many or unevalled from subr-arity.
     (if (and (cdr-safe sig)

lisp/emacs-lisp/eieio-core.el

@@ -117,9 +117,6 @@ Currently under control of this var:
 (defsubst eieio--object-class-tag (obj)
   (aref obj 0))
 
-(defsubst eieio--object-class (obj)
-  (eieio--object-class-tag obj))
-
 
 ;;; Important macros used internally in eieio.
 
@@ -132,6 +129,12 @@ Currently under control of this var:
       (or (cl--find-class class) class)
     class))
 
+(defsubst eieio--object-class (obj)
+  (let ((tag (eieio--object-class-tag obj)))
+    (if eieio-backward-compatibility
+        (eieio--class-object tag)
+      tag)))
+
 (defun class-p (x)
   "Return non-nil if X is a valid class vector.
 X can also be is a symbol."
@@ -163,7 +166,7 @@ Return nil if that option doesn't exist."
 (defun eieio-object-p (obj)
   "Return non-nil if OBJ is an EIEIO object."
   (and (recordp obj)
-       (eieio--class-p (eieio--object-class-tag obj))))
+       (eieio--class-p (eieio--object-class obj))))
 
 (define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
 

lisp/emacs-lisp/eieio.el

@@ -710,6 +710,9 @@ calls `initialize-instance' on that object."
     ;; Call the initialize method on the new object with the slots
     ;; that were passed down to us.
     (initialize-instance new-object slots)
+    (when eieio-backward-compatibility
+      ;; Use symbol as type descriptor, for backwards compatibility.
+      (aset new-object 0 class))
     ;; Return the created object.
     new-object))
 

src/gmalloc.c

@@ -181,7 +181,7 @@ struct list
   };
 
 /* Free list headers for each fragment size.  */
-extern struct list _fraghead[];
+static struct list _fraghead[BLOCKLOG];
 
 /* List of blocks allocated with aligned_alloc and friends.  */
 struct alignlist
@@ -339,9 +339,6 @@ size_t _heapindex;
 /* Limit of valid info table indices.  */
 size_t _heaplimit;
 
-/* Free lists for each fragment size.  */
-struct list _fraghead[BLOCKLOG];
-
 /* Instrumentation.  */
 size_t _chunks_used;
 size_t _bytes_used;
@@ -351,10 +348,6 @@ size_t _bytes_free;
 /* Are you experienced?  */
 int __malloc_initialized;
 
-#else
-
-static struct list _fraghead[BLOCKLOG];
-
 #endif /* HYBRID_MALLOC */
 
 /* Number of extra blocks to get each time we ask for more core.

test/lisp/emacs-lisp/bytecomp-tests.el

@@ -456,6 +456,20 @@ Subtests signal errors if something goes wrong."
     ;; Should not warn that mt--test2 is not known to be defined.
     (should-not (re-search-forward "my--test2" nil t))))
 
+(ert-deftest bytecomp-warn-wrong-args ()
+  (with-current-buffer (get-buffer-create "*Compile-Log*")
+    (let ((inhibit-read-only t)) (erase-buffer))
+    (byte-compile '(remq 1 2 3))
+    (ert-info ((buffer-string) :prefix "buffer: ")
+      (should (re-search-forward "remq.*3.*2")))))
+
+(ert-deftest bytecomp-warn-wrong-args-subr ()
+  (with-current-buffer (get-buffer-create "*Compile-Log*")
+    (let ((inhibit-read-only t)) (erase-buffer))
+    (byte-compile '(safe-length 1 2 3))
+    (ert-info ((buffer-string) :prefix "buffer: ")
+      (should (re-search-forward "safe-length.*3.*1")))))
+
 (ert-deftest test-eager-load-macro-expansion ()
   (test-byte-comp-compile-and-load nil
     '(progn (defmacro abc (arg) 1) (defun def () (abc 2))))

test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el

@@ -274,7 +274,7 @@ persistent class.")
     :type vector
     :initarg :random-vector)))
 
-(ert-deftest eieio-test-persist-hash-and-vector ()
+(defun eieio-test-persist-hash-and-vector ()
   (let* ((jane (make-instance 'person :name "Jane"))
          (bob  (make-instance 'person :name "Bob"))
          (hans (make-instance 'person :name "Hans"))
@@ -294,10 +294,18 @@ persistent class.")
     (aset (car (slot-value class 'janitors)) 1 hans)
     (aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
     (unwind-protect
-        ;; FIXME: This should not error.
-        (should-error (persist-test-save-and-compare class))
+        (persist-test-save-and-compare class)
       (delete-file (oref class file)))))
 
+(ert-deftest eieio-persist-hash-and-vector-backward-compatibility ()
+  (let ((eieio-backward-compatibility t)) ; The default.
+    (eieio-test-persist-hash-and-vector)))
+
+(ert-deftest eieio-persist-hash-and-vector-no-backward-compatibility ()
+  :expected-result :failed ;; Bug#29220.
+  (let ((eieio-backward-compatibility nil))
+    (eieio-test-persist-hash-and-vector)))
+
 ;; Extra quotation of lists inside other objects (Gnus registry), also
 ;; bug#29220.
 
@@ -312,7 +320,7 @@ persistent class.")
     :initarg :htab
     :type hash-table)))
 
-(ert-deftest eieio-test-persist-interior-lists ()
+(defun eieio-test-persist-interior-lists ()
   (let* ((thing (make-instance
                  'eieio-container
                  :vec [nil]
@@ -332,8 +340,16 @@ persistent class.")
     (setf (nth 2 (cadar alst)) john
           (nth 2 (cadadr alst)) alexie)
     (unwind-protect
-        ;; FIXME: Should not error.
-        (should-error (persist-test-save-and-compare thing))
+        (persist-test-save-and-compare thing)
       (delete-file (slot-value thing 'file)))))
 
+(ert-deftest eieio-test-persist-interior-lists-backward-compatibility ()
+  (let ((eieio-backward-compatibility t)) ; The default.
+    (eieio-test-persist-interior-lists)))
+
+(ert-deftest eieio-test-persist-interior-lists-no-backward-compatibility ()
+  :expected-result :failed ;; Bug#29220.
+  (let ((eieio-backward-compatibility nil))
+    (eieio-test-persist-interior-lists)))
+
 ;;; eieio-test-persist.el ends here