diff options
| author | Stefan Monnier | 2015-01-18 12:24:43 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-01-18 12:24:43 -0500 |
| commit | 2a61bd0096db23123734db439051c859e42b9606 (patch) | |
| tree | 95bf8383ee904cf723e57d1560f86fc551fb139b /lisp | |
| parent | 8ab85ee7ce9ad101583620e7ba3bee39cf3491ae (diff) | |
| download | emacs-2a61bd0096db23123734db439051c859e42b9606.tar.gz emacs-2a61bd0096db23123734db439051c859e42b9606.zip | |
EIEIO&cl-generic: Add obsolescence warnings and fix corner case
* lisp/emacs-lisp/cl-generic.el (cl-generic-define-method): Correctly handle
introduction of a new dispatch argument.
(cl--generic-cache-miss): Handle dispatch on an argument which was not
considered as dispatchable for this method.
(cl-defmethod): Warn when adding a method to an obsolete generic function.
(cl--generic-lambda): Make sure it works if cl-lib is not yet loaded.
* lisp/emacs-lisp/eieio-generic.el (eieio--defgeneric-init-form):
Use autoloadp.
* lisp/emacs-lisp/eieio.el (defclass): Add obsolescence warning for the
`newname' argument.
* test/automated/cl-generic-tests.el (cl-generic-test-10-weird): New test.
Rename other tests to preserve ordering.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 20 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 27 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-generic.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 11 |
4 files changed, 47 insertions, 13 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b7a1fb943a3..c731551f913 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,6 +1,20 @@ | |||
| 1 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the | ||
| 4 | `newname' argument. | ||
| 5 | |||
| 6 | * emacs-lisp/cl-generic.el (cl-generic-define-method): Correctly handle | ||
| 7 | introduction of a new dispatch argument. | ||
| 8 | (cl--generic-cache-miss): Handle dispatch on an argument which was not | ||
| 9 | considered as dispatchable for this method. | ||
| 10 | (cl-defmethod): Warn when adding a method to an obsolete generic function. | ||
| 11 | (cl--generic-lambda): Make sure it works if cl-lib is not yet loaded. | ||
| 12 | |||
| 13 | * emacs-lisp/eieio-generic.el (eieio--defgeneric-init-form): Use autoloadp. | ||
| 14 | |||
| 1 | 2015-01-18 Artur Malabarba <bruce.connor.am@gmail.com> | 15 | 2015-01-18 Artur Malabarba <bruce.connor.am@gmail.com> |
| 2 | 16 | ||
| 3 | * emacs-lisp/package.el (package--append-to-alist): Renamed from | 17 | * emacs-lisp/package.el (package--append-to-alist): Rename from |
| 4 | `package--add-to-alist' | 18 | `package--add-to-alist' |
| 5 | Updated docstring due to new name. | 19 | Updated docstring due to new name. |
| 6 | 20 | ||
| @@ -862,8 +876,8 @@ | |||
| 862 | 2014-12-27 Eli Zaretskii <eliz@gnu.org> | 876 | 2014-12-27 Eli Zaretskii <eliz@gnu.org> |
| 863 | 877 | ||
| 864 | * language/misc-lang.el (composition-function-table): Add Syriac | 878 | * language/misc-lang.el (composition-function-table): Add Syriac |
| 865 | characters and also ZWJ/ZWNJ. See | 879 | characters and also ZWJ/ZWNJ. |
| 866 | http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html | 880 | See http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html |
| 867 | for the details. | 881 | for the details. |
| 868 | 882 | ||
| 869 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | 883 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> |
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 819e2e92888..544f1fa140f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -212,13 +212,13 @@ This macro can only be used within the lexical scope of a cl-generic method." | |||
| 212 | (macroenv (cons `(cl-generic-current-method-specializers | 212 | (macroenv (cons `(cl-generic-current-method-specializers |
| 213 | . ,(lambda () specializers)) | 213 | . ,(lambda () specializers)) |
| 214 | macroexpand-all-environment))) | 214 | macroexpand-all-environment))) |
| 215 | (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'. | ||
| 215 | (if (not with-cnm) | 216 | (if (not with-cnm) |
| 216 | (cons nil (macroexpand-all fun macroenv)) | 217 | (cons nil (macroexpand-all fun macroenv)) |
| 217 | ;; First macroexpand away the cl-function stuff (e.g. &key and | 218 | ;; First macroexpand away the cl-function stuff (e.g. &key and |
| 218 | ;; destructuring args, `declare' and whatnot). | 219 | ;; destructuring args, `declare' and whatnot). |
| 219 | (pcase (macroexpand fun macroenv) | 220 | (pcase (macroexpand fun macroenv) |
| 220 | (`#'(lambda ,args . ,body) | 221 | (`#'(lambda ,args . ,body) |
| 221 | (require 'cl-lib) ;Needed to expand `cl-flet'. | ||
| 222 | (let* ((doc-string (and doc-string (stringp (car body)) | 222 | (let* ((doc-string (and doc-string (stringp (car body)) |
| 223 | (pop body))) | 223 | (pop body))) |
| 224 | (cnm (make-symbol "cl--cnm")) | 224 | (cnm (make-symbol "cl--cnm")) |
| @@ -287,6 +287,13 @@ which case this method will be invoked when the argument is `eql' to VAL. | |||
| 287 | (cadr name)))) | 287 | (cadr name)))) |
| 288 | (setq name setter) | 288 | (setq name setter) |
| 289 | code)) | 289 | code)) |
| 290 | ,(and (get name 'byte-obsolete-info) | ||
| 291 | (or (not (fboundp 'byte-compile-warning-enabled-p)) | ||
| 292 | (byte-compile-warning-enabled-p 'obsolete)) | ||
| 293 | (let* ((obsolete (get name 'byte-obsolete-info))) | ||
| 294 | (macroexp--warn-and-return | ||
| 295 | (macroexp--obsolete-warning name obsolete "generic function") | ||
| 296 | nil))) | ||
| 290 | (cl-generic-define-method ',name ',qualifiers ',args | 297 | (cl-generic-define-method ',name ',qualifiers ',args |
| 291 | ,uses-cnm ,fun))))) | 298 | ,uses-cnm ,fun))))) |
| 292 | 299 | ||
| @@ -308,13 +315,14 @@ which case this method will be invoked when the argument is `eql' to VAL. | |||
| 308 | (dolist (specializer specializers) | 315 | (dolist (specializer specializers) |
| 309 | (let* ((tagcode (funcall cl-generic-tagcode-function specializer 'arg)) | 316 | (let* ((tagcode (funcall cl-generic-tagcode-function specializer 'arg)) |
| 310 | (x (assq i dispatches))) | 317 | (x (assq i dispatches))) |
| 311 | (if (not x) | 318 | (unless x |
| 312 | (setf (cl--generic-dispatches generic) | 319 | (setq x (list i (funcall cl-generic-tagcode-function t 'arg))) |
| 313 | (setq dispatches (cons (list i tagcode) dispatches))) | 320 | (setf (cl--generic-dispatches generic) |
| 314 | (unless (member tagcode (cdr x)) | 321 | (setq dispatches (cons x dispatches)))) |
| 315 | (setf (cdr x) | 322 | (unless (member tagcode (cdr x)) |
| 316 | (nreverse (sort (cons tagcode (cdr x)) | 323 | (setf (cdr x) |
| 317 | #'car-less-than-car))))) | 324 | (nreverse (sort (cons tagcode (cdr x)) |
| 325 | #'car-less-than-car)))) | ||
| 318 | (setq i (1+ i)))) | 326 | (setq i (1+ i)))) |
| 319 | (if me (setcdr me (cons uses-cnm function)) | 327 | (if me (setcdr me (cons uses-cnm function)) |
| 320 | (setf (cl--generic-method-table generic) | 328 | (setf (cl--generic-method-table generic) |
| @@ -478,7 +486,8 @@ for all those different tags in the method-cache.") | |||
| 478 | (let ((types (apply #'append (mapcar cl-generic-tag-types-function tags))) | 486 | (let ((types (apply #'append (mapcar cl-generic-tag-types-function tags))) |
| 479 | (methods '())) | 487 | (methods '())) |
| 480 | (dolist (method-desc (cl--generic-method-table generic)) | 488 | (dolist (method-desc (cl--generic-method-table generic)) |
| 481 | (let ((m (member (nth dispatch-arg (caar method-desc)) types))) | 489 | (let* ((specializer (or (nth dispatch-arg (caar method-desc)) t)) |
| 490 | (m (member specializer types))) | ||
| 482 | (when m | 491 | (when m |
| 483 | (push (cons (length m) method-desc) methods)))) | 492 | (push (cons (length m) method-desc) methods)))) |
| 484 | ;; Sort the methods, most specific first. | 493 | ;; Sort the methods, most specific first. |
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el index 27a58493905..74ecefe7863 100644 --- a/lisp/emacs-lisp/eieio-generic.el +++ b/lisp/emacs-lisp/eieio-generic.el | |||
| @@ -110,7 +110,7 @@ Methods with only primary implementations are executed in an optimized way." | |||
| 110 | 110 | ||
| 111 | (cond | 111 | (cond |
| 112 | ((or (not (fboundp method)) | 112 | ((or (not (fboundp method)) |
| 113 | (eq 'autoload (car-safe (symbol-function method)))) | 113 | (autoloadp (symbol-function method))) |
| 114 | ;; Make sure the method tables are installed. | 114 | ;; Make sure the method tables are installed. |
| 115 | (eieio--mt-install method) | 115 | (eieio--mt-install method) |
| 116 | ;; Construct the actual body of this function. | 116 | ;; Construct the actual body of this function. |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index c5597b83170..0c85d90151a 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -276,6 +276,17 @@ and reference them using the function `class-option'." | |||
| 276 | `(defun ,name (&rest slots) | 276 | `(defun ,name (&rest slots) |
| 277 | ,(format "Create a new object with name NAME of class type %S." | 277 | ,(format "Create a new object with name NAME of class type %S." |
| 278 | name) | 278 | name) |
| 279 | (declare (compiler-macro | ||
| 280 | (lambda (whole) | ||
| 281 | (if (not (stringp (car slots))) | ||
| 282 | whole | ||
| 283 | (macroexp--warn-and-return | ||
| 284 | (format "Obsolete name arg %S to constructor %S" | ||
| 285 | (car slots) (car whole)) | ||
| 286 | ;; Keep the name arg, for backward compatibility, | ||
| 287 | ;; but hide it so we don't trigger indefinitely. | ||
| 288 | `(,(car whole) (identity ,(car slots)) | ||
| 289 | ,@(cdr slots))))))) | ||
| 279 | (apply #'eieio-constructor ',name slots)))))) | 290 | (apply #'eieio-constructor ',name slots)))))) |
| 280 | 291 | ||
| 281 | 292 | ||