Skip to content

Add calls that return exit-code so that errors can be handled by caller #50

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Add calls that return exit-code so that errors can be handled by caller #50

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
26ba58c
Add process commands that also return exit-code
Sep 9, 2017
0f2af90
Remove a potentially platform dependent part of a test
Sep 9, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
113 changes: 88 additions & 25 deletions deferred.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -746,47 +746,87 @@ object. The process name and buffer name of the argument of the
`start-process' are generated by this function automatically.
The next deferred object receives stdout and stderr string from
the command process."
(deferred:process-gen 'start-process command args))
(deferred:process-gen 'start-process nil command args))

(defun deferred:process-ec (command &rest args)
"A deferred wrapper of `start-process'. Return a deferred
object. The process name and buffer name of the argument of the
`start-process' are generated by this function automatically.
The next deferred object receives the list (exit-code output),
where the output is the stdout and stderr as one string from the
command process."
(deferred:process-gen 'start-process 'w-exit-code command args))

(defun deferred:process-shell (command &rest args)
"A deferred wrapper of `start-process-shell-command'. Return a deferred
object. The process name and buffer name of the argument of the
`start-process-shell-command' are generated by this function automatically.
The next deferred object receives stdout and stderr string from
the command process."
(deferred:process-gen 'start-process-shell-command command args))
(deferred:process-gen 'start-process-shell-command nil command args))

(defun deferred:process-shell-ec (command &rest args)
"A deferred wrapper of `start-process-shell-command'. Return a
deferred object. The process name and buffer name of the argument
of the `start-process-shell-command' are generated by this
function automatically. The next deferred object receives the
list (exit-code output), where the output is the stdout and
stderr as one string from the command process."
(deferred:process-gen 'start-process-shell-command 'w-exit-code command args))

(defun deferred:process-buffer (command &rest args)
"A deferred wrapper of `start-process'. Return a deferred
object. The process name and buffer name of the argument of the
`start-process' are generated by this function automatically.
The next deferred object receives stdout and stderr buffer from
the command process."
(deferred:process-buffer-gen 'start-process command args))
(deferred:process-buffer-gen 'start-process nil command args))

(defun deferred:process-ec-buffer (command &rest args)
"A deferred wrapper of `start-process'. Return a deferred
object. The process name and buffer name of the argument of the
`start-process' are generated by this function automatically.
The next deferred object receives the list (exit-code output),
where the output is the stdout and stderr in one buffer from the
command process."
(deferred:process-buffer-gen 'start-process 'w-exit-code command args))

(defun deferred:process-shell-buffer (command &rest args)
"A deferred wrapper of `start-process-shell-command'. Return a deferred
object. The process name and buffer name of the argument of the
`start-process-shell-command' are generated by this function automatically.
The next deferred object receives stdout and stderr buffer from
the command process."
(deferred:process-buffer-gen 'start-process-shell-command command args))

(defun deferred:process-gen (f command args)
(deferred:process-buffer-gen 'start-process-shell-command nil command args))

(defun deferred:process-shell-ec-buffer (command &rest args)
"A deferred wrapper of `start-process-shell-command'. Return a
deferred object. The process name and buffer name of the argument
of the `start-process-shell-command' are generated by this
function automatically. The next deferred object receives the
list (exit-code output), where the output is the stdout and
stderr in one buffer from the command process."
(deferred:process-buffer-gen 'start-process-shell-command 'w-exit-code command args))

(defun deferred:process-gen (f w-exit-code command args)
"[internal]"
(let ((pd (deferred:process-buffer-gen f command args)) d)
(let ((pd (deferred:process-buffer-gen f w-exit-code command args)) d)
(setq d (deferred:nextc pd
(lambda (buf)
(prog1
(with-current-buffer buf (buffer-string))
(kill-buffer buf)))))
(lambda (output)
(let* ((buf (if w-exit-code (nth 1 output) output))
(buf-str (with-current-buffer buf (buffer-string))))
(prog1
(if w-exit-code
(list (nth 0 output) buf-str)
buf-str)
(kill-buffer buf))))))
(setf (deferred-cancel d)
(lambda (_x)
(deferred:default-cancel d)
(deferred:default-cancel pd)))
d))

(defun deferred:process-buffer-gen (f command args)
(defun deferred:process-buffer-gen (f w-exit-code command args)
"[internal]"
(let ((d (deferred:next)) (uid (deferred:uid)))
(let ((proc-name (format "*deferred:*%s*:%s" command uid))
Expand All @@ -810,19 +850,22 @@ the command process."
proc
(lambda (proc event)
(unless (process-live-p proc)
(if (zerop (process-exit-status proc))
(deferred:post-task nd 'ok proc-buf)
(let ((msg (format "Deferred process exited abnormally:\n command: %s\n exit status: %s %s\n event: %s\n buffer contents: %S"
command
(process-status proc)
(process-exit-status proc)
(string-trim-right event)
(if (buffer-live-p proc-buf)
(with-current-buffer proc-buf
(buffer-string))
"(unavailable)"))))
(kill-buffer proc-buf)
(deferred:post-task nd 'ng msg))))))
(let ((exit-code (process-exit-status proc)))
(if w-exit-code
(deferred:post-task nd 'ok (list exit-code proc-buf))
(if (zerop exit-code)
(deferred:post-task nd 'ok proc-buf)
(let ((msg (format "Deferred process exited abnormally:\n command: %s\n exit status: %s %s\n event: %s\n buffer contents: %S"
command
(process-status proc)
exit-code
(string-trim-right event)
(if (buffer-live-p proc-buf)
(with-current-buffer proc-buf
(buffer-string))
"(unavailable)"))))
(kill-buffer proc-buf)
(deferred:post-task nd 'ng msg))))))))
(setf (deferred-cancel nd)
(lambda (x) (deferred:default-cancel x)
(when proc
Expand Down Expand Up @@ -852,6 +895,26 @@ the command process."
`(deferred:nextc ,d
(lambda (,(cl-gensym)) (deferred:process-shell-buffer ,command ,@args))))

