branch: externals-release/plz
commit 9b681d48933f288a6ae4ec92ca4bc03792a3fe9f
Merge: 1b66fa907d 57f1048265
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Merge: v0.8
---
.github/workflows/test.yml | 7 +-
README.org | 9 ++
plz.el | 32 ++++---
tests/test-plz.el | 216 ++++++++++++++++++++++-----------------------
4 files changed, 140 insertions(+), 124 deletions(-)
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index 3c38eac865..0f991e4057 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -41,7 +41,12 @@ jobs:
fail-fast: false
matrix:
emacs_version:
- - 26.3
+ # FIXME: The 26.3 test fails to initialize with the error
+ # "Package ‘emacs-27.1’ is unavailable", which happens just
+ # after "Package refresh done". Not sure what the cause is.
+ # But I don't want the whole suite marked as failing because
+ # of 26.3 right now, so commenting it out.
+ # - 26.3
- 27.1
- 27.2
- 28.1
diff --git a/README.org b/README.org
index 0b6285cb5a..d3d27d948c 100644
--- a/README.org
+++ b/README.org
@@ -142,6 +142,9 @@ Synchronously download a JPEG file, then create an Emacs
image object from the d
~NOQUERY~ is passed to ~make-process~, which see.
+ ~FILTER~ is an optional function to be used as the process filter for the
curl process. It can be used to handle HTTP responses in a streaming way. The
function must accept 2 arguments, the process object running curl, and a string
which is output received from the process. The default process filter inserts
the output of the process into the process buffer. The provided ~FILTER~
function should at least insert output up to the HTTP body into the process
buffer.
+
+
** Queueing
~plz~ provides a simple system for queueing HTTP requests. First, make a
~plz-queue~ struct by calling ~make-plz-queue~. Then call ~plz-queue~ with the
struct as the first argument, and the rest of the arguments being the same as
those passed to ~plz~. Then call ~plz-run~ to run the queued requests.
@@ -185,6 +188,12 @@ You may also clear a queue with ~plz-clear~, which cancels
any active or queued
:TOC: :depth 0
:END:
+** 0.8
+
+*Additions*
+
++ Function ~plz~ now accepts a ~:filter~ argument which can be used to
override the default process filter (e.g. for streaming responses).
([[https://github.com/alphapapa/plz.el/pull/43][#43]],
[[https://github.com/alphapapa/plz.el/pull/50][#50]]. Thanks to
[[https://github.com/r0man][Roman Scherer]].)
+
** 0.7.3
*Fixes*
diff --git a/plz.el b/plz.el
index 75281bb88a..57e247f815 100644
--- a/plz.el
+++ b/plz.el
@@ -5,7 +5,7 @@
;; Author: Adam Porter <a...@alphapapa.net>
;; Maintainer: Adam Porter <a...@alphapapa.net>
;; URL: https://github.com/alphapapa/plz.el
-;; Version: 0.7.3
+;; Version: 0.8
;; Package-Requires: ((emacs "26.3"))
;; Keywords: comm, network, http
@@ -254,7 +254,7 @@ connection phase and waiting to receive the response (the
;;;;; Public
-(cl-defun plz (method url &rest rest &key headers body else finally noquery
+(cl-defun plz (method url &rest rest &key headers body else filter finally
noquery
(as 'string) (then 'sync)
(body-type 'text) (decode t decode-s)
(connect-timeout plz-connect-timeout) (timeout
plz-timeout))
@@ -330,6 +330,15 @@ from a host, respectively.
NOQUERY is passed to `make-process', which see.
+FILTER is an optional function to be used as the process filter
+for the curl process. It can be used to handle HTTP responses in
+a streaming way. The function must accept 2 arguments, the
+process object running curl, and a string which is output
+received from the process. The default process filter inserts
+the output of the process into the process buffer. The provided
+FILTER function should at least insert output up to the HTTP body
+into the process buffer.
+
\(To silence checkdoc, we mention the internal argument REST.)"
;; FIXME(v0.8): Remove the note about error changes from the docstring.
;; FIXME(v0.8): Update error signals in docstring.
@@ -390,10 +399,10 @@ NOQUERY is passed to `make-process', which see.
('binary nil)
(_ decode)))
(default-directory
- ;; Avoid making process in a nonexistent directory (in case the
current
- ;; default-directory has since been removed). It's unclear what
the best
- ;; directory is, but this seems to make sense, and it should still
exist.
- temporary-file-directory)
+ ;; Avoid making process in a nonexistent directory (in case the
current
+ ;; default-directory has since been removed). It's unclear what the
best
+ ;; directory is, but this seems to make sense, and it should still
exist.
+ temporary-file-directory)
(process-buffer (generate-new-buffer " *plz-request-curl*"))
(stderr-process (make-pipe-process :name "plz-request-curl-stderr"
:buffer (generate-new-buffer "
*plz-request-curl-stderr*")
@@ -404,6 +413,7 @@ NOQUERY is passed to `make-process', which see.
:coding 'binary
:command (append (list plz-curl-program)
curl-command-line-args)
:connection-type 'pipe
+ :filter filter
:sentinel #'plz--sentinel
:stderr stderr-process
:noquery noquery))
@@ -635,11 +645,11 @@ making QUEUE's requests."
Return when QUEUE is at limit or has no more queued requests.
QUEUE should be a `plz-queue' structure."
- (cl-labels ((readyp
- (queue) (and (not (plz-queue-canceled-p queue))
- (plz-queue-requests queue)
- ;; With apologies to skeeto...
- (< (length (plz-queue-active queue))
(plz-queue-limit queue)))))
+ (cl-labels ((readyp (queue)
+ (and (not (plz-queue-canceled-p queue))
+ (plz-queue-requests queue)
+ ;; With apologies to skeeto...
+ (< (length (plz-queue-active queue)) (plz-queue-limit
queue)))))
(while (readyp queue)
(pcase-let* ((request (plz--queue-pop queue))
((cl-struct plz-queued-request method url
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 3f5f0a85f1..8725b9e4dc 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -1,6 +1,6 @@
;;; test-plz.el --- Tests for plz -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2023 Free Software Foundation, Inc.
;; Author: Adam Porter <a...@alphapapa.net>
;; Maintainer: Adam Porter <a...@alphapapa.net>
@@ -24,67 +24,14 @@
;;; Commentary:
-;; NOTE: NOTE: NOTE: NOTE: Yes, four NOTEs, because this is important:
-;; As of this moment, all of the tests pass when run with makem.sh.
-;; And when running them in an interactive Emacs with ERT, one test at
-;; a time, individual tests pass, or almost always do (depending on
-;; whether the httpbin.org server is overloaded). But when running
-;; multiple tests in ERT at one time,
-;; i.e. (ert-run-tests-interactively "plz-"), multiple, if not most,
-;; tests fail, but not the same ones every time.
-
-;; I have now spent hours trying to figure out why, inserting many
-;; debug statements in many functions, and come up with nothing. I
-;; tried changing the way `accept-process-output' is called, like
-;; using timeouts or JUST-THIS-ONE, but it made no difference. I
-;; tried calling it extra times, nope. I tried calling the sentinel
-;; extra times when it seemed that it hadn't run the THEN function,
-;; nope. Nothing seems to make a difference.
-
-;; I even checked out an earlier commit, before the commit that
-;; rewrote/merged the synchronous request code into the `plz'
-;; function, thinking that surely I broke something--but, nope, they
-;; apparently failed the same way back then: passing with makem.sh,
-;; passing individually, but failing when run in close succession by
-;; ERT.
-
-;; After inserting enough debug statements, I noticed that the process
-;; sentinel sometimes seemed to run for the last time after the ERT
-;; test had returned, which suggests that ERT might be doing something
-;; weird, or somehow its instrumentation interferes with the
-;; process-handling code. But if that's not the cause, then I'm out
-;; of ideas.
-
-;; So then I tried rewriting the synchronous request code to use
-;; `call-process-region', instead of calling `accept-process-output'
-;; in a loop to block on the curl process (which is how the Elisp
-;; manual says to do it), but that still made no difference: even the
-;; async requests fail in the same way with ERT. So that doesn't
-;; appear to be the problem, either.
-
-;; So is there some kind of fundamental flaw in the `plz' design?
-;; Maybe. Is there a simple, logical oversight in its code that only
-;; manifests under certain conditions? Maybe. Is ERT doing something
-;; weird that's interfering with process-related code? Maybe. Is
-;; Emacs's own process-handling code still broken in some mysterious
-;; way? Maybe.
-
-;; But despite all of that, when using `plz' "in anger", in `ement',
-;; it seems to work reliably for me. I did get one report from one
-;; user that sounded like the same kind of problem I'm seeing with ERT
-;; here, but then he tried `ement-connect' again, and it worked. And
-;; I'm sitting here watching `ement' constantly using `plz' to talk to
-;; the matrix.org server, and I haven't had a single error or failure,
-;; even after hours of being connected. It *seems* to *actually*
-;; work.
-
-;; So, if you're reading this, and you're wondering whether you should
-;; use `plz': Well, please do, and please let me know if you have any
-;; problems; I do need to know whether it's working for other users.
-;; And if you think you might know what's going wrong when running the
-;; tests in ERT, please let me know, because I'm out of ideas: as far
-;; as I can tell, when it comes to process-handling in Emacs, "there
-;; be dragons."
+;; This file implements tests for `plz'. By default, the requests are
+;; made to "localhost", expecting an instance of httpbin
+;; <https://github.com/postmanlabs/httpbin> running on port 80; it's
+;; convenient to use the Docker image "kennethreitz/httpbin". By
+;; changing the variable `plz-test-uri-prefix', the tests can be run
+;; against other URLs, such as <https://httpbin.org> (but that server
+;; is often overloaded, making for unreliable tests, so a local
+;; instance is preferred).
;;; Code:
@@ -127,7 +74,11 @@ If running httpbin locally, set to \"http://localhost\".";)
do (sleep-for seconds))))
(cl-defmacro plz-deftest (name () &body docstring-keys-and-body)
- "Like `ert-deftest', but defines tests for both HTTP/1.1 and HTTP/2."
+ "Like `ert-deftest', but defines tests for both HTTP/1.1 and HTTP/2.
+Also defines local function `url' which returns its argument
+appended to `plz-test-uri-prefix' (and any instance of
+\"URI-PREFIX\" in URL-PART is replaced with `plz-test-uri-prefix'
+in URL-encoded form)."
(declare (debug (&define [&name "test@" symbolp]
sexp [&optional stringp]
[&rest keywordp sexp] def-body))
@@ -139,18 +90,15 @@ If running httpbin locally, set to \"http://localhost\".";)
`(ert-deftest ,name ()
(let ((plz-curl-default-args
',(append plz-curl-default-args (list
(format "--http%s" http-version)))))
- ,@docstring-keys-and-body))))))
+ (cl-labels ((url (part)
+ (setf part
(replace-regexp-in-string
+ "URI-PREFIX"
(url-hexify-string plz-test-uri-prefix)
+ part t t))
+ (concat plz-test-uri-prefix
part)))
+ ,@docstring-keys-and-body)))))))
;;;; Functions
-(defun plz-test-url (url-part)
- "Return URL-PART appended to `plz-test-uri-prefix'.
-Also, any instance of \"URI-PREFIX\" in URL-PART is replaced with
-`plz-test-uri-prefix' in URL-encoded form."
- (setf url-part (replace-regexp-in-string "URI-PREFIX" (url-hexify-string
plz-test-uri-prefix)
- url-part t t))
- (concat plz-test-uri-prefix url-part))
-
(defmacro plz-test-get-response (response)
"Test parts of RESPONSE with `should'."
`(progn
@@ -168,7 +116,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-string nil
(let* ((test-string)
- (process (plz 'get (plz-test-url "/get")
+ (process (plz 'get (url "/get")
:as 'string
:then (lambda (string)
(setf test-string string)))))
@@ -177,7 +125,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-buffer nil
(let* ((result-buffer)
- (process (plz 'get (plz-test-url "/get")
+ (process (plz 'get (url "/get")
:as 'buffer :then (lambda (buffer)
(setf result-buffer buffer)))))
(unwind-protect
@@ -192,7 +140,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-response nil
(let* ((test-response)
- (process (plz 'get (plz-test-url "/get")
+ (process (plz 'get (url "/get")
:as 'response
:then (lambda (response)
(setf test-response response)))))
@@ -201,7 +149,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-json nil
(let* ((test-json)
- (process (plz 'get (plz-test-url "/get")
+ (process (plz 'get (url "/get")
:as #'json-read
:then (lambda (json)
(setf test-json json)))))
@@ -212,7 +160,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-post-json-string nil
(let* ((json-string (json-encode (list (cons "key" "value"))))
(response-json)
- (process (plz 'post (plz-test-url "/post")
+ (process (plz 'post (url "/post")
:headers '(("Content-Type" . "application/json"))
:body json-string
:as #'json-read
@@ -224,13 +172,13 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(should (string= "value" (alist-get 'key (json-read-from-string
.data)))))))
(plz-deftest plz-post-jpeg-string nil
- (let* ((jpeg-to-upload (plz 'get (plz-test-url "/image/jpeg")
+ (let* ((jpeg-to-upload (plz 'get (url "/image/jpeg")
:as 'binary :then 'sync))
(_ (unless jpeg-to-upload
(error "jpeg-to-upload is nil")))
(response-json)
(response-jpeg)
- (process (plz 'post (plz-test-url "/post")
+ (process (plz 'post (url "/post")
:headers '(("Content-Type" . "image/jpeg"))
:body jpeg-to-upload :body-type 'binary
:as #'json-read
@@ -252,7 +200,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-put-json-string nil
(let* ((json-string (json-encode (list (cons "key" "value"))))
(response-json)
- (process (plz 'put (plz-test-url "/put")
+ (process (plz 'put (url "/put")
:headers '(("Content-Type" . "application/json"))
:body json-string
:as #'json-read
@@ -268,21 +216,21 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
;;;;; Sync
(plz-deftest plz-get-string-sync nil
- (let-alist (json-read-from-string (plz 'get (plz-test-url "/get")
+ (let-alist (json-read-from-string (plz 'get (url "/get")
:as 'string :then 'sync))
- (should (equal (plz-test-url "/get") .url))))
+ (should (equal (url "/get") .url))))
(plz-deftest plz-get-response-sync nil
- (plz-test-get-response (plz 'get (plz-test-url "/get")
+ (plz-test-get-response (plz 'get (url "/get")
:as 'response :then 'sync)))
(plz-deftest plz-get-json-sync nil
- (let-alist (plz 'get (plz-test-url "/get")
+ (let-alist (plz 'get (url "/get")
:as #'json-read :then 'sync)
(should (string-match "curl" .headers.User-Agent))))
(plz-deftest plz-get-buffer-sync nil
- (let ((buffer (plz 'get (plz-test-url "/get")
+ (let ((buffer (plz 'get (url "/get")
:as 'buffer :then 'sync)))
(unwind-protect
(should (buffer-live-p buffer))
@@ -295,7 +243,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-with-headers ()
(let* ((response-json)
- (process (plz 'get (plz-test-url "/get")
+ (process (plz 'get (url "/get")
:headers '(("X-Plz-Test-Header" . "plz-test-header-value"))
:as #'json-read
:then (lambda (json)
@@ -307,7 +255,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-post-with-headers ()
(let* ((alist (list (cons "key" "value")))
(response-json)
- (process (plz 'post (plz-test-url "/post")
+ (process (plz 'post (url "/post")
:headers '(("Content-Type" . "application/json")
("X-Plz-Test-Header" . "plz-test-header-value"))
:body (json-encode alist)
@@ -320,7 +268,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(should (equal "value" (alist-get 'key (json-read-from-string
.data)))))))
(plz-deftest plz-get-json-with-headers-sync ()
- (let-alist (plz 'get (plz-test-url "/get")
+ (let-alist (plz 'get (url "/get")
:headers '(("X-Plz-Test-Header" . "plz-test-header-value"))
:as #'json-read :then 'sync)
(should (string-match "curl" .headers.User-Agent))
@@ -337,10 +285,10 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
;; lightweight way to test a server's presence, so we should
;; probably support it. This merely tests that no error is
;; signaled, which should mean that the HEAD request succeeded.
- (should (plz 'head (plz-test-url "/get"))))
+ (should (plz 'head (url "/get"))))
(plz-deftest plz-head-as-response ()
- (let ((response (plz 'head (plz-test-url "/get")
+ (let ((response (plz 'head (url "/get")
:as 'response)))
(should (equal "application/json"
(alist-get 'content-type
@@ -352,44 +300,44 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(should (equal ""
(alist-get 'data
(json-read-from-string
- (plz 'post (plz-test-url "/post"))))))
+ (plz 'post (url "/post"))))))
(should (equal "application/json"
(alist-get 'content-type
(plz-response-headers
- (plz 'post (plz-test-url "/post") :as
'response))))))
+ (plz 'post (url "/post") :as 'response))))))
;;;;; Status codes
(plz-deftest plz-201-succeeds ()
;; This merely tests that a 201 response does not signal an error.
- (should (plz 'get (plz-test-url "/status/201"))))
+ (should (plz 'get (url "/status/201"))))
(plz-deftest plz-400-errors ()
- (should-error (plz 'get (plz-test-url "/status/400"))))
+ (should-error (plz 'get (url "/status/400"))))
(plz-deftest plz-500-errors ()
- (should-error (plz 'get (plz-test-url "/status/500"))))
+ (should-error (plz 'get (url "/status/500"))))
;;;;; Redirects
(plz-deftest plz-301-redirects ()
(plz-test-get-response
- (plz 'get (plz-test-url "/redirect-to?url=URI-PREFIX%2Fget&status_code=301")
+ (plz 'get (url "/redirect-to?url=URI-PREFIX%2Fget&status_code=301")
:as 'response :then 'sync)))
(plz-deftest plz-302-redirects ()
(plz-test-get-response
- (plz 'get (plz-test-url "/redirect-to?url=URI-PREFIX%2Fget&status_code=302")
+ (plz 'get (url "/redirect-to?url=URI-PREFIX%2Fget&status_code=302")
:as 'response :then 'sync)))
(plz-deftest plz-307-redirects ()
(plz-test-get-response
- (plz 'get (plz-test-url "/redirect-to?url=URI-PREFIX%2Fget&status_code=307")
+ (plz 'get (url "/redirect-to?url=URI-PREFIX%2Fget&status_code=307")
:as 'response :then 'sync)))
(plz-deftest plz-308-redirects ()
(plz-test-get-response
- (plz 'get (plz-test-url "/redirect-to?url=URI-PREFIX%2Fget&status_code=308")
+ (plz 'get (url "/redirect-to?url=URI-PREFIX%2Fget&status_code=308")
:as 'response :then 'sync)))
;;;;; Errors
@@ -438,7 +386,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-404-error-sync nil
(pcase-let ((`(,_signal . (,_message ,data))
- (should-error (plz 'get (plz-test-url "/get/status/404")
+ (should-error (plz 'get (url "/get/status/404")
:as 'string :then 'sync)
:type 'plz-error)))
(should (plz-error-p data))
@@ -447,7 +395,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-404-error-async nil
(let* ((err)
- (process (plz 'get (plz-test-url "/get/status/404")
+ (process (plz 'get (url "/get/status/404")
:as 'string :then #'ignore
:else (lambda (e)
(setf err e)))))
@@ -459,7 +407,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-timeout-error-sync nil
(pcase-let* ((start-time (current-time))
(`(,_signal . (,_message ,(cl-struct plz-error (curl-error
`(,code . ,message)))))
- (should-error (plz 'get (plz-test-url "/delay/5")
+ (should-error (plz 'get (url "/delay/5")
:as 'string :then 'sync :timeout 1)
:type 'plz-error))
(end-time (current-time)))
@@ -471,7 +419,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(let* ((start-time (current-time))
(end-time)
(plz-error)
- (process (plz 'get (plz-test-url "/delay/5")
+ (process (plz 'get (url "/delay/5")
:as 'response :timeout 1 :then #'ignore
:else (lambda (e)
(setf end-time (current-time)
@@ -485,7 +433,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-finally nil
(let* ((finally-null t)
- (process (plz 'get (plz-test-url "/get")
+ (process (plz 'get (url "/get")
:as 'string
:then #'ignore
:finally (lambda ()
@@ -497,7 +445,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(plz-deftest plz-get-jpeg ()
(let* ((test-jpeg)
- (process (plz 'get (plz-test-url "/image/jpeg")
+ (process (plz 'get (url "/image/jpeg")
:as 'binary
:then (lambda (string)
(setf test-jpeg string)))))
@@ -505,14 +453,14 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(should (equal 'jpeg (image-type-from-data test-jpeg)))))
(plz-deftest plz-get-jpeg-sync ()
- (let ((jpeg (plz 'get (plz-test-url "/image/jpeg")
+ (let ((jpeg (plz 'get (url "/image/jpeg")
:as 'binary :then 'sync)))
(should (equal 'jpeg (image-type-from-data jpeg)))))
;;;;; Downloading to files
(plz-deftest plz-get-temp-file ()
- (let ((filename (plz 'get (plz-test-url "/image/jpeg")
+ (let ((filename (plz 'get (url "/image/jpeg")
:as 'file :then 'sync)))
(unwind-protect
(let ((jpeg-data (with-temp-buffer
@@ -529,7 +477,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(delete-file filename)
(unwind-protect
(progn
- (plz 'get (plz-test-url "/image/jpeg")
+ (plz 'get (url "/image/jpeg")
:as `(file ,filename) :then 'sync)
(let ((jpeg-data (with-temp-buffer
(insert-file-contents filename)
@@ -547,7 +495,7 @@ Also, any instance of \"URI-PREFIX\" in URL-PART is
replaced with
(with-temp-file filename
(insert "deadbeef"))
(setf process
- (plz 'put (plz-test-url "/put")
+ (plz 'put (url "/put")
:body `(file ,filename)
:as #'json-read
:then (lambda (json)
@@ -571,7 +519,7 @@ and only called once."
:finally (lambda ()
(setf finally-called-at
(current-time))
(cl-incf finally-called-times))))
- (urls (list (plz-test-url "/delay/2")))
+ (urls (list (url "/delay/2")))
completed-urls queue-started-at)
(dolist (url urls)
(plz-queue queue
@@ -593,8 +541,8 @@ and only called once."
(plz-deftest plz-queue-without-finally ()
"Ensure that a queue without a FINALLY function doesn't signal an error."
(let* ((queue (make-plz-queue :limit 2))
- (urls (list (plz-test-url "/get?foo=0")
- (plz-test-url "/get?foo=1")))
+ (urls (list (url "/get?foo=0")
+ (url "/get?foo=1")))
completed-urls)
(dolist (url urls)
(plz-queue queue
@@ -611,6 +559,50 @@ and only called once."
;; TODO: Add test for canceling queue.
+;; Process filter
+
+(defun test-plz-process-filter (process output)
+ "Write OUTPUT to the PROCESS buffer."
+ (when (buffer-live-p (process-buffer process))
+ (with-current-buffer (process-buffer process)
+ (let ((movingp (= (point) (process-mark process))))
+ (save-excursion
+ (goto-char (process-mark process))
+ (insert output)
+ (set-marker (process-mark process) (point)))
+ (when movingp
+ (goto-char (process-mark process)))))))
+
+(plz-deftest plz-get-json-process-filter-async ()
+ (let* ((test-json) (outputs)
+ (process (plz 'get (url "/get")
+ :as #'json-read
+ :then (lambda (json)
+ (setf test-json json))
+ :filter (lambda (process output)
+ (test-plz-process-filter process output)
+ (push output outputs)))))
+ (plz-test-wait process)
+ (let-alist test-json
+ (should (string-match-p "curl" .headers.User-Agent)))
+ (let ((output (string-join (reverse outputs))))
+ (should (string-match-p "HTTP.*\s+200" output))
+ (should (string-match-p "Server: gunicorn" output))
+ (should (string-match-p "\"args\":\s*{}" output)))))
+
+(plz-deftest plz-get-json-process-filter-sync ()
+ (let* ((outputs)
+ (response (plz 'get (url "/get")
+ :as 'response
+ :filter (lambda (process output)
+ (test-plz-process-filter process output)
+ (push output outputs)))))
+ (plz-test-get-response response)
+ (let ((output (string-join (reverse outputs))))
+ (should (string-match-p "HTTP.*\s+200" output))
+ (should (string-match-p "Server: gunicorn" output))
+ (should (string-match-p "\"args\":\s*{}" output)))))
+
;;;; Footer
(provide 'test-plz)
