Skip to content

Use tasty-bench package itself #181

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
May 26, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions .github/workflows/test.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,7 @@ jobs:
cabal update
cabal build --enable-tests --enable-benchmarks
cabal test
cabal bench
cabal haddock
cabal check
cabal sdist
Expand Down Expand Up @@ -82,6 +83,7 @@ jobs:
. ~/.ghcup/env
cabal update
cabal test
cabal bench

# We use github.com/haskell self-hosted runners for ARM testing.
# If they become unavailable in future, put ['armv7', 'aarch64']
Expand All @@ -105,13 +107,13 @@ jobs:
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
name: Run build (arm32v7 linux)
with:
args: sh -c "cabal update && ghcup install ghc --isolate=/usr --force 9.2.2 && cabal test -w ghc-9.2.2"
args: sh -c "cabal update && ghcup install ghc --isolate=/usr --force 9.2.2 && cabal test -w ghc-9.2.2 && cabal bench -w ghc-9.2.2"

- if: matrix.arch == 'arm64v8'
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
name: Run build (arm64v8 linux)
with:
args: sh -c "cabal update && ghcup install ghc --isolate=/usr --force 9.2.2 && cabal test -w ghc-9.2.2"
args: sh -c "cabal update && ghcup install ghc --isolate=/usr --force 9.2.2 && cabal test -w ghc-9.2.2 && cabal bench -w ghc-9.2.2"

darwin_arm:
runs-on: ${{ matrix.os }}
Expand Down Expand Up @@ -143,5 +145,6 @@ jobs:
. .github/scripts/env.sh
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 BOOTSTRAP_HASKELL_GHC_VERSION=${{ matrix.ghc }} BOOTSTRAP_HASKELL_ADJUST_BASHRC=yes sh
cabal test
cabal bench
env:
HOMEBREW_CHANGE_ARCH_TO_ARM: 1
76 changes: 5 additions & 71 deletions bench/BenchFilePath.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,10 @@ module Main where

import System.OsPath.Types
import System.OsPath.Encoding ( ucs2le )
import System.Environment
import qualified System.OsString.Internal.Types as OST
import qualified Data.ByteString.Short as SBS

import TastyBench
import Data.List
import Data.Maybe
import GHC.IO.Encoding
import Test.Tasty.Bench

import qualified System.FilePath.Posix as PF
import qualified System.FilePath.Posix as WF
Expand All @@ -22,45 +18,9 @@ import qualified System.OsString.Windows as WSP
import qualified System.OsPath.Posix as APF
import qualified System.OsPath.Windows as AWF


data Config = Config {
format :: Format
, stdev :: Double
, timeout :: Integer
}

data Format = Print
| CSV
deriving (Read, Show)

defaultConfig :: Config
defaultConfig = Config defaultFormat defaultStdev defaultTimeout

defaultFormat :: Format
defaultFormat = Print

defaultStdev :: Double
defaultStdev = 0.02

defaultTimeout :: Integer
defaultTimeout = 800000

parseConfig :: [String] -> Config
parseConfig [] = defaultConfig
parseConfig xs =
let format' = maybe defaultFormat (read . fromJust . stripPrefix "--format=" ) $ find ("--format=" `isPrefixOf`) xs
stdev' = maybe defaultStdev (read . fromJust . stripPrefix "--stdev=" ) $ find ("--stdev=" `isPrefixOf`) xs
timeout' = maybe defaultTimeout (read . fromJust . stripPrefix "--timeout=") $ find ("--timeout=" `isPrefixOf`) xs
in Config format' stdev' timeout'


main :: IO ()
main = do
setLocaleEncoding utf8
args <- getArgs
let config = parseConfig args
benchGroup config
[ ("filepath (string)",
main = defaultMain
[ bgroup "filepath (string)" $ map (uncurry bench)
[("splitExtension (posix)" , nf PF.splitExtension posixPath)
,("splitExtension (windows)" , nf WF.splitExtension windowsPath)
,("takeExtension (posix)" , nf PF.takeExtension posixPath)
Expand Down Expand Up @@ -149,9 +109,8 @@ main = do
,("splitSearchPath (posix)" , nf PF.splitSearchPath posixSearchPath)
,("splitSearchPath (windows)" , nf WF.splitSearchPath windowsSearchPath)
]
)

, ("filepath (AFPP)",
, bgroup "filepath (AFPP)" $ map (uncurry bench)
[ ("splitExtension (posix)" , nf APF.splitExtension posixPathAFPP)
, ("splitExtension (windows)" , nf AWF.splitExtension windowsPathAFPP)
, ("takeExtension (posix)" , nf APF.takeExtension posixPathAFPP)
Expand Down Expand Up @@ -240,9 +199,8 @@ main = do
, ("splitSearchPath (posix)" , nf APF.splitSearchPath posixSearchPathAFPP)
, ("splitSearchPath (windows)" , nf AWF.splitSearchPath windowsSearchPathAFPP)
]
)

, ("encoding/decoding",
, bgroup "encoding/decoding" $ map (uncurry bench)
[ ("decodeUtf (posix)" , nf (APF.decodeUtf @Maybe) posixPathAFPP)
, ("decodeUtf (windows)" , nf (AWF.decodeUtf @Maybe) windowsPathAFPP)
, ("decodeWith (windows)" , nf (AWF.decodeWith ucs2le) windowsPathAFPP)
Expand All @@ -259,7 +217,6 @@ main = do
, ("fromBytes (posix)" , nf (OSP.fromBytes @Maybe) (SBS.fromShort . OST.getPosixString $ posixPathAFPP))
, ("fromBytes (windows)" , nf (WSP.fromBytes @Maybe) (SBS.fromShort . OST.getWindowsString $ windowsPathAFPP))
]
)
]


Expand All @@ -286,26 +243,3 @@ posixSearchPathAFPP = [OSP.pstr|:foo:bar:bath:baz:baz:tz:fooooooooooooooo:laaaaa

windowsSearchPathAFPP :: WindowsString
windowsSearchPathAFPP = [WSP.pstr|foo;bar;bath;baz;baz;tz;fooooooooooooooo;laaaaaaaaaaaaaaa;baaaaaaaaaaaaar;zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz;zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz;kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk;kkkkkkkkkkkkkkkkkk;h;h;h;a;s;r;a;h;gt;r;r;r;s;s.txt|]


benchGroup :: Config -> [(String, [(String, Benchmarkable)])] -> IO ()
benchGroup _ [] = pure ()
benchGroup format ((name, benchs):xs) = do
putStrLn name
bench format benchs
benchGroup format xs

bench :: Config -> [(String, Benchmarkable)] -> IO ()
bench _ [] = pure ()
bench config@Config{..} (x:xs) = do
let (name, benchmarkable) = x
case format of
CSV -> putStr (name ++ ",")
Print -> putStr (" " ++ name ++ ": ")
est <- measureUntil CpuTime False (Timeout timeout "") (RelStDev stdev) benchmarkable
case format of
CSV -> putStr $ csvEstimate est
Print -> putStr $ "\n " ++ prettyEstimate est
putStr "\n"
bench config xs

Loading