1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00

ports.test: catch pipe errors

Refactors a couple of the ports tests to catch errors in the test runner,
so that the test suite will print ERROR on failure.

* test-suite/tests/ports.test (pipe:write, pipe:read): modified
This commit is contained in:
Michael Gran 2023-06-02 18:57:06 -07:00
parent b572f187af
commit 73a8ca88fb

View file

@ -2,7 +2,7 @@
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;; ;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006-2007, 2009-2015, 2017, 2019-2021, ;;;; Copyright (C) 1999, 2001, 2004, 2006-2007, 2009-2015, 2017, 2019-2021,
;;;; 2024 Free Software Foundation, Inc. ;;;; 2024,2025 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -736,22 +736,23 @@
;;;; Pipe (popen) ports. ;;;; Pipe (popen) ports.
;;; Run a command, and read its output. ;;; Run a command, and read its output.
(let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r")) (pass-if "pipe: read"
(in-string (read-all pipe))) (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
(close-pipe pipe) (in-string (read-all pipe)))
(pass-if "pipe: read" (close-pipe pipe)
(equal? in-string "Howdy there, partner!\n"))) (equal? in-string "Howdy there, partner!\n")))
;;; Run a command, send some output to it, and see if it worked. ;;; Run a command, send some output to it, and see if it worked.
(let* ((filename (test-file)) (pass-if "pipe: write"
(pipe (open-pipe (string-append "grep Mommy > " filename) "w"))) (let* ((filename (test-file))
(display "Now Jimmy lives on a mushroom cloud\n" pipe) (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
(display "Mommy, why does everybody have a bomb?\n" pipe) (display "Now Jimmy lives on a mushroom cloud\n" pipe)
(close-pipe pipe) (display "Mommy, why does everybody have a bomb?\n" pipe)
(let ((in-string (read-file filename))) (close-pipe pipe)
(pass-if "pipe: write" (let ((in-string (read-file filename)))
(equal? in-string "Mommy, why does everybody have a bomb?\n"))) (delete-file filename)
(delete-file filename)) (equal? in-string "Mommy, why does everybody have a bomb?\n"))))
(pass-if-equal "pipe, fdopen, and line buffering" (pass-if-equal "pipe, fdopen, and line buffering"
"foo\nbar\n" "foo\nbar\n"