testsuite timeouts

Ian Lynagh <[email protected]> Wed, 6 Apr 2005 13:10:18 +0100

Newsgroups	gmane.comp.lang.haskell.cvs.fptools
Message-ID	<20050406121018.GA19110__44737.994837533$1112789329$gmane$org@matrix.chaos.earth.li>

Hi,

The timeout program in the testsuite doesn't seem to work correctly for
me. If I run the okeefe_neural test with a timeout of 10s then the tests
are aborted, but the ghc-6.5 processes aren't killed, leaving me with 7
of them working away when it finishes.

I've attached a replacement that does work for me. It makes a new
process group for the test, and kills that group rather than a single
process when a timeout happens. Annoyingly I can't seem to write it
without resorting to some C - in order to run createSession in a fork I
have to get a ProcessID, but waitForProcess wants a ProcessHandle. I
can't see a way to convert one to the other, nor a waitpid wrapper
working on ProcessIDs.

I don't think this will work on Windows, but driver/testlib.py doesn't
use it on Windows anyway, so this doesn't look like a problem.


Is it OK to commit this?


Thanks
Ian

_______________________________________________
Cvs-fptools mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-fptools

Makefile (text/plain, 199 B)

TOP = ..
include $(TOP)/mk/boilerplate.mk

HC = $(GHC_INPLACE)
MKDEPENDHS = $(GHC_INPLACE)
SRC_HC_OPTS += -threaded -package unix

HS_PROG = timeout

boot :: $(HS_PROG)

include $(TOP)/mk/target.mk

cbits.c (text/x-csrc, 206 B)

#include "timeout.h"

int mywaitpid(pid_t pid) {
    int status;
    waitpid(pid, &status, 0);
    if (WIFEXITED(status)) {
        return WEXITSTATUS(status);
    }
    else {
        return 99;
    }
}

timeout.h (text/x-chdr, 74 B)

#include <sys/types.h>
#include <sys/wait.h>

int mywaitpid(pid_t pid);

timeout.hs (text/plain, 1.1 KB)

{-# OPTIONS_GHC -fffi #-}

import Control.Concurrent
import System.Environment
import System.Process
import System.Exit

import Foreign.C.Types
import System.Posix.Signals
import System.Posix.Types
import System.IO
import System.Posix.Process (forkProcess, createSession)
import System.Cmd (system)

main = do
  args <- getArgs
  case args of 
    [secs,cmd] -> do
        p <- forkProcess $ do createSession
                              r <- system cmd
                              exitWith r
        m <- newEmptyMVar
        forkIO (do threadDelay (read secs * 1000000)
                   putMVar m Nothing
               )
        forkIO (do r <- waitpid p
                   putMVar m (Just (fromIntegral r)))
        r <- takeMVar m
        case r of
          Nothing -> do signalProcessGroup sigTERM p
                        exitWith (ExitFailure 99)
          Just 0 -> exitWith ExitSuccess
          Just r -> exitWith (ExitFailure r)
    _other -> do hPutStrLn stderr "timeout: bad arguments"
                 exitWith (ExitFailure 1)

foreign import ccall "timeout.h mywaitpid" waitpid :: CPid -> IO CInt