[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 2a532d3 077/187: Replace closure prevention with closure s
From: |
Michael Albinus |
Subject: |
[elpa] master 2a532d3 077/187: Replace closure prevention with closure sanitation |
Date: |
Wed, 30 Dec 2015 11:49:48 +0000 |
branch: master
commit 2a532d388db717a9eedfd2e80255e4b276cc2e1c
Author: Ryan C. Thompson <address@hidden>
Commit: Ryan C. Thompson <address@hidden>
Replace closure prevention with closure sanitation
"Sanitation" means that if a closure's list of lexical variables
contains any variables with unprintable values, those variables are
removed from the list. When async-debug is on, this also generates a
message about the removed variables.
This solution is arguably more hackish, but should also work in every
case where the "prevent all closures" solution worked as well as some
more cases.
---
async-test.el | 12 ++++++----
async.el | 61 +++++++++++++++++++++++++++++++++++++++++++-------------
2 files changed, 54 insertions(+), 19 deletions(-)
diff --git a/async-test.el b/async-test.el
index b77fdd1..c1dbb0a 100644
--- a/async-test.el
+++ b/async-test.el
@@ -287,9 +287,11 @@ Return the name of the directory."
;; case one of those variables (the one that collects the result)
;; gets set to a list of process objects, which are unprintable. If
;; `lexical-binding' is non-nil, this unprintable value is
- ;; incorporated into the closures created by `lambda' within the
- ;; loop. Closure prevention avoids the error from this unprintable
- ;; lexical value in these examples.
+ ;; incorporated into the closures created by `lambda' within the lexical
+ ;; scope of the loop, causing an error when another process tried to
+ ;; read in the printed value. `async--sanitize-closure' should
+ ;; prevent this by deleting the unprintable variable from the
+ ;; closure before printing it.
(eval
'(progn
(mapcar #'async-get
@@ -305,8 +307,8 @@ Return the name of the directory."
(cl-loop repeat 2 collect
(async-start `(lambda () ,(* 150 2))))))
t)
- ;; However closure prevention also (obviously) prevents creation of
- ;; lexical closures, leading to an error in this case.
+ ;; The following lexical closure should work fine, since x, y, and z
+ ;; all have printable values.
(should
(eq 6
(eval
diff --git a/async.el b/async.el
index c4485d6..1527baf 100644
--- a/async.el
+++ b/async.el
@@ -142,6 +142,47 @@ as follows:
(async--insert-sexp sexp)
(process-send-region process (point-min) (point-max))))
+(defsubst async--value-printable-p (value)
+ "Return non-nil if VALUE can be round-tripped to a string prepresentation."
+ (condition-case nil
+ (let* ((value-string (prin1-to-string value))
+ (value-from-string (car (read-from-string value-string))))
+ (equal value value-from-string))
+ (error nil)))
+
+(defun async--sanitize-closure (func)
+ "If FUNC is a closure, delete unprintable lexicals from it."
+ (when (eq (car-safe func) 'closure)
+ (setf (cadr func)
+ (or (loop for obj in (cadr func)
+ if (or (not (consp obj))
+ (async--value-printable-p (cdr obj)))
+ collect obj
+ else do
+ (when async-debug
+ (message "Sanitized var from closure: %s=%S"
+ (car obj) (cdr obj))))
+ ;; A closure with no lexicals generally has this value
+ ;; as its cadr, so we'll use that if everything gets
+ ;; filtered out.
+ '(t))))
+ func)
+
+(defsubst async--get-function (func)
+ "Get the function definition of FUNC, whatever it is.
+
+FUNC can be a variable name, "
+ (indirect-function
+ (cond
+ ;; Quoted form => Extract value without evaluating since `(eval
+ ;; (quote (closure ...)))' is an error.
+ ((memq (car-safe func) '(quote function))
+ (cadr func))
+ ;; Anything else => eval it
+ ;; (e.g. variable or function call)
+ (t
+ (eval func)))))
+
(defun async-batch-invoke ()
"Called from the child Emacs process' command-line."
(setq async-in-child-emacs t
@@ -261,21 +302,13 @@ returns nil. It can still be useful, however, as an
argument to
`async-ready' or `async-wait'."
(require 'find-func)
(let* ((procvar (make-symbol "proc"))
- ;; Evaluate START-FUNC if it isn't aready a function.
- (start-func
- (if (functionp start-func)
- start-func
- (eval start-func)))
+ ;; Evaluate START-FUNC and resolve it to an actual function
+ ;; definition.
(start-func
- (if (eq (car start-func) 'lambda)
- (eval start-func t)
- start-func)))
- ;; If START-FUNC is a lambda, prevent it from creating a lexical
- ;; closure by evaluating it in an empty lexical environment.
- (when (eq (car start-func) 'lambda)
- (setq start-func
- (eval start-func t)))
- `(let* ((sexp #',start-func)
+ (async--get-function start-func)))
+ (unless (functionp start-func)
+ (error "Start-func is not a function: %S" start-func))
+ `(let* ((sexp (async--sanitize-closure #',start-func))
(,procvar
(async-start-process
"emacs" (file-truename
- [elpa] master 93b05a9 073/187: More robust evaluation and closure-protection of start-func, (continued)
- [elpa] master 93b05a9 073/187: More robust evaluation and closure-protection of start-func, Michael Albinus, 2015/12/30
- [elpa] master ba705c6 076/187: Add test for handling different ways of passing a function, Michael Albinus, 2015/12/30
- [elpa] master b6d990d 075/187: Add lexbind test, Michael Albinus, 2015/12/30
- [elpa] master f6d7a74 074/187: Merge pull request #18 from DarwinAwardWinner/lexbind-fix, Michael Albinus, 2015/12/30
- [elpa] master 9b5bb5c 072/187: Add more comprehensive testing for anti-closure feature, Michael Albinus, 2015/12/30
- [elpa] master 204750d 081/187: Revert "* helm-async.el: Fix error handling.", Michael Albinus, 2015/12/30
- [elpa] master b05c63a 083/187: Don't rely on async.el being in load-path., Michael Albinus, 2015/12/30
- [elpa] master 374f514 079/187: Complete the docstring for "async--get-function", Michael Albinus, 2015/12/30
- [elpa] master 9704eb8 080/187: Merge pull request #21 from DarwinAwardWinner/lexbind-fix, Michael Albinus, 2015/12/30
- [elpa] master 4a7b07b 084/187: Merge pull request #23 from DarwinAwardWinner/no-load-path-fix, Michael Albinus, 2015/12/30
- [elpa] master 2a532d3 077/187: Replace closure prevention with closure sanitation,
Michael Albinus <=
- [elpa] master f18c735 078/187: Merge pull request #19 from DarwinAwardWinner/lexbind-fix, Michael Albinus, 2015/12/30
- [elpa] master 3f751fb 082/187: Revert master back to 242ae73, Michael Albinus, 2015/12/30
- [elpa] master eff5419 088/187: Rename helm-async.el to dired-async.el, Michael Albinus, 2015/12/30
- [elpa] master ec8decc 090/187: * dired-async.el (helm-async-be-async): alias for dired-async-be-async., Michael Albinus, 2015/12/30
- [elpa] master 5ff0f9b 087/187: * helm-async.el: Use cl-lib instead of cl., Michael Albinus, 2015/12/30
- [elpa] master aabc7b4 086/187: * helm-async.el: Rename all with dired-async prefix instead of helm-async., Michael Albinus, 2015/12/30
- [elpa] master a37e1db 089/187: * dired-async.el: Finish converting all names to dired*., Michael Albinus, 2015/12/30
- [elpa] master b311374 092/187: * dired-async.el (dired-async-mode): Notify number of jobs running in lighter., Michael Albinus, 2015/12/30
- [elpa] master b514e21 093/187: * async-test.el: Remove now unnecessary tests., Michael Albinus, 2015/12/30
- [elpa] master 4d14cbb 094/187: * async-test.el: Update copyrights., Michael Albinus, 2015/12/30