Use smaller directory trees to bench and test BFS traversals

Author: adithyaov

bench-test-lib/src/BenchTestLib/DirIO.hs

@@ -6,6 +6,8 @@
 -- Stability   : experimental
 -- Portability : GHC
 
+{-# LANGUAGE QuasiQuotes #-}
+
 module BenchTestLib.DirIO
     ( createDirStucture
     , listDirUnfoldDfs
@@ -41,6 +43,7 @@ import Streamly.Data.Stream (Stream)
 import Streamly.Data.Unfold (Unfold)
 import Streamly.FileSystem.Path (Path)
 import System.Process (callCommand)
+import Streamly.Unicode.String (str)
 
 import qualified Streamly.Data.Stream.Prelude as Stream
 import qualified Streamly.Data.Array as Array
@@ -110,10 +113,12 @@ streamDirChunked = either Dir.readEitherChunks (const Stream.nil)
 -- Functions
 --------------------------------------------------------------------------------
 
-createDirStucture :: FilePath -> IO ()
-createDirStucture dirRoot = do
-    let cmd =
-            "bench-test-lib/create_dir_structure.sh  " ++ dirRoot ++ " 5 5"
+createDirStucture :: FilePath -> Int -> Int -> IO ()
+createDirStucture dirRoot depth width = do
+    let dStr = show depth
+        wStr = show width
+        cmd =
+            [str|./bench-test-lib/create_dir_structure.sh #{dirRoot} #{dStr} #{wStr}|]
     callCommand ("mkdir -p " ++ dirRoot)
     callCommand cmd
 

benchmark/Streamly/Benchmark/FileSystem/DirIO.hs

@@ -32,45 +32,48 @@ import BenchTestLib.DirIO
 moduleName :: String
 moduleName = "FileSystem.DirIO"
 
-#define BENCH(x) \
+#define BENCH(x,fp) \
 bench " x " $ nfIO $ \
-    Stream.fold Fold.drain $ x dirRoot
+    Stream.fold Fold.drain $ x fp
 
 -- | List the current directory recursively
 main :: IO ()
 main = do
     setLocaleEncoding utf8
 
-    let dirRoot = "benchmark-tmp/dir-structure"
-    createDirStucture dirRoot
+    let smallTree = "benchmark-tmp/dir-structure-small"
+        bigTree = "benchmark-tmp/dir-structure-big"
+    createDirStucture smallTree 2 3
+    createDirStucture bigTree 5 5
 
     defaultMain
         [ bgroup (o_1_space_prefix moduleName)
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
            $ (bench "listDirByteChunked" $ nfIO $
-               Stream.fold Fold.drain $ listDirByteChunked dirRoot) :
+               Stream.fold Fold.drain $ listDirByteChunked bigTree) :
 #endif
-            [ BENCH(listDirUnfoldDfs)
-              -- NOTE: The BFS traversal fails with:
-              -- openDirStream: resource exhausted (Too many open files)
-            , BENCH(listDirUnfoldDfs)
-            -- , BENCH(listDirUnfoldBfs)
-            -- , BENCH(listDirUnfoldBfsRev)
-            , BENCH(listDirConcatDfs)
-            -- , BENCH(listDirConcatBfs)
-            -- , BENCH(listDirConcatBfsRev)
-            , BENCH(listDirAppend)
-            , BENCH(listDirInterleave)
-            , BENCH(listDirPar)
-            , BENCH(listDirParInterleaved)
-            , BENCH(listDirParOrdered)
-            , BENCH(listDirChunkDfs)
-            -- , BENCH(listDirChunkBfs)
-            -- , BENCH(listDirChunkBfsRev)
-            , BENCH(listDirChunkAppend)
-            , BENCH(listDirChunkInterleave)
-            , BENCH(listDirChunkPar)
-            , BENCH(listDirChunkParInterleaved)
-            , BENCH(listDirChunkParOrdered)
+            -- NOTE: The BFS traversal fails with:
+            -- openDirStream: resource exhausted (Too many open files)
+            -- if a bigger directory tree is used
+            [ BENCH(listDirUnfoldDfs,bigTree)
+            , BENCH(listDirUnfoldDfs,bigTree)
+            , BENCH(listDirUnfoldBfs,smallTree)
+            , BENCH(listDirUnfoldBfsRev,smallTree)
+            , BENCH(listDirConcatDfs,bigTree)
+            , BENCH(listDirConcatBfs,smallTree)
+            , BENCH(listDirConcatBfsRev,smallTree)
+            , BENCH(listDirAppend,bigTree)
+            , BENCH(listDirInterleave,bigTree)
+            , BENCH(listDirPar,bigTree)
+            , BENCH(listDirParInterleaved,bigTree)
+            , BENCH(listDirParOrdered,bigTree)
+            , BENCH(listDirChunkDfs,bigTree)
+            , BENCH(listDirChunkBfs,smallTree)
+            , BENCH(listDirChunkBfsRev,smallTree)
+            , BENCH(listDirChunkAppend,bigTree)
+            , BENCH(listDirChunkInterleave,bigTree)
+            , BENCH(listDirChunkPar,bigTree)
+            , BENCH(listDirChunkParInterleaved,bigTree)
+            , BENCH(listDirChunkParOrdered,bigTree)
             ]
         ]

test/Streamly/Test/FileSystem/DirIO.hs

@@ -61,49 +61,64 @@ testCorrectnessByteChunked strmBase lister = do
                 $ Unicode.decodeUtf8Chunks lister
     Stream.eqBy (==) strm strmBase `shouldReturn` True
 
-#define IT(x) \
+#define IT(x,sb,dr) \
 it " x " $ \
-    testCorrectness strmBase (x dirRoot)
+    testCorrectness sb (x dr)
 
 -- | List the current directory recursively
 main :: IO ()
 main = do
     setLocaleEncoding utf8
-    let dirRoot = "benchmark-tmp/dir-structure"
-    createDirStucture dirRoot
-    findRes <- readCreateProcess ((shell [str|find #{dirRoot}|])) ""
-    strmBaseCache <-
+
+    let smallTree = "benchmark-tmp/dir-structure-small"
+        bigTree = "benchmark-tmp/dir-structure-big"
+    createDirStucture smallTree 2 3
+    createDirStucture bigTree 5 5
+
+    findResBig <- readCreateProcess (shell [str|find #{bigTree}|]) ""
+    findResSmall <- readCreateProcess (shell [str|find #{smallTree}|]) ""
+
+    strmBaseCacheSmall <-
+        Stream.fold Fold.toList
+            $ StreamK.toStream
+            $ StreamK.sortBy compare
+            $ StreamK.fromStream
+            $ Unicode.lines Fold.toList $ Stream.fromList findResSmall
+    strmBaseCacheBig <-
         Stream.fold Fold.toList
             $ StreamK.toStream
             $ StreamK.sortBy compare
             $ StreamK.fromStream
-            $ Unicode.lines Fold.toList $ Stream.fromList findRes
-    let strmBase = Stream.fromList strmBaseCache
+            $ Unicode.lines Fold.toList $ Stream.fromList findResBig
+    let strmBaseSmall = Stream.fromList strmBaseCacheSmall
+    let strmBaseBig = Stream.fromList strmBaseCacheBig
+
     hspec $
         describe moduleName $ do
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
             it "listDirByteChunked" $
                 testCorrectnessByteChunked
-                    (Stream.drop 1 strmBase) (listDirByteChunked dirRoot)
+                    (Stream.drop 1 strmBaseBig) (listDirByteChunked bigTree)
 #endif
             -- NOTE: The BFS traversal fails with:
             -- openDirStream: resource exhausted (Too many open files)
-            IT(listDirUnfoldDfs)
-            -- IT(listDirUnfoldBfs)
-            -- IT(listDirUnfoldBfsRev)
-            IT(listDirConcatDfs)
-            -- IT(listDirConcatBfs)
-            -- IT(listDirConcatBfsRev)
-            IT(listDirAppend)
-            IT(listDirInterleave)
-            IT(listDirPar)
-            IT(listDirParInterleaved)
-            IT(listDirParOrdered)
-            IT(listDirChunkDfs)
-            -- IT(listDirChunkBfs)
-            -- IT(listDirChunkBfsRev)
-            IT(listDirChunkAppend)
-            IT(listDirChunkInterleave)
-            IT(listDirChunkPar)
-            IT(listDirChunkParInterleaved)
-            IT(listDirChunkParOrdered)
+            -- if a bigger directory tree is used
+            IT(listDirUnfoldDfs,strmBaseBig,bigTree)
+            IT(listDirUnfoldBfs,strmBaseSmall,smallTree)
+            IT(listDirUnfoldBfsRev,strmBaseSmall,smallTree)
+            IT(listDirConcatDfs,strmBaseBig,bigTree)
+            IT(listDirConcatBfs,strmBaseSmall,smallTree)
+            IT(listDirConcatBfsRev,strmBaseSmall,smallTree)
+            IT(listDirAppend,strmBaseBig,bigTree)
+            IT(listDirInterleave,strmBaseBig,bigTree)
+            IT(listDirPar,strmBaseBig,bigTree)
+            IT(listDirParInterleaved,strmBaseBig,bigTree)
+            IT(listDirParOrdered,strmBaseBig,bigTree)
+            IT(listDirChunkDfs,strmBaseBig,bigTree)
+            IT(listDirChunkBfs,strmBaseSmall,smallTree)
+            IT(listDirChunkBfsRev,strmBaseSmall,smallTree)
+            IT(listDirChunkAppend,strmBaseBig,bigTree)
+            IT(listDirChunkInterleave,strmBaseBig,bigTree)
+            IT(listDirChunkPar,strmBaseBig,bigTree)
+            IT(listDirChunkParInterleaved,strmBaseBig,bigTree)
+            IT(listDirChunkParOrdered,strmBaseBig,bigTree)