bench test for hGetLineUntilExitOrEOF

This seems to show that hWaitForInput does not seem to behave as
documented. It does not time out, so blocks forever in this situation.
This is with a 0 timeout and with larger timeouts. Unsure why, it looked
like it should work.

Utility/Process.hs

@@ -6,7 +6,7 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP, Rank2Types #-}
+{-# LANGUAGE CPP, Rank2Types, LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Process (
@@ -24,7 +24,7 @@ module Utility.Process (
 	withCreateProcess,
 	waitForProcess,
 	cleanupProcess,
-	cancelOnExit,
+	hGetLineUntilExitOrEOF,
 	startInteractiveProcess,
 	stdinHandle,
 	stdoutHandle,
@@ -250,40 +250,56 @@ cleanupProcess (mb_stdin, mb_stdout, mb_stderr, pid) = do
  - buffered to the handle before exiting.
  -}
 hGetLineUntilExitOrEOF :: ProcessHandle -> Handle -> IO (Maybe String)
-hGetLineUntilExitOrEOF ph h = either Just id <$> (reader `race` waiter)
+hGetLineUntilExitOrEOF ph h = do
+	w <- async waiter
+	r <- reader
+	cancel w
+	return r
   where
-	reader = hGetLine isEOF h >>= \case
+	reader = hIsEOF h >>= \case
 		True -> return Nothing
 		False -> Just <$> hGetLine h
 
 	waiter = do
 		smalldelay
+		print "hGetLineUntilExitOrEOF waitForProcess"
+		hFlush stdout
 		_ <- waitForProcess ph
-		waiter'
+		print "hGetLineUntilExitOrEOF process done"
+		hFlush stdout
+		waitbufferempty
+		print "hGetLineUntilExitOrEOF buffer empty"
+		hFlush stdout
 		-- Reached the end of the processes output.
 		hClose h
 
-	waiter' = isanythingbuffered >>= \case
+	waitbufferempty = isanythingbuffered >>= \case
 		True -> do
+			print "something still buffered.."
 			-- Waiting for the reader to consume
 			-- buffered output after the process has
 			-- exited.
 			threadDelay 10000 -- 1/100th second
-			waiter'
+			waitbufferempty
 		False ->  return ()
 
-	isanythingbuffered = 
+	isanythingbuffered = do
+		print "hWaitForInput call start"
 		-- waitForInput is documented to throw an encoding
 		-- error in some cases, if the Handle has buffered on it
 		-- something that cannot be decoded. If it does,
 		-- that does imply there's still something buffered though.
+		r <- hWaitForInput h 100
+		{-
 		catchNonAsync
-			(const (return True))
 			-- waitForInput can throw an EOF error
 			(catchIOErrorType EOF
-				(const (return False))
-				(hWaitForInput h 0))
-
+				(const (print "EOF exception" >> return False))
+				(hWaitForInput h 1))
+			(const (print "encoding exception" >> return True))
+		-}
+		print "hWaitForInput call done"
+		return r
 
 	-- A small delay avoids starting the work of waitForProcess
 	-- unncessarily in the common case where hGetLine gets a buffered

bench

@@ -0,0 +1,5 @@
+#!/bin/sh
+ssh -fN -o ControlMaster=auto -o ControlPersist=15m -o ControlPath=./socket localhost
+echo foo >&2
+sleep 2
+perl -e 'print STDERR "blah\n" for 1..100; print STDERR "final\n"'

test.hs

@@ -0,0 +1,19 @@
+import Utility.Process
+import Data.Maybe
+import System.IO
+import Control.Concurrent.Async
+
+main = do
+	(Nothing, Nothing, Just h, p) <- createProcess $ (proc "./bench" [])
+		{ std_err = CreatePipe }
+	t <- async $ go h p
+	exitcode <- waitForProcess p
+	print ("process exited", exitcode)
+	wait t
+  where
+	go h p = do
+		l <- hGetLineUntilExitOrEOF p h
+		print ("got line", l)
+		if isJust l
+			then go h p
+			else print "at EOF"