1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
{-# LANGUAGE PatternGuards #-}
module Examples.Test.Random(main) where
import Development.Shake
import Examples.Util
import Control.Exception
import Control.Monad
import Data.List
import Data.Maybe
import Data.Time
import System.Environment
import System.Exit
import System.Random
import qualified Data.ByteString.Char8 as BS
inputRange = [1..10]
data Value = Single Int | Multiple [[Value]]
deriving (Read,Show,Eq)
data Source = Input Int | Output Int | Bang
deriving (Read,Show)
data Logic = Logic Int [[Source]]
| Want [Int]
deriving (Read,Show)
main = shaken test $ \args obj -> do
let toFile (Input i) = obj $ "input-" ++ show i ++ ".txt"
toFile (Output i) = obj $ "output-" ++ show i ++ ".txt"
toFile Bang = error "BANG"
let randomSleep = liftIO $ do
i <- randomRIO (0, 25)
sleep $ fromInteger i / 100
forM_ (map read $ filter (isNothing . asDuration) args) $ \x -> case x of
Want xs -> want $ map (toFile . Output) xs
Logic out srcs -> toFile (Output out) *> \out -> do
res <- fmap (show . Multiple) $ forM srcs $ \src -> do
randomSleep
need $ map toFile src
mapM (liftIO . fmap read . readFileStrict . toFile) src
randomSleep
writeFileChanged out res
asDuration :: String -> Maybe Double
asDuration x
| "s" `isSuffixOf` x, [(i,"")] <- reads $ init x = Just i
| "m" `isSuffixOf` x, [(i,"")] <- reads $ init x = Just $ i * 60
| otherwise = Nothing
test build obj = do
limit <- do
args <- getArgs
let bound = listToMaybe $ reverse $ mapMaybe asDuration args
start <- getCurrentTime
return $ when (isJust bound) $ do
now <- getCurrentTime
when (fromRational (toRational $ now `diffUTCTime` start) > fromJust bound) exitSuccess
forM_ [1..] $ \count -> do
limit
putStrLn $ "* PERFORMING RANDOM TEST " ++ show count
build ["clean"]
build [] -- to create the directory
forM_ inputRange $ \i ->
writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single i
logic <- randomLogic
runLogic [] logic
chng <- filterM (const randomIO) inputRange
forM_ chng $ \i ->
writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single $ negate i
runLogic chng logic
forM_ inputRange $ \i ->
writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single i
logicBang <- addBang =<< addBang logic
j <- randomRIO (1::Int,8)
res <- try $ build $ "--exception" : ("-j" ++ show j) : map show (logicBang ++ [Want [i | Logic i _ <- logicBang]])
case res of
Left err
| "BANG" `isInfixOf` show (err :: SomeException) -> return () -- error I expected
| otherwise -> error $ "UNEXPECTED ERROR: " ++ show err
_ -> return () -- occasionally we only put BANG in places with no dependenies that don't get rebuilt
runLogic [] $ logic ++ [Want [i | Logic i _ <- logic]]
where
runLogic :: [Int] -> [Logic] -> IO ()
runLogic negated xs = do
let poss = [i | Logic i _ <- xs]
i <- randomRIO (0, 7)
wants <- replicateM i $ do
i <- randomRIO (0, 5)
replicateM i $ randomElem poss
sleepFileTime
j <- randomRIO (1::Int,8)
build $ ("-j" ++ show j) : map show (xs ++ map Want wants)
let value i = case [ys | Logic j ys <- xs, j == i] of
[ys] -> Multiple $ flip map ys $ map $ \i -> case i of
Input i -> Single $ if i `elem` negated then negate i else i
Output i -> value i
forM_ (concat wants) $ \i -> do
let wanted = value i
got <- fmap read $ readFileStrict $ obj $ "output-" ++ show i ++ ".txt"
when (wanted /= got) $
error $ "INCORRECT VALUE for " ++ show i
addBang :: [Logic] -> IO [Logic]
addBang xs = do
i <- randomRIO (0, length xs - 1)
let (before,now:after) = splitAt i xs
now <- f now
return $ before ++ now : after
where
f (Logic log xs) = do
i <- randomRIO (0, length xs)
let (before,after) = splitAt i xs
return $ Logic log $ before ++ [Bang] : after
randomLogic :: IO [Logic] -- only Logic constructors
randomLogic = do
rules <- randomRIO (1,100)
f rules $ map Input inputRange
where
f 0 avail = return []
f i avail = do
needs <- randomRIO (0,3)
xs <- replicateM needs $ do
ns <- randomRIO (0,3)
replicateM ns $ randomElem avail
let r = Logic i xs
fmap (r:) $ f (i-1) (Output i:avail)
randomElem :: [a] -> IO a
randomElem xs = do
i <- randomRIO (0, length xs - 1)
return $ xs !! i
readFileStrict :: FilePath -> IO String
readFileStrict = fmap BS.unpack . BS.readFile
|
