[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/oclosure 20e5cd82ae 13/25: Fix bug#28557
From: |
Stefan Monnier |
Subject: |
scratch/oclosure 20e5cd82ae 13/25: Fix bug#28557 |
Date: |
Fri, 31 Dec 2021 15:40:58 -0500 (EST) |
branch: scratch/oclosure
commit 20e5cd82aec81a411dd5e4fd880cccc8dabe3455
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Fix bug#28557
* test/lisp/emacs-lisp/cconv-tests.el: Remove `:expected-result :failed`
from the bug#28557 tests.
(cconv-tests-cl-function-:documentation): Account for the presence of
the arglist (aka "usage") in the docstring.
* lisp/emacs-lisp/cl-macs.el (cl--transform-lambda):
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric):
Handle non-constant `:documentation`.
* lisp/emacs-lisp/generator.el (iter-lambda):
* lisp/emacs-lisp/oclosure.el (oclosure-lambda):
* lisp/emacs-lisp/cconv.el (cconv--convert-funcbody):
Use `macroexp-parse-body`.
* lisp/calendar/icalendar.el (icalendar--decode-isodatetime):
Fix misuse of `cl-lib` without requiring it.
---
lisp/calendar/icalendar.el | 4 +--
lisp/emacs-lisp/cconv.el | 11 ++------
lisp/emacs-lisp/cl-generic.el | 4 ++-
lisp/emacs-lisp/cl-macs.el | 29 ++++++++++++-------
lisp/emacs-lisp/generator.el | 6 ++--
lisp/emacs-lisp/nadvice.el | 2 ++
lisp/emacs-lisp/oclosure.el | 55 +++++++++++++++++++------------------
test/lisp/emacs-lisp/cconv-tests.el | 14 +---------
8 files changed, 62 insertions(+), 63 deletions(-)
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 7a483d4062..01387341d6 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -645,10 +645,10 @@ FIXME: multiple comma-separated values should be allowed!"
(setq second (read (substring isodatetimestring 13 15))))
;; FIXME: Support subseconds.
(when (> (length isodatetimestring) 15)
- (cl-case (aref isodatetimestring 15)
+ (pcase (aref isodatetimestring 15)
(?Z
(setq source-zone t))
- ((?- ?+)
+ ((or ?- ?+)
(setq source-zone
(concat "UTC" (substring isodatetimestring 15))))))
;; shift if necessary
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 97066da0ee..66e0c35941 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -294,15 +294,10 @@ of converted forms."
(cconv-convert form env nil))
funcbody))
(if wrappers
- (let ((special-forms '()))
- ;; Keep special forms at the beginning of the body.
- (while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring.
- (memq (car-safe (car funcbody))
- '(interactive declare :documentation)))
- (push (pop funcbody) special-forms))
- (let ((body (macroexp-progn funcbody)))
+ (pcase-let ((`(,decls . ,body) (macroexp-parse-body funcbody)))
+ (let ((body (macroexp-progn body)))
(dolist (wrapper wrappers) (setq body (funcall wrapper body)))
- `(,@(nreverse special-forms) ,@(macroexp-unprogn body))))
+ `(,@decls ,@(macroexp-unprogn body))))
funcbody)))
(defun cconv--lifted-arg (var env)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 44018da30e..1886f309e3 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -286,7 +286,9 @@ DEFAULT-BODY, if present, is used as the body of a default
method.
(progn
(defalias ',name
(cl-generic-define ',name ',args ',(nreverse options))
- ,(help-add-fundoc-usage doc args))
+ ,(if (consp doc) ;An expression rather than a constant.
+ `(docstring-add-fundoc-usage ,doc ',args)
+ (docstring-add-fundoc-usage doc args)))
:autoload-end
,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
(nreverse methods)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6bd0d0c328..96559fbfb6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -301,24 +301,33 @@ FORM is of the form (ARGS . BODY)."
(t ;; `simple-args' doesn't handle all the parsing that we need,
;; so we pass the rest to cl--do-arglist which will do
;; "manual" parsing.
- (let ((slen (length simple-args)))
- (when (memq '&optional simple-args)
- (cl-decf slen))
- (setq header
+ (let ((slen (length simple-args))
+ (usage-str
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
+ (docstring--quote
+ (let ((print-gensym nil) (print-quoted t)
+ (print-escape-newlines t))
+ (format "%S" (cons 'fn (cl--make-usage-args
+ orig-args))))))))
+ (when (memq '&optional simple-args)
+ (cl-decf slen))
+ (setq header
+ (cond
+ ((eq :documentation (caar header))
+ `((:documentation (docstring-add-fundoc-usage
+ ,(cadr (car header))
+ ,usage-str))
+ ,@(cdr header)))
+ (t
(cons (docstring-add-fundoc-usage
(if (stringp (car header)) (pop header))
;; Be careful with make-symbol and (back)quote,
;; see bug#12884.
- (docstring--quote
- (let ((print-gensym nil) (print-quoted t)
- (print-escape-newlines t))
- (format "%S" (cons 'fn (cl--make-usage-args
- orig-args))))))
- header)))
+ usage-str)
+ header))))
;; FIXME: we'd want to choose an arg name for the &rest param
;; and pass that as `expr' to cl--do-arglist, but that ends up
;; generating code with a redundant let-binding, so we instead
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index cb0241017a..a768c6ae83 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -692,8 +692,10 @@ of values. Callers can retrieve each value using
`iter-next'."
(declare (indent defun)
(debug (&define lambda-list lambda-doc &rest sexp)))
(cl-assert lexical-binding)
- `(lambda ,arglist
- ,(cps-generate-evaluator body)))
+ (pcase-let* ((`(,declarations . ,exps) (macroexp-parse-body body)))
+ `(lambda ,arglist
+ ,@declarations
+ ,(cps-generate-evaluator exps))))
(defmacro iter-make (&rest body)
"Return a new iterator."
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index ea6b4d73d3..3a1c4a2a58 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -484,6 +484,8 @@ is defined as a macro, alias, command, ..."
(get symbol 'advice--pending))
(t (symbol-function symbol)))
function props)
+ ;; FIXME: We could use a defmethod on `function-docstring' instead,
+ ;; except when (or (not nf) (autoloadp nf))!
(put symbol 'function-documentation `(advice--make-docstring ',symbol))
(add-function :around (get symbol 'defalias-fset-function)
#'advice--defalias-fset))
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index f8ed5bfa39..3462e62a43 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -187,33 +187,34 @@
(defmacro oclosure-lambda (type fields args &rest body)
(declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))
- ;; FIXME: Provide the fields in the order specified by `type'.
- (let* ((class (cl--find-class type))
- (slots (oclosure--class-slots class))
- (prebody '())
- (slotbinds (nreverse
- (mapcar (lambda (slot)
- (list (cl--slot-descriptor-name slot)))
- slots)))
- (tempbinds (mapcar
- (lambda (field)
- (let* ((name (car field))
- (bind (assq name slotbinds)))
- (cond
- ((not bind)
- (error "Unknown slots: %S" name))
- ((cdr bind)
- (error "Duplicate slots: %S" name))
- (t
- (let ((temp (gensym "temp")))
- (setcdr bind (list temp))
- (cons temp (cdr field)))))))
- fields)))
- ;; FIXME: Since we use the docstring internally to store the
- ;; type we can't handle actual docstrings. We could fix this by adding
- ;; a docstring slot to OClosures.
- (while (memq (car-safe (car-safe body)) '(interactive declare))
- (push (pop body) prebody))
+ ;; FIXME: Should `oclosure-define' distinguish "optional" from
+ ;; "mandatory" slots, and/or provide default values for slots missing
+ ;; from `fields'?
+ (pcase-let*
+ ((class (cl--find-class type))
+ (slots (oclosure--class-slots class))
+ ;; FIXME: Since we use the docstring internally to store the
+ ;; type we can't handle actual docstrings. We could fix this by adding
+ ;; a docstring slot to OClosures.
+ (`(,prebody . ,body) (macroexp-parse-body body))
+ (slotbinds (nreverse
+ (mapcar (lambda (slot)
+ (list (cl--slot-descriptor-name slot)))
+ slots)))
+ (tempbinds (mapcar
+ (lambda (field)
+ (let* ((name (car field))
+ (bind (assq name slotbinds)))
+ (cond
+ ((not bind)
+ (error "Unknown slots: %S" name))
+ ((cdr bind)
+ (error "Duplicate slots: %S" name))
+ (t
+ (let ((temp (gensym "temp")))
+ (setcdr bind (list temp))
+ (cons temp (cdr field)))))))
+ fields)))
;; FIXME: Optimize temps away when they're provided in the right order?
;; FIXME: Slots not specified in `fields' tend to emit "Variable FOO left
;; uninitialized"!
diff --git a/test/lisp/emacs-lisp/cconv-tests.el
b/test/lisp/emacs-lisp/cconv-tests.el
index 0701892b8c..d7f9af1899 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -83,9 +83,6 @@
(iter-yield 'cl-iter-defun-result))
(ert-deftest cconv-tests-cl-iter-defun-:documentation ()
"Docstring for cl-iter-defun can be specified with :documentation."
- ;; FIXME: See Bug#28557.
- :tags '(:unstable)
- :expected-result :failed
(should (string= (documentation 'cconv-tests-cl-iter-defun)
"cl-iter-defun documentation"))
(should (eq (iter-next (cconv-tests-cl-iter-defun))
@@ -96,17 +93,12 @@
(iter-yield 'iter-defun-result))
(ert-deftest cconv-tests-iter-defun-:documentation ()
"Docstring for iter-defun can be specified with :documentation."
- ;; FIXME: See Bug#28557.
- :tags '(:unstable)
- :expected-result :failed
(should (string= (documentation 'cconv-tests-iter-defun)
"iter-defun documentation"))
(should (eq (iter-next (cconv-tests-iter-defun)) 'iter-defun-result)))
(ert-deftest cconv-tests-iter-lambda-:documentation ()
"Docstring for iter-lambda can be specified with :documentation."
- ;; FIXME: See Bug#28557.
- :expected-result :failed
(let ((iter-fun
(iter-lambda ()
(:documentation (concat "iter-lambda" " documentation"))
@@ -116,13 +108,11 @@
(ert-deftest cconv-tests-cl-function-:documentation ()
"Docstring for cl-function can be specified with :documentation."
- ;; FIXME: See Bug#28557.
- :expected-result :failed
(let ((fun (cl-function (lambda (&key arg)
(:documentation (concat "cl-function"
" documentation"))
(list arg 'cl-function-result)))))
- (should (string= (documentation fun) "cl-function documentation"))
+ (should (string-match "\\`cl-function documentation$" (documentation fun)))
(should (equal (funcall fun :arg t) '(t cl-function-result)))))
(ert-deftest cconv-tests-function-:documentation ()
@@ -142,8 +132,6 @@
(+ 1 n))
(ert-deftest cconv-tests-cl-defgeneric-:documentation ()
"Docstring for cl-defgeneric can be specified with :documentation."
- ;; FIXME: See Bug#28557.
- :expected-result :failed
(let ((descr (describe-function 'cconv-tests-cl-defgeneric)))
(set-text-properties 0 (length descr) nil descr)
(should (string-match-p "cl-defgeneric documentation" descr))
- scratch/oclosure d93b0ad4d4 06/25: (interactive-form, function-docstring): New generic functions, (continued)
- scratch/oclosure d93b0ad4d4 06/25: (interactive-form, function-docstring): New generic functions, Stefan Monnier, 2021/12/31
- scratch/oclosure a444d85977 08/25: Fix bootstrap problems and various misc issues found along the way, Stefan Monnier, 2021/12/31
- scratch/oclosure f44ee8cd53 17/25: oclosure.el (accessor): New type, Stefan Monnier, 2021/12/31
- scratch/oclosure 55a8e92413 20/25: oclosure.el: Add support for mutable slots, Stefan Monnier, 2021/12/31
- scratch/oclosure bc1d94a0d8 21/25: * lisp/emacs-lisp/oclosure.el (Commentary:): Add a few notes, Stefan Monnier, 2021/12/31
- scratch/oclosure 263172dbfb 02/25: lisp/emacs-lisp/oclosure.el: Make it available to cl-generic, Stefan Monnier, 2021/12/31
- scratch/oclosure 3119e59252 07/25: lisp/emacs-lisp/oclosure.el: Rename `oclosure-make` to `oclosure-lambda`, Stefan Monnier, 2021/12/31
- scratch/oclosure 9465a7e59e 10/25: nadvice.el: Restore interactive-form handling, Stefan Monnier, 2021/12/31
- scratch/oclosure 3c9d64b602 14/25: cl-macs.el (cl--transform-lambda): Fix last change, Stefan Monnier, 2021/12/31
- scratch/oclosure 01002ebba0 18/25: oclosure.el (oclosure-define): Use `oclosure--copy` to define accessors, Stefan Monnier, 2021/12/31
- scratch/oclosure 20e5cd82ae 13/25: Fix bug#28557,
Stefan Monnier <=
- scratch/oclosure 44dbab47f7 23/25: * lisp/emacs-lisp/oclosure.el: Remove obsolete comment, Stefan Monnier, 2021/12/31
- scratch/oclosure 1ace4acd54 22/25: Replace uniquify.el's advice with direct calls, Stefan Monnier, 2021/12/31
- scratch/oclosure 3aa60102b9 24/25: kmacro.el: Unify the lambda and the list representations, Stefan Monnier, 2021/12/31
- scratch/oclosure e9cfab679d 15/25: lisp/emacs-lisp/cl-macs.el: Align with `master`, Stefan Monnier, 2021/12/31
- scratch/oclosure e65e2bd0aa 12/25: * lisp/emacs-lisp/cl-generic.el (cl-generic--oclosure-generalizer): Fix precedence, Stefan Monnier, 2021/12/31
- scratch/oclosure de320e2003 25/25: Arrange to load `nadvice` later in `loadup.el`, Stefan Monnier, 2021/12/31