1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-07-02 22:46:30 +02:00

tests: Fix call-with-io deadlock.

* tests/gpgscm/ffi.c (es_wrap): Ifdef-out.
[HAVE_W32_SYSTEM] (read_from_pipe): New.
(do_process_spawn_io): Rename from do_process_spawn.  Do I/O
with no deadlock.
* tests/gpgscm/tests.scm (call-with-io): Use process-spawn-io.
(es-read-all): Remove.

--

GnuPG-bug-id: 6523
Signed-off-by: NIIBE Yutaka <gniibe@fsij.org>
This commit is contained in:
NIIBE Yutaka 2023-06-08 14:39:50 +09:00
parent f5656ff363
commit 1b0ce9918c
No known key found for this signature in database
GPG key ID: 640114AF89DE6054
2 changed files with 299 additions and 46 deletions

View file

@ -92,24 +92,16 @@
(define :stdin car)
(define :stdout cadr)
(define :stderr caddr)
(define :proc cadddr)
(define (call-with-io what in)
(let ((h (process-spawn what 0)))
(es-write (:stdin h) in)
(es-fclose (:stdin h))
(let* ((out (es-read-all (:stdout h)))
(err (es-read-all (:stderr h)))
(result (process-wait (:proc h) #t)))
(es-fclose (:stdout h))
(es-fclose (:stderr h))
(if (> (*verbose*) 2)
(info "Child" (:proc h) "returned:"
`((command ,(stringify what))
(status ,result)
(stdout ,out)
(stderr ,err))))
(list result out err))))
(let ((proc-result (process-spawn-io what in)))
(if (> (*verbose*) 2)
(info "Child #proc returned:"
`((command ,(stringify what))
(status ,(car proc-result))
(stdout ,(cadr proc-result))
(stderr ,(caddr proc-result)))))
proc-result))
;; Accessor function for the results of 'call-with-io'. ':stdout' and
;; ':stderr' can also be used.
@ -128,17 +120,6 @@
(:stdout result)
(throw (:stderr result)))))
;;
;; estream helpers.
;;
(define (es-read-all stream)
(let loop
((acc ""))
(if (es-feof stream)
acc
(loop (string-append acc (es-read stream 4096))))))
;;
;; File management.
;;