fuzz tester: avoid deleting entire repository (had to happen eventually, right?)
This commit is contained in:
parent
377bc7bbb7
commit
33fe3dac9e
1 changed files with 27 additions and 21 deletions
|
@ -211,31 +211,37 @@ genFuzzAction = do
|
||||||
|
|
||||||
existingFile :: Int -> FilePath -> IO (Maybe FuzzFile)
|
existingFile :: Int -> FilePath -> IO (Maybe FuzzFile)
|
||||||
existingFile 0 _ = return Nothing
|
existingFile 0 _ = return Nothing
|
||||||
existingFile n top = maybe (return Nothing) (go . toFilePath) =<< existingDir
|
existingFile n top = do
|
||||||
where
|
dir <- existingDirIncludingTop
|
||||||
go dir = do
|
contents <- catchDefaultIO [] (getDirectoryContents dir)
|
||||||
contents <- catchDefaultIO [] (getDirectoryContents dir)
|
let files = filter isFuzzFile contents
|
||||||
let files = filter isFuzzFile contents
|
if null files
|
||||||
if null files
|
then do
|
||||||
then do
|
let dirs = filter isFuzzDir contents
|
||||||
let dirs = filter isFuzzDir contents
|
if null dirs
|
||||||
if null dirs
|
then return Nothing
|
||||||
then return Nothing
|
else do
|
||||||
else do
|
i <- getStdRandom $ randomR (0, length dirs - 1)
|
||||||
i <- getStdRandom $ randomR (0, length dirs - 1)
|
existingFile (n - 1) (top </> dirs !! i)
|
||||||
existingFile (n - 1) (top </> dirs !! i)
|
else do
|
||||||
else do
|
i <- getStdRandom $ randomR (0, length files - 1)
|
||||||
i <- getStdRandom $ randomR (0, length files - 1)
|
return $ Just $ FuzzFile $ top </> dir </> files !! i
|
||||||
return $ Just $ FuzzFile $ top </> dir </> files !! i
|
|
||||||
|
existingDirIncludingTop :: IO FilePath
|
||||||
existingDir :: IO (Maybe FuzzDir)
|
existingDirIncludingTop = do
|
||||||
existingDir = do
|
|
||||||
dirs <- filter isFuzzDir <$> getDirectoryContents "."
|
dirs <- filter isFuzzDir <$> getDirectoryContents "."
|
||||||
if null dirs
|
if null dirs
|
||||||
then return Nothing
|
then return "."
|
||||||
else do
|
else do
|
||||||
n <- getStdRandom $ randomR (0, length dirs)
|
n <- getStdRandom $ randomR (0, length dirs)
|
||||||
return $ Just $ FuzzDir $ ("." : dirs) !! n
|
return $ ("." : dirs) !! n
|
||||||
|
|
||||||
|
existingDir :: IO (Maybe FuzzDir)
|
||||||
|
existingDir = do
|
||||||
|
d <- existingDirIncludingTop
|
||||||
|
return $ if isFuzzDir d
|
||||||
|
then Just $ FuzzDir d
|
||||||
|
else Nothing
|
||||||
|
|
||||||
newFile :: IO (Maybe FuzzFile)
|
newFile :: IO (Maybe FuzzFile)
|
||||||
newFile = go (100 :: Int)
|
newFile = go (100 :: Int)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue