merge master

6 files changed, 125 insertions, 47 deletions

diff --git a/test/ChangeLog b/test/ChangeLog
index 8ed02ee341b..15baf866f37 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,34 @@
+2015-01-18  Leo Liu  <sdl.web@gmail.com>
+
+        * automated/seq-tests.el (test-seq-subseq): Add more tests.
+        (Bug#19434)
+
+2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * automated/eieio-tests.el
+        (eieio-test-37-obsolete-name-in-constructor): New test.
+
+2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * automated/eieio-tests.el (eieio-test-25-slot-tests)
+        (eieio-test-26-default-inheritance, eieio-test-28-slot-protection)
+        (eieio-test-30-slot-attribute-override)
+        (eieio-test-31-slot-attribute-override-class-allocation): Don't check
+        that we enforce :protection since we don't any more.
+
+        * automated/eieio-test-methodinvoke.el (eieio-test-method-store):
+        Use an explicit arg instead of eieio--scoped-class.  Update all callers.
+
+2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1):
+        Reset eieio-test--1.
+
+        * automated/cl-generic-tests.el (cl-generic-test-8-after/before):
+        Rename from cl-generic-test-7-after/before.
+        (cl--generic-test-advice): New function.
+        (cl-generic-test-9-advice): New test.
+
 2015-01-16  Jorgen Schaefer  <contact@jorgenschaefer.de>
 
         * automated/package-test.el (package-test-install-prioritized):
diff --git a/test/automated/cl-generic-tests.el b/test/automated/cl-generic-tests.el
index 17bce6a3157..46397fb7f51 100644
--- a/test/automated/cl-generic-tests.el
+++ b/test/automated/cl-generic-tests.el
@@ -129,5 +129,31 @@
     (cons "x&y-int" (cl-call-next-method)))
   (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2))))
 
+(ert-deftest cl-generic-test-8-after/before ()
+  (let ((log ()))
+    (cl-defgeneric cl--generic-1 (x y))
+    (cl-defmethod cl--generic-1 ((_x t) y) (cons y log))
+    (cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
+    (cons "quatre" (cl-call-next-method)))
+    (cl-defmethod cl--generic-1 :after (x _y)
+      (push (list :after x) log))
+    (cl-defmethod cl--generic-1 :before (x _y)
+      (push (list :before x) log))
+    (should (equal (cl--generic-1 4 6) '("quatre" 6 (:before 4))))
+    (should (equal log '((:after 4) (:before 4))))))
+
+(defun cl--generic-test-advice (&rest args) (cons "advice" (apply args)))
+
+(ert-deftest cl-generic-test-9-advice ()
+  (cl-defgeneric cl--generic-1 (x y) "My doc.")
+  (cl-defmethod cl--generic-1 (x y) (list x y))
+  (advice-add 'cl--generic-1 :around #'cl--generic-test-advice)
+  (should (equal (cl--generic-1 4 5) '("advice" 4 5)))
+  (cl-defmethod cl--generic-1 ((_x integer) _y)
+    (cons "integer" (cl-call-next-method)))
+  (should (equal (cl--generic-1 4 5) '("advice" "integer" 4 5)))
+  (advice-remove 'cl--generic-1 #'cl--generic-test-advice)
+  (should (equal (cl--generic-1 4 5) '("integer" 4 5))))
+
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here
diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el
index bbfb8d1f1da..c83391b1cc5 100644
--- a/test/automated/cl-lib-tests.el
+++ b/test/automated/cl-lib-tests.el
@@ -245,4 +245,7 @@
 (ert-deftest cl-loop-destructuring-with ()
   (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
 
+(ert-deftest cl-flet-test ()
+  (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
+
 ;;; cl-lib.el ends here
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
index 6362fc5a8d9..b6d60b85815 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -58,11 +58,9 @@
 (defvar eieio-test-method-order-list nil
   "List of symbols stored during method invocation.")
 
-(defun eieio-test-method-store (keysym)
+(defun eieio-test-method-store (&rest args)
   "Store current invocation class symbol in the invocation order list."
-  ;; FIXME: Don't depend on `eieio--scoped-class'!
-  (let* ((c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
-    (push c eieio-test-method-order-list)))
+  (push args eieio-test-method-order-list))
 
 (defun eieio-test-match (rightanswer)
   "Do a test match."
@@ -86,36 +84,36 @@
 (defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
 
 (defmethod eitest-F :BEFORE ((p eitest-B-base1))
-  (eieio-test-method-store :BEFORE))
+  (eieio-test-method-store :BEFORE 'eitest-B-base1))
 
 (defmethod eitest-F :BEFORE ((p eitest-B-base2))
-  (eieio-test-method-store :BEFORE))
+  (eieio-test-method-store :BEFORE 'eitest-B-base2))
 
 (defmethod eitest-F :BEFORE ((p eitest-B))
-  (eieio-test-method-store :BEFORE))
+  (eieio-test-method-store :BEFORE 'eitest-B))
 
 (defmethod eitest-F ((p eitest-B))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'eitest-B)
   (call-next-method))
 
 (defmethod eitest-F ((p eitest-B-base1))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'eitest-B-base1)
   (call-next-method))
 
 (defmethod eitest-F ((p eitest-B-base2))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'eitest-B-base2)
   (when (next-method-p)
     (call-next-method))
   )
 
 (defmethod eitest-F :AFTER ((p eitest-B-base1))
-  (eieio-test-method-store :AFTER))
+  (eieio-test-method-store :AFTER 'eitest-B-base1))
 
 (defmethod eitest-F :AFTER ((p eitest-B-base2))
-  (eieio-test-method-store :AFTER))
+  (eieio-test-method-store :AFTER 'eitest-B-base2))
 
 (defmethod eitest-F :AFTER ((p eitest-B))
-  (eieio-test-method-store :AFTER))
+  (eieio-test-method-store :AFTER 'eitest-B))
 
 (ert-deftest eieio-test-method-order-list-3 ()
   (let ((eieio-test-method-order-list nil)
@@ -150,15 +148,15 @@
 ;;; Return value from :PRIMARY
 ;;
 (defmethod eitest-I :BEFORE ((a eitest-A))
-  (eieio-test-method-store :BEFORE)
+  (eieio-test-method-store :BEFORE 'eitest-A)
   ":before")
 
 (defmethod eitest-I :PRIMARY ((a eitest-A))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'eitest-A)
   ":primary")
 
 (defmethod eitest-I :AFTER ((a eitest-A))
-  (eieio-test-method-store :AFTER)
+  (eieio-test-method-store :AFTER 'eitest-A)
   ":after")
 
 (ert-deftest eieio-test-method-order-list-5 ()
@@ -177,17 +175,17 @@
 
 ;; 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)
+  (eieio-test-method-store :STATIC 'C-base1)
   (if (next-method-p) (call-next-method))
   )
 
 (defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
-  (eieio-test-method-store :STATIC)
+  (eieio-test-method-store :STATIC 'C-base2)
   (if (next-method-p) (call-next-method))
   )
 
 (defmethod eieio-constructor :STATIC ((p C) &rest args)
-  (eieio-test-method-store :STATIC)
+  (eieio-test-method-store :STATIC 'C)
   (call-next-method)
   )
 
@@ -214,24 +212,24 @@
 
 (defmethod eitest-F ((p D))
   "D"
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'D)
   (call-next-method))
 
 (defmethod eitest-F ((p D-base0))
   "D-base0"
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'D-base0)
   ;; This should have no next
   ;; (when (next-method-p) (call-next-method))
   )
 
 (defmethod eitest-F ((p D-base1))
   "D-base1"
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'D-base1)
   (call-next-method))
 
 (defmethod eitest-F ((p D-base2))
   "D-base2"
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'D-base2)
   (when (next-method-p)
     (call-next-method))
   )
@@ -256,21 +254,21 @@
 (defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
 
 (defmethod eitest-F ((p E))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'E)
   (call-next-method))
 
 (defmethod eitest-F ((p E-base0))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'E-base0)
   ;; This should have no next
   ;; (when (next-method-p) (call-next-method))
   )
 
 (defmethod eitest-F ((p E-base1))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'E-base1)
   (call-next-method))
 
 (defmethod eitest-F ((p E-base2))
-  (eieio-test-method-store :PRIMARY)
+  (eieio-test-method-store :PRIMARY 'E-base2)
   (when (next-method-p)
     (call-next-method))
   )
@@ -384,6 +382,7 @@
 (cl-defgeneric eieio-test--1 (x y))
 
 (ert-deftest eieio-test-cl-generic-1 ()
+  (cl-defgeneric eieio-test--1 (x y))
   (cl-defmethod eieio-test--1 (x y) (list x y))
   (cl-defmethod eieio-test--1 ((_x CNM-0) y)
     (cons "CNM-0" (cl-call-next-method 7 y)))
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index 0b1ff1fd93b..e0120b4b5b8 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -563,7 +563,7 @@ METHOD is the method that was attempting to be called."
   (should (eq (oref eitest-t1 slot-1) 'moose))
   (should (eq (oref eitest-t1 :moose) 'moose))
   ;; Don't pass reference of private slot
-  (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
+  ;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
   ;; Check private slot accessor
   (should (string= (get-slot-2 eitest-t1) "penguin"))
   ;; Pass string instead of symbol
@@ -583,7 +583,7 @@ METHOD is the method that was attempting to be called."
   (should (eq (oref eitest-t2 slot-1) 'moose))
   (should (eq (oref eitest-t2 :moose) 'moose))
   (should (string= (get-slot-2 eitest-t2) "linux"))
-  (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
+  ;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
   (should (string= (get-slot-2 eitest-t2) "linux"))
   (should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type))
 
@@ -654,20 +654,23 @@ Do not override for `prot-2'."
   ;; Access public slots
   (oref eitest-p1 slot-1)
   (oref eitest-p2 slot-1)
-  ;; Accessing protected slot out of context must fail
-  (should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
+  ;; Accessing protected slot out of context used to fail, but we dropped this
+  ;; feature, since it was underused and noone noticed that the check was
+  ;; incorrect (much too loose).
+  ;;PROTECTED (should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
   ;; Access protected slot in method
   (prot1-slot-2 eitest-p1)
   ;; Protected slot in subclass method
   (prot1-slot-2 eitest-p2)
   ;; Protected slot from parent class method
   (prot0-slot-2 eitest-p1)
-  ;; Accessing private slot out of context must fail
-  (should-error (oref eitest-p1 slot-3) :type 'invalid-slot-name)
+  ;; Accessing private slot out of context used to fail, but we dropped this
+  ;; feature, since it was not used.
+  ;;PRIVATE (should-error (oref eitest-p1 slot-3) :type 'invalid-slot-name)
   ;; Access private slot in method
   (prot1-slot-3 eitest-p1)
   ;; Access private slot in subclass method must fail
-  (should-error (prot1-slot-3 eitest-p2) :type 'invalid-slot-name)
+  ;;PRIVATE (should-error (prot1-slot-3 eitest-p2) :type 'invalid-slot-name)
   ;; Access private slot by same class
   (prot1-slot-3-only eitest-p1)
   ;; Access private slot by subclass in sameclass method
@@ -729,12 +732,13 @@ Subclasses to override slot attributes.")
 
 (ert-deftest eieio-test-30-slot-attribute-override ()
   ;; Subclass should not override :protection slot attribute
-  (should-error
-        (eval
-         '(defclass slotattr-fail (slotattr-base)
-            ((protection :protection :public)
-             )
-            "This class should throw an error.")))
+  ;;PROTECTION is gone.
+  ;;(should-error
+  ;;       (eval
+  ;;        '(defclass slotattr-fail (slotattr-base)
+  ;;           ((protection :protection :public)
+  ;;            )
+  ;;           "This class should throw an error.")))
 
   ;; Subclass should not override :type slot attribute
   (should-error
@@ -782,12 +786,13 @@ Subclasses to override slot attributes.")
 
 (ert-deftest eieio-test-31-slot-attribute-override-class-allocation ()
   ;; Same as test-30, but with class allocation
-  (should-error
-      (eval
-       '(defclass slotattr-fail (slotattr-class-base)
-          ((protection :protection :public)
-           )
-          "This class should throw an error.")))
+  ;;PROTECTION is gone.
+  ;;(should-error
+  ;;     (eval
+  ;;      '(defclass slotattr-fail (slotattr-class-base)
+  ;;         ((protection :protection :public)
+  ;;          )
+  ;;         "This class should throw an error.")))
   (should-error
       (eval
        '(defclass slotattr-fail (slotattr-class-base)
@@ -887,6 +892,15 @@ Subclasses to override slot attributes.")
   (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
   (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
 
+(defclass eieio--testing ()
+  ())
+
+(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
+  (list newname 2))
+
+(ert-deftest eieio-test-37-obsolete-name-in-constructor ()
+  (should (equal (eieio--testing "toto") '("toto" 2))))
+
 (provide 'eieio-tests)
 
 ;;; eieio-tests.el ends here
diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el
index 9fcda7f7c9d..23989799306 100644
--- a/test/automated/seq-tests.el
+++ b/test/automated/seq-tests.el
@@ -182,7 +182,12 @@ Evaluate BODY for each created sequence.
     (should (same-contents-p (seq-subseq seq 1 -1) '(3 4))))
   (should (vectorp (seq-subseq [2 3 4 5] 2)))
   (should (stringp (seq-subseq "foo" 2 3)))
-  (should (listp (seq-subseq '(2 3 4 4) 2 3))))
+  (should (listp (seq-subseq '(2 3 4 4) 2 3)))
+  (should-error (seq-subseq '(1 2 3) 4))
+  (should-not   (seq-subseq '(1 2 3) 3))
+  (should       (seq-subseq '(1 2 3) -3))
+  (should-error (seq-subseq '(1 2 3) 1 4))
+  (should       (seq-subseq '(1 2 3) 1 3)))
 
 (ert-deftest test-seq-concatenate ()
   (with-test-sequences (seq '(2 4 6))