mirror of
https://github.com/NixOS/nixpkgs.git
synced 2024-11-21 05:00:16 +00:00
420506d752
svn path=/nixpkgs/trunk/; revision=11196
46 lines
1.8 KiB
Diff
46 lines
1.8 KiB
Diff
Index: guile/test-suite/tests/popen.test
|
|
===================================================================
|
|
RCS file: /sources/guile/guile/guile-core/guile/test-suite/tests/popen.test,v
|
|
retrieving revision 1.3.2.2
|
|
diff -u -r1.3.2.2 popen.test
|
|
--- guile/test-suite/tests/popen.test 25 Aug 2006 01:21:39 -0000 1.3.2.2
|
|
+++ guile/test-suite/tests/popen.test 18 Mar 2008 20:18:08 -0000
|
|
@@ -1,6 +1,6 @@
|
|
;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*-
|
|
;;;;
|
|
-;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
|
|
+;;;; Copyright 2003, 2006, 2008 Free Software Foundation, Inc.
|
|
;;;;
|
|
;;;; This library is free software; you can redistribute it and/or
|
|
;;;; modify it under the terms of the GNU Lesser General Public
|
|
@@ -81,12 +81,15 @@
|
|
(let* ((pair (pipe))
|
|
(port (with-error-to-port (cdr pair)
|
|
(lambda ()
|
|
- (open-input-pipe
|
|
- "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
|
|
+ (open-input-output-pipe
|
|
+ "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; read")))))
|
|
(close-port (cdr pair)) ;; write side
|
|
- (and (char? (read-char (car pair))) ;; wait for child to do its thing
|
|
- (char-ready? port)
|
|
- (eof-object? (read-char port))))))
|
|
+ (let ((result (and (char? (read-char (car pair))) ;; wait for child to do its thing
|
|
+ (char-ready? port)
|
|
+ (eof-object? (read-char port)))))
|
|
+ (display "hello!\n" port)
|
|
+ (close-pipe port)
|
|
+ result))))
|
|
|
|
;;
|
|
;; open-output-pipe
|
|
@@ -132,7 +135,7 @@
|
|
(port (with-error-to-port (cdr pair)
|
|
(lambda ()
|
|
(open-output-pipe
|
|
- "exec 0</dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
|
|
+ "exec 0</dev/null; echo closed 1>&2; exec 2>/dev/null; read")))))
|
|
(close-port (cdr pair)) ;; write side
|
|
(and (char? (read-char (car pair))) ;; wait for child to do its thing
|
|
(catch 'system-error
|