From baa4c9b27dd467c94fad38bc044dd715b96f0b32 Mon Sep 17 00:00:00 2001 From: Nicolas Trangez Date: Fri, 21 Oct 2016 02:11:14 +0200 Subject: [PATCH] reedsolomon-examples: Add test-suite This commit adds a simple test-suite for the `reedsolomon-example` binaries. The tests run the binaries in-place on some random data and validate a couple of basic expectations. --- .../reedsolomon-examples.cabal | 17 ++ reedsolomon-examples/test/Main.hs | 153 ++++++++++++++++++ stack.yaml | 1 + 3 files changed, 171 insertions(+) create mode 100644 reedsolomon-examples/test/Main.hs diff --git a/reedsolomon-examples/reedsolomon-examples.cabal b/reedsolomon-examples/reedsolomon-examples.cabal index 821aab41..0e7c23f7 100644 --- a/reedsolomon-examples/reedsolomon-examples.cabal +++ b/reedsolomon-examples/reedsolomon-examples.cabal @@ -42,6 +42,23 @@ Executable reedsolomon-simple-decoder , vector >= 0.10 && < 0.12 Default-Language: Haskell2010 +Test-Suite reedsolomon-examples-test + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: test + Main-Is: Main.hs + Build-Depends: base >= 4.7 && < 4.10 + , directory >= 1.2 && < 1.3 + , filepath >= 1.3 && < 1.5 + , process >= 1.2 && < 1.5 + , random >= 1.1 && < 1.2 + , tasty >= 0.10 && < 0.12 + , tasty-hspec >= 1.1 && < 1.2 + , temporary >= 1.2 && < 1.3 + Default-Language: Haskell2010 + Ghc-Options: -threaded -rtsopts -with-rtsopts=-N + if impl(ghc >= 7.10) + Ghc-Options: -g + Source-Repository head Type: git Location: https://github.com/NicolasT/reedsolomon.git diff --git a/reedsolomon-examples/test/Main.hs b/reedsolomon-examples/test/Main.hs new file mode 100644 index 00000000..0d83120f --- /dev/null +++ b/reedsolomon-examples/test/Main.hs @@ -0,0 +1,153 @@ +module Main (main) where + +import Control.Monad (forM_, void) +import Data.Char (chr) +import System.Exit (ExitCode(ExitFailure)) +import System.IO (Handle, SeekMode(AbsoluteSeek), hFlush, hGetContents, hPutStr, hSeek) + +import System.Directory (getDirectoryContents, removeFile) + +import System.FilePath ((), takeDirectory, takeFileName) + +import System.Process (readProcess, readProcessWithExitCode) + +import System.Random (getStdGen, randomRIO, randomRs) + +import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) + +import Test.Tasty (defaultMain) +import Test.Tasty.Hspec + +main :: IO () +main = defaultMain =<< testSpec "reedsolomon-examples" spec + +spec :: Spec +spec = do + encoderSpec + decoderSpec + +encoderSpec :: Spec +encoderSpec = around (withDataAndOut fileSize) $ + describe "reedsolomon-simple-encoder" $ do + context "when provided with no options" $ + it "outputs 6 (4 + 2) parts" $ \(dat, out) -> do + exec "reedsolomon-simple-encoder" ["--out", out, dat] + parts <- listDirectory out + length parts `shouldBe` 6 + context "when provided with options" $ do + let testOptions n k = + let msg = unwords ["outputs", show (n + k) + , "(" ++ show n ++ " + " ++ show k ++ ")" + , "parts for" + , "'--data", show n, "--par", show k ++ "'" + ] + in + it msg $ \(dat, out) -> do + exec "reedsolomon-simple-encoder" [ "--out", out + , "--data", show n + , "--par", show k + , dat + ] + parts <- listDirectory out + length parts `shouldBe` n + k + + testOptions 4 2 + testOptions 9 3 + testOptions 50 10 + + where + fileSize = 4 * 1024 + 1 + + +decoderSpec :: Spec +decoderSpec = around (withEncodedData 9 3 fileSize) $ + describe "reedsolomon-simple-decoder" $ do + context "when no data parts are missing" $ + it "decodes the data correctly" $ runTest (const (return ())) + + context "when K random parts are missing" $ + it "decodes the data correctly" $ + let pre (_, k, parts, _, _) = + forM_ [0 .. k - 1] $ \_ -> do + parts' <- listDirectory (takeDirectory parts) + idx <- randomRIO (0, length parts' - 1) + let part = takeDirectory parts (parts' !! idx) + removeFile part + in + runTest pre + + context "when (K + 1) data parts are missing" $ + it "fails to decode" $ \(n, k, parts, out, _) -> do + parts' <- listDirectory (takeDirectory parts) + forM_ (take (k + 1) parts') $ \name -> + removeFile (takeDirectory parts name) + + let cmd = "reedsolomon-simple-decoder" + args = [ "--out", out "result" + , "--data", show n + , "--par", show k + , parts + ] + (exitCode, _, err) <- readProcessWithExitCode cmd args "" + + exitCode `shouldSatisfy` isExitFailure + err `shouldContain` "InvalidNumberOfShards" + where + fileSize = 3 * 1024 + 1 + isExitFailure e = case e of + ExitFailure _ -> True + _ -> False + runTest :: ((Int, Int, FilePath, FilePath, Handle) -> IO ()) + -> (Int, Int, FilePath, FilePath, Handle) + -> IO () + runTest pre args@(n, k, parts, out, original) = do + pre args + + let result = out "result" + exec "reedsolomon-simple-decoder" [ "--out", result + , "--data", show n + , "--par", show k + , parts + ] + + result' <- take fileSize `fmap` readFile result + original' <- hGetContents original + + result' `shouldBe` original' + + +exec :: String -> [String] -> IO () +exec cmd args = void $ readProcess cmd args "" + +fillHandle :: Int -> Handle -> IO () +fillHandle size hnd = do + gen <- getStdGen + hPutStr hnd $ map chr $ take size $ randomRs (0, 127) gen + hFlush hnd + +withDataAndOut :: Int -> ((FilePath, FilePath) -> IO ()) -> IO () +withDataAndOut size action = + withSystemTempFile "reedsolomon-examples.dat" $ \dat hnd -> do + fillHandle size hnd + withSystemTempDirectory "reedsolomon-examples.out" $ \out -> + action (dat, out) + +withEncodedData :: Int -> Int -> Int -> ((Int, Int, FilePath, FilePath, Handle) -> IO ()) -> IO () +withEncodedData n k size action = + withSystemTempFile "reedsolomon-examples.dat" $ \dat hnd -> do + fillHandle size hnd + hSeek hnd AbsoluteSeek 0 + + withSystemTempDirectory "reedsolomon-examples.out" $ \out -> do + exec "reedsolomon-simple-encoder" [ "--out", out + , "--data", show n + , "--par", show k + , dat + ] + + let out' = out takeFileName dat + withSystemTempDirectory "reedsolomon-examples.out" $ \out2 -> + action (n, k, out', out2, hnd) + +listDirectory :: FilePath -> IO [FilePath] +listDirectory = fmap (filter $ flip notElem [".", ".."]) . getDirectoryContents diff --git a/stack.yaml b/stack.yaml index a3e2f828..febab0bb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,5 +4,6 @@ packages: extra-deps: - bytestring-mmap-0.2.2 +- tasty-hspec-1.1.3 resolver: lts-7.0