diff --git a/tests/gpgscm/t-child.c b/tests/gpgscm/t-child.c index fe2e7b407..ae1a6352c 100644 --- a/tests/gpgscm/t-child.c +++ b/tests/gpgscm/t-child.c @@ -30,6 +30,8 @@ int main (int argc, char **argv) { + char buffer[4096]; + memset (buffer, 'A', sizeof buffer); #if _WIN32 if (! setmode (stdin, O_BINARY)) return 23; @@ -49,10 +51,16 @@ main (int argc, char **argv) fprintf (stdout, "hello"); else if (strcmp (argv[1], "hello_stderr") == 0) fprintf (stderr, "hello"); + else if (strcmp (argv[1], "stdout4096") == 0) + fwrite (buffer, 1, sizeof buffer, stdout); + else if (strcmp (argv[1], "stdout8192") == 0) + { + fwrite (buffer, 1, sizeof buffer, stdout); + fwrite (buffer, 1, sizeof buffer, stdout); + } else if (strcmp (argv[1], "cat") == 0) while (! feof (stdin)) { - char buffer[4096]; size_t bytes_read; bytes_read = fread (buffer, 1, sizeof buffer, stdin); fwrite (buffer, 1, bytes_read, stdout); diff --git a/tests/gpgscm/t-child.scm b/tests/gpgscm/t-child.scm index 27928f6d8..93208f421 100644 --- a/tests/gpgscm/t-child.scm +++ b/tests/gpgscm/t-child.scm @@ -22,6 +22,8 @@ (define (qualify executable) (string-append executable (getenv "EXEEXT"))) +(define child (qualify "t-child")) + (assert (= 0 (call `(,(qualify "t-child") "return0")))) (assert (= 1 (call `(,(qualify "t-child") "return1")))) (assert (= 77 (call `(,(qualify "t-child") "return77")))) @@ -51,6 +53,16 @@ (assert (string=? "" (:stdout r))) (assert (string=? "hello" (:stderr r)))) +(let ((r (call-with-io `(,(qualify "t-child") "stdout4096") ""))) + (assert (= 0 (:retcode r))) + (assert (= 4096 (string-length (:stdout r)))) + (assert (string=? "" (:stderr r)))) + +(let ((r (call-with-io `(,(qualify "t-child") "stdout8192") ""))) + (assert (= 0 (:retcode r))) + (assert (= 8192 (string-length (:stdout r)))) + (assert (string=? "" (:stderr r)))) + (let ((r (call-with-io `(,(qualify "t-child") "cat") "hellohello"))) (assert (= 0 (:retcode r))) (assert (string=? "hellohello" (:stdout r))) @@ -90,4 +102,17 @@ (wait-processes '("child0" "child1") (list pid0 pid1) #t)))) (echo " world.") +(tr:do + (tr:pipe-do + (pipe:spawn `(,child stdout4096)) + (pipe:spawn `(,child cat))) + (tr:call-with-content (lambda (c) + (assert (= 4096 (length c)))))) +(tr:do + (tr:pipe-do + (pipe:spawn `(,child stdout8192)) + (pipe:spawn `(,child cat))) + (tr:call-with-content (lambda (c) + (assert (= 8192 (length c)))))) + (echo "All good.")