(defmacro deferred:process-ecc (d command &rest args)
"Process chain of `deferred:process'."
`(deferred:nextc ,d
(lambda (,(cl-gensym)) (deferred:process-ec ,command ,@args))))

(defmacro deferred:process-ec-bufferc (d command &rest args)
"Process chain of `deferred:process-buffer'."
`(deferred:nextc ,d
(lambda (,(cl-gensym)) (deferred:process-ec-buffer ,command ,@args))))

(defmacro deferred:process-shell-ecc (d command &rest args)
"Process chain of `deferred:process'."
`(deferred:nextc ,d
(lambda (,(cl-gensym)) (deferred:process-shell-ec ,command ,@args))))

(defmacro deferred:process-shell-ec-bufferc (d command &rest args)
"Process chain of `deferred:process-buffer'."
`(deferred:nextc ,d
(lambda (,(cl-gensym)) (deferred:process-shell-ec-buffer ,command ,@args))))

;; Special variables defined in url-vars.el.
(defvar url-request-data)
(defvar url-request-method)
Expand Down
154 changes: 153 additions & 1 deletion test/deferred-test.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -914,13 +914,38 @@
(nextc it (deferred:not-called-func))
(errorc it (string-match "^Searching for program" (cadr e)))))

(should=
(length (buffer-list))
(deferred:cancel (deferred:process-ec "pwd" nil))
(length (buffer-list)))

(should= 0
(dtest
(deferred:process-ec "pwd---")
(nextc it (deferred:not-called-func))
(errorc it (string-match "^Searching for program" (cadr e)))))

(should=
(with-temp-buffer
(call-process "pwd" nil t nil)
(list 0 (buffer-string)))
(wtest 0.1 ;; maybe fail in some environments...
(deferred:process-ec "pwd" nil)))

(should=
(with-temp-buffer (call-process "pwd" nil t nil)
(buffer-string))
(wtest 0.1
(wait 0.1)
(deferred:processc it "pwd" nil)))

(should=
(with-temp-buffer (call-process "pwd" nil t nil)
(list 0 (buffer-string)))
(wtest 0.1
(wait 0.1)
(deferred:process-ecc it "pwd" nil)))

(should=
(with-temp-buffer
(call-process "ls" nil t "-1")
Expand All @@ -932,6 +957,32 @@
(error "Not live buffer : %s" x))
(with-current-buffer x (buffer-string)))))

(should=
(with-temp-buffer
(call-process "ls" nil t "-1")
(list 0 (buffer-string)))
(wtest 0.1 ;; maybe fail in some environments...
(deferred:process-ec-buffer "ls" "-1")
(nextc it
(let ((buf (nth 1 x)))
(unless (buffer-live-p buf)
(error "Not live buffer : %s" buf))
(list (nth 0 x)
(with-current-buffer buf (buffer-string)))))))

(should=
(with-temp-buffer
(call-process "ls" nil t t "--nonsensical")
;; Matching error output is trickier here, just check exit code.
2)
(wtest 0.1 ;; maybe fail in some environments...
(deferred:process-ec-buffer "ls" "--nonsensical")
(nextc it
(let ((buf (nth 1 x)))
(unless (buffer-live-p buf)
(error "Not live buffer : %s" buf))
(nth 0 x)))))

(should=
(with-temp-buffer
(call-process "ls" nil t "-1")
Expand All @@ -944,6 +995,20 @@
(error "Not live buffer : %s" x))
(with-current-buffer x (buffer-string)))))

(should=
(with-temp-buffer
(call-process "ls" nil t "-1")
(list 0 (buffer-string)))
(wtest 0.1 ;; maybe fail in some environments...
(wait 0.1)
(deferred:process-ec-bufferc it "ls" "-1")
(nextc it
(let ((buf (nth 1 x)))
(unless (buffer-live-p buf)
(error "Not live buffer : %s" buf))
(list (nth 0 x)
(with-current-buffer buf (buffer-string)))))))

(should=
(length (buffer-list))
(deferred:cancel (deferred:process-buffer "ls" nil))
Expand All @@ -955,6 +1020,17 @@
(nextc it (deferred:not-called-func))
(errorc it (string-match "^Searching for program" (cadr e)))))

(should=
(length (buffer-list))
(deferred:cancel (deferred:process-ec-buffer "ls" nil))
(length (buffer-list)))

(should= 0
(dtest
(deferred:process-ec-buffer "pwd---")
(nextc it (deferred:not-called-func))
(errorc it (string-match "^Searching for program" (cadr e)))))

;;shell

(should=
Expand Down Expand Up @@ -982,13 +1058,38 @@
(nextc it (deferred:not-called-func))
(errorc it "ERROR")))

(should=
(length (buffer-list))
(deferred:cancel (deferred:process-shell-ec "pwd" nil))
(length (buffer-list)))

(should= "ERROR"
(wtest 0.1
(deferred:process-shell-ec "lsasfdsadf")
(nextc it (deferred:not-called-func))
(errorc it "ERROR")))

(should=
(with-temp-buffer
(call-process "pwd" nil t nil)
(list 0 (buffer-string)))
(wtest 0.1 ;; maybe fail in some environments...
(deferred:process-shell-ec "pwd" nil)))

(should=
(with-temp-buffer (call-process-shell-command "pwd" nil t nil)
(buffer-string))
(wtest 0.1
(wait 0.1)
(deferred:process-shellc it "pwd" nil)))

(should=
(with-temp-buffer (call-process "pwd" nil t nil)
(list 0 (buffer-string)))
(wtest 0.1
(wait 0.1)
(deferred:process-shell-ecc it "pwd" nil)))

(should=
(with-temp-buffer
(call-process-shell-command "ls" nil t "-1")
Expand All @@ -1000,6 +1101,32 @@
(error "Not live buffer : %s" x))
(with-current-buffer x (buffer-string)))))

(should=
(with-temp-buffer
(call-process "ls" nil t "-1")
(list 0 (buffer-string)))
(wtest 0.1 ;; maybe fail in some environments...
(deferred:process-shell-ec-buffer "ls" "-1")
(nextc it
(let ((buf (nth 1 x)))
(unless (buffer-live-p buf)
(error "Not live buffer : %s" buf))
(list (nth 0 x)
(with-current-buffer buf (buffer-string)))))))

(should=
(with-temp-buffer
(call-process "ls" nil t t "--nonsensical")
;; Matching error output is trickier here, just check exit code.
2)
(wtest 0.1 ;; maybe fail in some environments...
(deferred:process-shell-ec-buffer "ls" "--nonsensical")
(nextc it
(let ((buf (nth 1 x)))
(unless (buffer-live-p buf)
(error "Not live buffer : %s" buf))
(nth 0 x)))))

(should=
(with-temp-buffer
(call-process-shell-command "ls" nil t "-1")
Expand All @@ -1012,6 +1139,20 @@
(error "Not live buffer : %s" x))
(with-current-buffer x (buffer-string)))))

(should=
(with-temp-buffer
(call-process "ls" nil t "-1")
(list 0 (buffer-string)))
(wtest 0.1 ;; maybe fail in some environments...
(wait 0.1)
(deferred:process-shell-ec-bufferc it "ls" "-1")
(nextc it
(let ((buf (nth 1 x)))
(unless (buffer-live-p buf)
(error "Not live buffer : %s" buf))
(list (nth 0 x)
(with-current-buffer buf (buffer-string)))))))

(should=
(length (buffer-list))
(deferred:cancel (deferred:process-shell-buffer "ls" nil))
Expand All @@ -1021,4 +1162,15 @@
(wtest 0.1
(deferred:process-shell-buffer "lssaf")
(nextc it (deferred:not-called-func))
(errorc it "ERROR"))))
(errorc it "ERROR")))

(should=
(length (buffer-list))
(deferred:cancel (deferred:process-shell-ec-buffer "ls" nil))
(length (buffer-list)))

(should= "ERROR"
(wtest 0.1
(deferred:process-shell-ec-buffer "lssaf")
(nextc it (deferred:not-called-func))
(errorc it "ERROR"))))