diff --git a/t-child.c b/t-child.c index fe2e7b4..ae1a635 100644 --- a/t-child.c +++ b/t-child.c @@ -1,66 +1,74 @@ /* Sanity check for the process and IPC primitives. * * Copyright (C) 2016 g10 code GmbH * * This file is part of GnuPG. * * GnuPG is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 3 of the License, or * (at your option) any later version. * * GnuPG is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, see . */ #include #include #include #ifdef _WIN32 # include # include #endif int main (int argc, char **argv) { + char buffer[4096]; + memset (buffer, 'A', sizeof buffer); #if _WIN32 if (! setmode (stdin, O_BINARY)) return 23; if (! setmode (stdout, O_BINARY)) return 23; #endif if (argc == 1) return 2; else if (strcmp (argv[1], "return0") == 0) return 0; else if (strcmp (argv[1], "return1") == 0) return 1; else if (strcmp (argv[1], "return77") == 0) return 77; else if (strcmp (argv[1], "hello_stdout") == 0) 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); } else { fprintf (stderr, "unknown command %s\n", argv[1]); return 2; } return 0; } diff --git a/t-child.scm b/t-child.scm index 27928f6..93208f4 100644 --- a/t-child.scm +++ b/t-child.scm @@ -1,93 +1,118 @@ ;; Tests for the low-level process and IPC primitives. ;; ;; Copyright (C) 2016 g10 Code GmbH ;; ;; This file is part of GnuPG. ;; ;; GnuPG is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3 of the License, or ;; (at your option) any later version. ;; ;; GnuPG is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, see . (echo "Testing process and IPC primitives...") (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")))) (let ((r (call-with-io `(,(qualify "t-child") "return0") ""))) (assert (= 0 (:retcode r))) (assert (string=? "" (:stdout r))) (assert (string=? "" (:stderr r)))) (let ((r (call-with-io `(,(qualify "t-child") "return1") ""))) (assert (= 1 (:retcode r))) (assert (string=? "" (:stdout r))) (assert (string=? "" (:stderr r)))) (let ((r (call-with-io `(,(qualify "t-child") "return77") ""))) (assert (= 77 (:retcode r))) (assert (string=? "" (:stdout r))) (assert (string=? "" (:stderr r)))) (let ((r (call-with-io `(,(qualify "t-child") "hello_stdout") ""))) (assert (= 0 (:retcode r))) (assert (string=? "hello" (:stdout r))) (assert (string=? "" (:stderr r)))) (let ((r (call-with-io `(,(qualify "t-child") "hello_stderr") ""))) (assert (= 0 (:retcode r))) (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))) (assert (string=? "" (:stderr r)))) (define (spawn what) (spawn-process-fd what CLOSED_FD STDOUT_FILENO STDERR_FILENO)) (let ((pid0 (spawn `(,(qualify "t-child") "return0"))) (pid1 (spawn `(,(qualify "t-child") "return0")))) (assert (equal? '(0 0) (wait-processes '("child0" "child1") (list pid0 pid1) #t)))) (let ((pid0 (spawn `(,(qualify "t-child") "return1"))) (pid1 (spawn `(,(qualify "t-child") "return0")))) (assert (equal? '(1 0) (wait-processes '("child0" "child1") (list pid0 pid1) #t)))) (let ((pid0 (spawn `(,(qualify "t-child") "return0"))) (pid1 (spawn `(,(qualify "t-child") "return77"))) (pid2 (spawn `(,(qualify "t-child") "return1")))) (assert (equal? '(0 77 1) (wait-processes '("child0" "child1" "child2") (list pid0 pid1 pid2) #t)))) (let* ((p (pipe)) (pid0 (spawn-process-fd `(,(qualify "t-child") "hello_stdout") CLOSED_FD (:write-end p) STDERR_FILENO)) (_ (close (:write-end p))) (pid1 (spawn-process-fd `(,(qualify "t-child") "cat") (:read-end p) STDOUT_FILENO STDERR_FILENO))) (close (:read-end p)) (assert (equal? '(0 0) (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.")