CodeGolf.SE #4486 test script

Main.hs

import Control.Monad
import Data.Char
import System.Directory
import System.Exit
import System.IO
import System.Process

program = "main=print$(\\xx@2012->xx)2012\n"
alphabet = [chr 32 .. chr 126]

deletions [] = []
deletions (x:xs) = xs : map (x:) (deletions xs)

insertions [] = map (:[]) alphabet
insertions (x:xs) = map (:(x:xs)) alphabet ++ map (x:) (insertions xs)

replacements [] = []
replacements (x:xs) = map (:xs) alphabet ++ map (x:) (replacements xs)

modifications xs = insertions xs ++ deletions xs ++ replacements xs

test program = do
    (path, handle) <- openTempFile "." "test.hs"
    hPutStr handle program
    hClose handle

    (exitCode, stdout, stderr) <- readProcessWithExitCode "runhaskell" [path] ""

    removeFile path

    let correct = exitCode == ExitSuccess && stdout == "2012\n" && stderr == ""
    let crashed = exitCode /= ExitSuccess || stderr /= ""

    return (correct || crashed)

testAll programs = go 1 programs
  where 
     go n (p:ps) = do putStr $ show n ++ "/" ++ show total ++ "\r"
                      hFlush stdout
                      passed <- test p
                      when (not passed) $ putStrLn $ "Failure: " ++ p
                      go (n+1) ps
     go n [] = putStrLn "Done" 

     total = length programs

main = testAll $ modifications program