{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeApplications #-}
module Test.Tasty.PAPI
(
defaultMain
, Benchmark
, Benchmarkable(..)
, bench
, bgroup
, nf
, whnf
, nfIO
, whnfIO
, benchIngredients
, consoleBenchReporter
, csvReporter
, Counter(..)
) where
import Control.Exception
import Control.Monad
import Control.DeepSeq
import Control.Concurrent.STM
import Data.List (nub, intercalate)
import Data.Proxy
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.Set as Set
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import System.Mem
import System.Exit
import System.IO
import Text.Printf
import Test.Tasty hiding (defaultMain)
import Test.Tasty.Ingredients
import Test.Tasty.Ingredients.ConsoleReporter
import Test.Tasty.Options
import Test.Tasty.Providers
import Test.Tasty.Runners
newtype EventSet = EventSet CInt
deriving (Int -> EventSet -> TestName -> TestName
[EventSet] -> TestName -> TestName
EventSet -> TestName
(Int -> EventSet -> TestName -> TestName)
-> (EventSet -> TestName)
-> ([EventSet] -> TestName -> TestName)
-> Show EventSet
forall a.
(Int -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Int -> EventSet -> TestName -> TestName
showsPrec :: Int -> EventSet -> TestName -> TestName
$cshow :: EventSet -> TestName
show :: EventSet -> TestName
$cshowList :: [EventSet] -> TestName -> TestName
showList :: [EventSet] -> TestName -> TestName
Show, Ptr EventSet -> IO EventSet
Ptr EventSet -> Int -> IO EventSet
Ptr EventSet -> Int -> EventSet -> IO ()
Ptr EventSet -> EventSet -> IO ()
EventSet -> Int
(EventSet -> Int)
-> (EventSet -> Int)
-> (Ptr EventSet -> Int -> IO EventSet)
-> (Ptr EventSet -> Int -> EventSet -> IO ())
-> (forall b. Ptr b -> Int -> IO EventSet)
-> (forall b. Ptr b -> Int -> EventSet -> IO ())
-> (Ptr EventSet -> IO EventSet)
-> (Ptr EventSet -> EventSet -> IO ())
-> Storable EventSet
forall b. Ptr b -> Int -> IO EventSet
forall b. Ptr b -> Int -> EventSet -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: EventSet -> Int
sizeOf :: EventSet -> Int
$calignment :: EventSet -> Int
alignment :: EventSet -> Int
$cpeekElemOff :: Ptr EventSet -> Int -> IO EventSet
peekElemOff :: Ptr EventSet -> Int -> IO EventSet
$cpokeElemOff :: Ptr EventSet -> Int -> EventSet -> IO ()
pokeElemOff :: Ptr EventSet -> Int -> EventSet -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO EventSet
peekByteOff :: forall b. Ptr b -> Int -> IO EventSet
$cpokeByteOff :: forall b. Ptr b -> Int -> EventSet -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> EventSet -> IO ()
$cpeek :: Ptr EventSet -> IO EventSet
peek :: Ptr EventSet -> IO EventSet
$cpoke :: Ptr EventSet -> EventSet -> IO ()
poke :: Ptr EventSet -> EventSet -> IO ()
Storable)
foreign import capi "papi.h value PAPI_OK" papi_OK :: CInt
foreign import capi "papi.h value PAPI_NULL" papi_NULL :: CInt
foreign import capi "papi.h value PAPI_VER_CURRENT" papi_VER_CURRENT :: CInt
foreign import capi "papi.h value PAPI_L1_DCM" papi_L1_DCM :: CInt
foreign import capi "papi.h value PAPI_L1_ICM" papi_L1_ICM :: CInt
foreign import capi "papi.h value PAPI_L2_DCM" papi_L2_DCM :: CInt
foreign import capi "papi.h value PAPI_L2_ICM" papi_L2_ICM :: CInt
foreign import capi "papi.h value PAPI_L3_DCM" papi_L3_DCM :: CInt
foreign import capi "papi.h value PAPI_L3_ICM" papi_L3_ICM :: CInt
foreign import capi "papi.h value PAPI_L1_TCM" papi_L1_TCM :: CInt
foreign import capi "papi.h value PAPI_L2_TCM" papi_L2_TCM :: CInt
foreign import capi "papi.h value PAPI_L3_TCM" papi_L3_TCM :: CInt
foreign import capi "papi.h value PAPI_CA_SNP" papi_CA_SNP :: CInt
foreign import capi "papi.h value PAPI_CA_SHR" papi_CA_SHR :: CInt
foreign import capi "papi.h value PAPI_CA_CLN" papi_CA_CLN :: CInt
foreign import capi "papi.h value PAPI_CA_INV" papi_CA_INV :: CInt
foreign import capi "papi.h value PAPI_CA_ITV" papi_CA_ITV :: CInt
foreign import capi "papi.h value PAPI_L3_LDM" papi_L3_LDM :: CInt
foreign import capi "papi.h value PAPI_L3_STM" papi_L3_STM :: CInt
foreign import capi "papi.h value PAPI_BRU_IDL" papi_BRU_IDL :: CInt
foreign import capi "papi.h value PAPI_FXU_IDL" papi_FXU_IDL :: CInt
foreign import capi "papi.h value PAPI_FPU_IDL" papi_FPU_IDL :: CInt
foreign import capi "papi.h value PAPI_LSU_IDL" papi_LSU_IDL :: CInt
foreign import capi "papi.h value PAPI_TLB_DM" papi_TLB_DM :: CInt
foreign import capi "papi.h value PAPI_TLB_IM" papi_TLB_IM :: CInt
foreign import capi "papi.h value PAPI_TLB_TL" papi_TLB_TL :: CInt
foreign import capi "papi.h value PAPI_L1_LDM" papi_L1_LDM :: CInt
foreign import capi "papi.h value PAPI_L1_STM" papi_L1_STM :: CInt
foreign import capi "papi.h value PAPI_L2_LDM" papi_L2_LDM :: CInt
foreign import capi "papi.h value PAPI_L2_STM" papi_L2_STM :: CInt
foreign import capi "papi.h value PAPI_BTAC_M" papi_BTAC_M :: CInt
foreign import capi "papi.h value PAPI_PRF_DM" papi_PRF_DM :: CInt
foreign import capi "papi.h value PAPI_L3_DCH" papi_L3_DCH :: CInt
foreign import capi "papi.h value PAPI_TLB_SD" papi_TLB_SD :: CInt
foreign import capi "papi.h value PAPI_CSR_FAL" papi_CSR_FAL :: CInt
foreign import capi "papi.h value PAPI_CSR_SUC" papi_CSR_SUC :: CInt
foreign import capi "papi.h value PAPI_CSR_TOT" papi_CSR_TOT :: CInt
foreign import capi "papi.h value PAPI_MEM_SCY" papi_MEM_SCY :: CInt
foreign import capi "papi.h value PAPI_MEM_RCY" papi_MEM_RCY :: CInt
foreign import capi "papi.h value PAPI_MEM_WCY" papi_MEM_WCY :: CInt
foreign import capi "papi.h value PAPI_STL_ICY" papi_STL_ICY :: CInt
foreign import capi "papi.h value PAPI_FUL_ICY" papi_FUL_ICY :: CInt
foreign import capi "papi.h value PAPI_STL_CCY" papi_STL_CCY :: CInt
foreign import capi "papi.h value PAPI_FUL_CCY" papi_FUL_CCY :: CInt
foreign import capi "papi.h value PAPI_HW_INT" papi_HW_INT :: CInt
foreign import capi "papi.h value PAPI_BR_UCN" papi_BR_UCN :: CInt
foreign import capi "papi.h value PAPI_BR_CN" papi_BR_CN :: CInt
foreign import capi "papi.h value PAPI_BR_TKN" papi_BR_TKN :: CInt
foreign import capi "papi.h value PAPI_BR_NTK" papi_BR_NTK :: CInt
foreign import capi "papi.h value PAPI_BR_MSP" papi_BR_MSP :: CInt
foreign import capi "papi.h value PAPI_BR_PRC" papi_BR_PRC :: CInt
foreign import capi "papi.h value PAPI_FMA_INS" papi_FMA_INS :: CInt
foreign import capi "papi.h value PAPI_TOT_IIS" papi_TOT_IIS :: CInt
foreign import capi "papi.h value PAPI_TOT_INS" papi_TOT_INS :: CInt
foreign import capi "papi.h value PAPI_INT_INS" papi_INT_INS :: CInt
foreign import capi "papi.h value PAPI_FP_INS" papi_FP_INS :: CInt
foreign import capi "papi.h value PAPI_LD_INS" papi_LD_INS :: CInt
foreign import capi "papi.h value PAPI_SR_INS" papi_SR_INS :: CInt
foreign import capi "papi.h value PAPI_BR_INS" papi_BR_INS :: CInt
foreign import capi "papi.h value PAPI_VEC_INS" papi_VEC_INS :: CInt
foreign import capi "papi.h value PAPI_RES_STL" papi_RES_STL :: CInt
foreign import capi "papi.h value PAPI_FP_STAL" papi_FP_STAL :: CInt
foreign import capi "papi.h value PAPI_TOT_CYC" papi_TOT_CYC :: CInt
foreign import capi "papi.h value PAPI_LST_INS" papi_LST_INS :: CInt
foreign import capi "papi.h value PAPI_SYC_INS" papi_SYC_INS :: CInt
foreign import capi "papi.h value PAPI_L1_DCH" papi_L1_DCH :: CInt
foreign import capi "papi.h value PAPI_L2_DCH" papi_L2_DCH :: CInt
foreign import capi "papi.h value PAPI_L1_DCA" papi_L1_DCA :: CInt
foreign import capi "papi.h value PAPI_L2_DCA" papi_L2_DCA :: CInt
foreign import capi "papi.h value PAPI_L3_DCA" papi_L3_DCA :: CInt
foreign import capi "papi.h value PAPI_L1_DCR" papi_L1_DCR :: CInt
foreign import capi "papi.h value PAPI_L2_DCR" papi_L2_DCR :: CInt
foreign import capi "papi.h value PAPI_L3_DCR" papi_L3_DCR :: CInt
foreign import capi "papi.h value PAPI_L1_DCW" papi_L1_DCW :: CInt
foreign import capi "papi.h value PAPI_L2_DCW" papi_L2_DCW :: CInt
foreign import capi "papi.h value PAPI_L3_DCW" papi_L3_DCW :: CInt
foreign import capi "papi.h value PAPI_L1_ICH" papi_L1_ICH :: CInt
foreign import capi "papi.h value PAPI_L2_ICH" papi_L2_ICH :: CInt
foreign import capi "papi.h value PAPI_L3_ICH" papi_L3_ICH :: CInt
foreign import capi "papi.h value PAPI_L1_ICA" papi_L1_ICA :: CInt
foreign import capi "papi.h value PAPI_L2_ICA" papi_L2_ICA :: CInt
foreign import capi "papi.h value PAPI_L3_ICA" papi_L3_ICA :: CInt
foreign import capi "papi.h value PAPI_L1_ICR" papi_L1_ICR :: CInt
foreign import capi "papi.h value PAPI_L2_ICR" papi_L2_ICR :: CInt
foreign import capi "papi.h value PAPI_L3_ICR" papi_L3_ICR :: CInt
foreign import capi "papi.h value PAPI_L1_ICW" papi_L1_ICW :: CInt
foreign import capi "papi.h value PAPI_L2_ICW" papi_L2_ICW :: CInt
foreign import capi "papi.h value PAPI_L3_ICW" papi_L3_ICW :: CInt
foreign import capi "papi.h value PAPI_L1_TCH" papi_L1_TCH :: CInt
foreign import capi "papi.h value PAPI_L2_TCH" papi_L2_TCH :: CInt
foreign import capi "papi.h value PAPI_L3_TCH" papi_L3_TCH :: CInt
foreign import capi "papi.h value PAPI_L1_TCA" papi_L1_TCA :: CInt
foreign import capi "papi.h value PAPI_L2_TCA" papi_L2_TCA :: CInt
foreign import capi "papi.h value PAPI_L3_TCA" papi_L3_TCA :: CInt
foreign import capi "papi.h value PAPI_L1_TCR" papi_L1_TCR :: CInt
foreign import capi "papi.h value PAPI_L2_TCR" papi_L2_TCR :: CInt
foreign import capi "papi.h value PAPI_L3_TCR" papi_L3_TCR :: CInt
foreign import capi "papi.h value PAPI_L1_TCW" papi_L1_TCW :: CInt
foreign import capi "papi.h value PAPI_L2_TCW" papi_L2_TCW :: CInt
foreign import capi "papi.h value PAPI_L3_TCW" papi_L3_TCW :: CInt
foreign import capi "papi.h value PAPI_FML_INS" papi_FML_INS :: CInt
foreign import capi "papi.h value PAPI_FAD_INS" papi_FAD_INS :: CInt
foreign import capi "papi.h value PAPI_FDV_INS" papi_FDV_INS :: CInt
foreign import capi "papi.h value PAPI_FSQ_INS" papi_FSQ_INS :: CInt
foreign import capi "papi.h value PAPI_FNV_INS" papi_FNV_INS :: CInt
foreign import capi "papi.h PAPI_library_init"
papi_library_init :: CInt -> IO CInt
foreign import capi unsafe "papi.h PAPI_create_eventset"
papi_create_eventset :: Ptr EventSet -> IO CInt
foreign import capi unsafe "papi.h PAPI_cleanup_eventset"
papi_cleanup_eventset :: EventSet -> IO CInt
foreign import capi unsafe "papi.h PAPI_destroy_eventset"
papi_destroy_eventset :: Ptr EventSet -> IO CInt
foreign import capi unsafe "papi.h PAPI_add_event"
papi_add_event :: EventSet -> CInt -> IO CInt
foreign import capi unsafe "papi.h PAPI_start"
papi_start :: EventSet -> IO CInt
foreign import capi unsafe "papi.h PAPI_stop"
papi_stop :: EventSet -> Ptr CLLong -> IO CInt
foreign import capi unsafe "papi.h PAPI_strerror"
papi_strerror :: CInt -> IO CString
call :: String -> IO CInt -> IO ()
call :: TestName -> IO CInt -> IO ()
call TestName
msg IO CInt
f = IO CInt
f IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CInt
n | CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
papi_OK -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> do
CString
c_str <- CInt -> IO CString
papi_strerror CInt
n
TestName
str <- if | CString
c_str CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr -> TestName -> IO TestName
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"UNKNOWN ERROR"
| Bool
otherwise -> CString -> IO TestName
peekCString CString
c_str
TestName -> IO ()
forall a. HasCallStack => TestName -> a
error (TestName -> IO ()) -> TestName -> IO ()
forall a b. (a -> b) -> a -> b
$ TestName -> TestName -> TestName -> TestName -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"PAPI: %s: %s [%s]" TestName
msg TestName
str (CInt -> TestName
forall a. Show a => a -> TestName
show CInt
n)
withPapiEventSet :: (EventSet -> IO a) -> IO a
withPapiEventSet :: forall a. (EventSet -> IO a) -> IO a
withPapiEventSet EventSet -> IO a
action = do
do CInt
n <- CInt -> IO CInt
papi_library_init CInt
papi_VER_CURRENT
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
papi_VER_CURRENT) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TestName -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"PAPI init failed"
IO EventSet -> (EventSet -> IO ()) -> (EventSet -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO EventSet
ini EventSet -> IO ()
fini EventSet -> IO a
action
where
ini :: IO EventSet
ini = (Ptr EventSet -> IO EventSet) -> IO EventSet
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr EventSet -> IO EventSet) -> IO EventSet)
-> (Ptr EventSet -> IO EventSet) -> IO EventSet
forall a b. (a -> b) -> a -> b
$ \Ptr EventSet
p_evt -> do
Ptr EventSet -> EventSet -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr EventSet
p_evt (CInt -> EventSet
EventSet CInt
papi_NULL)
TestName -> IO CInt -> IO ()
call TestName
"Failed to create eventset" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EventSet -> IO CInt
papi_create_eventset Ptr EventSet
p_evt
Ptr EventSet -> IO EventSet
forall a. Storable a => Ptr a -> IO a
peek Ptr EventSet
p_evt
fini :: EventSet -> IO ()
fini EventSet
evt = do
TestName -> IO CInt -> IO ()
call TestName
"Failed to cleanup eventset" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ EventSet -> IO CInt
papi_cleanup_eventset EventSet
evt
(Ptr EventSet -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr EventSet -> IO ()) -> IO ())
-> (Ptr EventSet -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EventSet
p_evt -> do
Ptr EventSet -> EventSet -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr EventSet
p_evt EventSet
evt
TestName -> IO CInt -> IO ()
call TestName
"Failed to destroy eventset" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EventSet -> IO CInt
papi_destroy_eventset Ptr EventSet
p_evt
data Counter
= L1_DCM
| L1_ICM
| L2_DCM
| L2_ICM
| L3_DCM
| L3_ICM
| L1_TCM
| L2_TCM
| L3_TCM
| CA_SNP
| CA_SHR
| CA_CLN
| CA_INV
| CA_ITV
| L3_LDM
| L3_STM
| BRU_IDL
| FXU_IDL
| FPU_IDL
| LSU_IDL
| TLB_DM
| TLB_IM
| TLB_TL
| L1_LDM
| L1_STM
| L2_LDM
| L2_STM
| BTAC_M
| PRF_DM
| L3_DCH
| TLB_SD
| CSR_FAL
| CSR_SUC
| CSR_TOT
| MEM_SCY
| MEM_RCY
| MEM_WCY
| STL_ICY
| FUL_ICY
| STL_CCY
| FUL_CCY
| HW_INT
| BR_UCN
| BR_CN
| BR_TKN
| BR_NTK
| BR_MSP
| BR_PRC
| FMA_INS
| TOT_IIS
| TOT_INS
| INT_INS
| FP_INS
| LD_INS
| SR_INS
| BR_INS
| VEC_INS
| RES_STL
| FP_STAL
| TOT_CYC
| LST_INS
| SYC_INS
| L1_DCH
| L2_DCH
| L1_DCA
| L2_DCA
| L3_DCA
| L1_DCR
| L2_DCR
| L3_DCR
| L1_DCW
| L2_DCW
| L3_DCW
| L1_ICH
| L2_ICH
| L3_ICH
| L1_ICA
| L2_ICA
| L3_ICA
| L1_ICR
| L2_ICR
| L3_ICR
| L1_ICW
| L2_ICW
| L3_ICW
| L1_TCH
| L2_TCH
| L3_TCH
| L1_TCA
| L2_TCA
| L3_TCA
| L1_TCR
| L2_TCR
| L3_TCR
| L1_TCW
| L2_TCW
| L3_TCW
| FML_INS
| FAD_INS
| FDV_INS
| FSQ_INS
| FNV_INS
deriving (Int -> Counter -> TestName -> TestName
[Counter] -> TestName -> TestName
Counter -> TestName
(Int -> Counter -> TestName -> TestName)
-> (Counter -> TestName)
-> ([Counter] -> TestName -> TestName)
-> Show Counter
forall a.
(Int -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Int -> Counter -> TestName -> TestName
showsPrec :: Int -> Counter -> TestName -> TestName
$cshow :: Counter -> TestName
show :: Counter -> TestName
$cshowList :: [Counter] -> TestName -> TestName
showList :: [Counter] -> TestName -> TestName
Show,ReadPrec [Counter]
ReadPrec Counter
Int -> ReadS Counter
ReadS [Counter]
(Int -> ReadS Counter)
-> ReadS [Counter]
-> ReadPrec Counter
-> ReadPrec [Counter]
-> Read Counter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Counter
readsPrec :: Int -> ReadS Counter
$creadList :: ReadS [Counter]
readList :: ReadS [Counter]
$creadPrec :: ReadPrec Counter
readPrec :: ReadPrec Counter
$creadListPrec :: ReadPrec [Counter]
readListPrec :: ReadPrec [Counter]
Read,Counter -> Counter -> Bool
(Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool) -> Eq Counter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Counter -> Counter -> Bool
== :: Counter -> Counter -> Bool
$c/= :: Counter -> Counter -> Bool
/= :: Counter -> Counter -> Bool
Eq,Eq Counter
Eq Counter
-> (Counter -> Counter -> Ordering)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Bool)
-> (Counter -> Counter -> Counter)
-> (Counter -> Counter -> Counter)
-> Ord Counter
Counter -> Counter -> Bool
Counter -> Counter -> Ordering
Counter -> Counter -> Counter
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Counter -> Counter -> Ordering
compare :: Counter -> Counter -> Ordering
$c< :: Counter -> Counter -> Bool
< :: Counter -> Counter -> Bool
$c<= :: Counter -> Counter -> Bool
<= :: Counter -> Counter -> Bool
$c> :: Counter -> Counter -> Bool
> :: Counter -> Counter -> Bool
$c>= :: Counter -> Counter -> Bool
>= :: Counter -> Counter -> Bool
$cmax :: Counter -> Counter -> Counter
max :: Counter -> Counter -> Counter
$cmin :: Counter -> Counter -> Counter
min :: Counter -> Counter -> Counter
Ord)
toCounter :: Counter -> CInt
toCounter :: Counter -> CInt
toCounter = \case
Counter
L1_DCM -> CInt
papi_L1_DCM
Counter
L1_ICM -> CInt
papi_L1_ICM
Counter
L2_DCM -> CInt
papi_L2_DCM
Counter
L2_ICM -> CInt
papi_L2_ICM
Counter
L3_DCM -> CInt
papi_L3_DCM
Counter
L3_ICM -> CInt
papi_L3_ICM
Counter
L1_TCM -> CInt
papi_L1_TCM
Counter
L2_TCM -> CInt
papi_L2_TCM
Counter
L3_TCM -> CInt
papi_L3_TCM
Counter
CA_SNP -> CInt
papi_CA_SNP
Counter
CA_SHR -> CInt
papi_CA_SHR
Counter
CA_CLN -> CInt
papi_CA_CLN
Counter
CA_INV -> CInt
papi_CA_INV
Counter
CA_ITV -> CInt
papi_CA_ITV
Counter
L3_LDM -> CInt
papi_L3_LDM
Counter
L3_STM -> CInt
papi_L3_STM
Counter
BRU_IDL -> CInt
papi_BRU_IDL
Counter
FXU_IDL -> CInt
papi_FXU_IDL
Counter
FPU_IDL -> CInt
papi_FPU_IDL
Counter
LSU_IDL -> CInt
papi_LSU_IDL
Counter
TLB_DM -> CInt
papi_TLB_DM
Counter
TLB_IM -> CInt
papi_TLB_IM
Counter
TLB_TL -> CInt
papi_TLB_TL
Counter
L1_LDM -> CInt
papi_L1_LDM
Counter
L1_STM -> CInt
papi_L1_STM
Counter
L2_LDM -> CInt
papi_L2_LDM
Counter
L2_STM -> CInt
papi_L2_STM
Counter
BTAC_M -> CInt
papi_BTAC_M
Counter
PRF_DM -> CInt
papi_PRF_DM
Counter
L3_DCH -> CInt
papi_L3_DCH
Counter
TLB_SD -> CInt
papi_TLB_SD
Counter
CSR_FAL -> CInt
papi_CSR_FAL
Counter
CSR_SUC -> CInt
papi_CSR_SUC
Counter
CSR_TOT -> CInt
papi_CSR_TOT
Counter
MEM_SCY -> CInt
papi_MEM_SCY
Counter
MEM_RCY -> CInt
papi_MEM_RCY
Counter
MEM_WCY -> CInt
papi_MEM_WCY
Counter
STL_ICY -> CInt
papi_STL_ICY
Counter
FUL_ICY -> CInt
papi_FUL_ICY
Counter
STL_CCY -> CInt
papi_STL_CCY
Counter
FUL_CCY -> CInt
papi_FUL_CCY
Counter
HW_INT -> CInt
papi_HW_INT
Counter
BR_UCN -> CInt
papi_BR_UCN
Counter
BR_CN -> CInt
papi_BR_CN
Counter
BR_TKN -> CInt
papi_BR_TKN
Counter
BR_NTK -> CInt
papi_BR_NTK
Counter
BR_MSP -> CInt
papi_BR_MSP
Counter
BR_PRC -> CInt
papi_BR_PRC
Counter
FMA_INS -> CInt
papi_FMA_INS
Counter
TOT_IIS -> CInt
papi_TOT_IIS
Counter
TOT_INS -> CInt
papi_TOT_INS
Counter
INT_INS -> CInt
papi_INT_INS
Counter
FP_INS -> CInt
papi_FP_INS
Counter
LD_INS -> CInt
papi_LD_INS
Counter
SR_INS -> CInt
papi_SR_INS
Counter
BR_INS -> CInt
papi_BR_INS
Counter
VEC_INS -> CInt
papi_VEC_INS
Counter
RES_STL -> CInt
papi_RES_STL
Counter
FP_STAL -> CInt
papi_FP_STAL
Counter
TOT_CYC -> CInt
papi_TOT_CYC
Counter
LST_INS -> CInt
papi_LST_INS
Counter
SYC_INS -> CInt
papi_SYC_INS
Counter
L1_DCH -> CInt
papi_L1_DCH
Counter
L2_DCH -> CInt
papi_L2_DCH
Counter
L1_DCA -> CInt
papi_L1_DCA
Counter
L2_DCA -> CInt
papi_L2_DCA
Counter
L3_DCA -> CInt
papi_L3_DCA
Counter
L1_DCR -> CInt
papi_L1_DCR
Counter
L2_DCR -> CInt
papi_L2_DCR
Counter
L3_DCR -> CInt
papi_L3_DCR
Counter
L1_DCW -> CInt
papi_L1_DCW
Counter
L2_DCW -> CInt
papi_L2_DCW
Counter
L3_DCW -> CInt
papi_L3_DCW
Counter
L1_ICH -> CInt
papi_L1_ICH
Counter
L2_ICH -> CInt
papi_L2_ICH
Counter
L3_ICH -> CInt
papi_L3_ICH
Counter
L1_ICA -> CInt
papi_L1_ICA
Counter
L2_ICA -> CInt
papi_L2_ICA
Counter
L3_ICA -> CInt
papi_L3_ICA
Counter
L1_ICR -> CInt
papi_L1_ICR
Counter
L2_ICR -> CInt
papi_L2_ICR
Counter
L3_ICR -> CInt
papi_L3_ICR
Counter
L1_ICW -> CInt
papi_L1_ICW
Counter
L2_ICW -> CInt
papi_L2_ICW
Counter
L3_ICW -> CInt
papi_L3_ICW
Counter
L1_TCH -> CInt
papi_L1_TCH
Counter
L2_TCH -> CInt
papi_L2_TCH
Counter
L3_TCH -> CInt
papi_L3_TCH
Counter
L1_TCA -> CInt
papi_L1_TCA
Counter
L2_TCA -> CInt
papi_L2_TCA
Counter
L3_TCA -> CInt
papi_L3_TCA
Counter
L1_TCR -> CInt
papi_L1_TCR
Counter
L2_TCR -> CInt
papi_L2_TCR
Counter
L3_TCR -> CInt
papi_L3_TCR
Counter
L1_TCW -> CInt
papi_L1_TCW
Counter
L2_TCW -> CInt
papi_L2_TCW
Counter
L3_TCW -> CInt
papi_L3_TCW
Counter
FML_INS -> CInt
papi_FML_INS
Counter
FAD_INS -> CInt
papi_FAD_INS
Counter
FDV_INS -> CInt
papi_FDV_INS
Counter
FSQ_INS -> CInt
papi_FSQ_INS
Counter
FNV_INS -> CInt
papi_FNV_INS
newtype CsvPath = CsvPath FilePath
instance IsOption (Maybe CsvPath) where
defaultValue :: Maybe CsvPath
defaultValue = Maybe CsvPath
forall a. Maybe a
Nothing
parseValue :: TestName -> Maybe (Maybe CsvPath)
parseValue = Maybe CsvPath -> Maybe (Maybe CsvPath)
forall a. a -> Maybe a
Just (Maybe CsvPath -> Maybe (Maybe CsvPath))
-> (TestName -> Maybe CsvPath) -> TestName -> Maybe (Maybe CsvPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvPath -> Maybe CsvPath
forall a. a -> Maybe a
Just (CsvPath -> Maybe CsvPath)
-> (TestName -> CsvPath) -> TestName -> Maybe CsvPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> CsvPath
CsvPath
optionName :: Tagged (Maybe CsvPath) TestName
optionName = TestName -> Tagged (Maybe CsvPath) TestName
forall a. a -> Tagged (Maybe CsvPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"csv"
optionHelp :: Tagged (Maybe CsvPath) TestName
optionHelp = TestName -> Tagged (Maybe CsvPath) TestName
forall a. a -> Tagged (Maybe CsvPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"File to write results in CSV format"
newtype CounterSet = CounterSet { CounterSet -> [Counter]
getCounterSet :: [Counter] }
instance IsOption CounterSet where
defaultValue :: CounterSet
defaultValue = [Counter] -> CounterSet
CounterSet [Counter
TOT_INS, Counter
TOT_CYC, Counter
BR_INS, Counter
BR_MSP]
optionName :: Tagged CounterSet TestName
optionName = TestName -> Tagged CounterSet TestName
forall a. a -> Tagged CounterSet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"counters"
optionHelp :: Tagged CounterSet TestName
optionHelp = TestName -> Tagged CounterSet TestName
forall a. a -> Tagged CounterSet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestName
"Adjust set of counters to use"
parseValue :: TestName -> Maybe CounterSet
parseValue = \case
(Char
'=':TestName
s) -> [Counter] -> CounterSet
CounterSet ([Counter] -> CounterSet) -> Maybe [Counter] -> Maybe CounterSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> Maybe [Counter]
forall {a}. Read a => TestName -> Maybe [a]
parser TestName
s
TestName
s -> [Counter] -> CounterSet
CounterSet ([Counter] -> CounterSet)
-> ([Counter] -> [Counter]) -> [Counter] -> CounterSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Counter] -> [Counter]
forall a. Eq a => [a] -> [a]
nub ([Counter] -> [Counter])
-> ([Counter] -> [Counter]) -> [Counter] -> [Counter]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Counter]
def[Counter] -> [Counter] -> [Counter]
forall a. [a] -> [a] -> [a]
++) ([Counter] -> CounterSet) -> Maybe [Counter] -> Maybe CounterSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> Maybe [Counter]
forall {a}. Read a => TestName -> Maybe [a]
parser TestName
s
where
CounterSet [Counter]
def = CounterSet
forall v. IsOption v => v
defaultValue
parser :: TestName -> Maybe [a]
parser TestName
s = case ReadS a
forall a. Read a => ReadS a
reads TestName
s of
[(a
c,TestName
"")] -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a
c]
[(a
c,Char
',':TestName
s')] -> (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> Maybe [a]
parser TestName
s'
[(a, TestName)]
_ -> Maybe [a]
forall a. Maybe a
Nothing
type Benchmark = TestTree
newtype Benchmarkable = Benchmarkable (IO ())
instance IsTest Benchmarkable where
testOptions :: Tagged Benchmarkable [OptionDescription]
testOptions = [OptionDescription] -> Tagged Benchmarkable [OptionDescription]
forall a. a -> Tagged Benchmarkable a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
run :: OptionSet -> Benchmarkable -> (Progress -> IO ()) -> IO Result
run OptionSet
opts (Benchmarkable IO ()
io) Progress -> IO ()
_
| Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n_threads = do
(EventSet -> IO Result) -> IO Result
forall a. (EventSet -> IO a) -> IO a
withPapiEventSet ((EventSet -> IO Result) -> IO Result)
-> (EventSet -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \EventSet
evt -> do
[Counter] -> (Counter -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Counter]
counters ((Counter -> IO ()) -> IO ()) -> (Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Counter
c -> do
TestName -> IO CInt -> IO ()
call (TestName
"Failed to add counter " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Counter -> TestName
forall a. Show a => a -> TestName
show Counter
c) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ EventSet -> CInt -> IO CInt
papi_add_event EventSet
evt (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Counter -> CInt
toCounter Counter
c
Int -> (Ptr CLLong -> IO Result) -> IO Result
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray ([Counter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Counter]
counters) ((Ptr CLLong -> IO Result) -> IO Result)
-> (Ptr CLLong -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \Ptr CLLong
vals -> do
IO ()
io
IO ()
performMajorGC
Int64
n1 <- IO Int64
getAllocationCounter
TestName -> IO CInt -> IO ()
call TestName
"Failed to start measurements" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ EventSet -> IO CInt
papi_start EventSet
evt
IO ()
io
TestName -> IO CInt -> IO ()
call TestName
"Failed to stop measurements" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ EventSet -> Ptr CLLong -> IO CInt
papi_stop EventSet
evt Ptr CLLong
vals
Int64
n2 <- IO Int64
getAllocationCounter
let n_alloc :: CLLong
n_alloc = Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> CLLong) -> Int64 -> CLLong
forall a b. (a -> b) -> a -> b
$ Int64
n1Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
n2
[CLLong]
measurements <- ((Int, Counter) -> IO CLLong) -> [(Int, Counter)] -> IO [CLLong]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ptr CLLong -> Int -> IO CLLong
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CLLong
vals (Int -> IO CLLong)
-> ((Int, Counter) -> Int) -> (Int, Counter) -> IO CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Counter) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Counter)] -> IO [CLLong])
-> [(Int, Counter)] -> IO [CLLong]
forall a b. (a -> b) -> a -> b
$ [Int
0..] [Int] -> [Counter] -> [(Int, Counter)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Counter]
counters
Result -> IO Result
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TestName -> Result
testPassed
(TestName -> Result) -> TestName -> Result
forall a b. (a -> b) -> a -> b
$ [CLLong] -> TestName
forall a. Show a => a -> TestName
show (CLLong
n_allocCLLong -> [CLLong] -> [CLLong]
forall a. a -> [a] -> [a]
:[CLLong]
measurements)
TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"\t"
( (TestName
"ALLOC="TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++CLLong -> TestName
showN CLLong
n_alloc)
TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: [ Counter -> TestName
forall a. Show a => a -> TestName
show Counter
c TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ (Char
'='Char -> TestName -> TestName
forall a. a -> [a] -> [a]
:CLLong -> TestName
showN CLLong
n)
| (Counter
c,CLLong
n) <- [Counter] -> [CLLong] -> [(Counter, CLLong)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Counter]
counters [CLLong]
measurements])
| Bool
otherwise = Result -> IO Result
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TestName -> Result
testFailed
TestName
"Benchmarks must not be run concurrently. Please pass -j1 or use single threaded runtime."
where
n_threads :: Int
n_threads = NumThreads -> Int
getNumThreads (NumThreads -> Int) -> NumThreads -> Int
forall a b. (a -> b) -> a -> b
$ OptionSet -> NumThreads
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
counters :: [Counter]
counters = CounterSet -> [Counter]
getCounterSet (CounterSet -> [Counter]) -> CounterSet -> [Counter]
forall a b. (a -> b) -> a -> b
$ OptionSet -> CounterSet
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
showN :: CLLong -> String
showN :: CLLong -> TestName
showN CLLong
n
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e4 = CLLong -> TestName
forall a. Show a => a -> TestName
show CLLong
n
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e5 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.2fe3" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e3)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e6 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.1fe3" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e3)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e7 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.3fe6" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e6)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e8 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.2fe6" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e6)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e9 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.1fe6" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e6)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e10 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.3fe9" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e9)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e11 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.2fe9" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e9)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e12 = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.1fe9" (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1e9)
| Bool
otherwise = TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.3e" Double
x
where x :: Double
x = CLLong -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
n :: Double
bench :: String -> Benchmarkable -> TestTree
bench :: TestName -> Benchmarkable -> TestTree
bench = TestName -> Benchmarkable -> TestTree
forall t. IsTest t => TestName -> t -> TestTree
singleTest
bgroup :: String -> [Benchmark] -> Benchmark
bgroup :: TestName -> [TestTree] -> TestTree
bgroup = TestName -> [TestTree] -> TestTree
testGroup
nf :: NFData b => (a -> b) -> a -> Benchmarkable
{-# NOINLINE nf #-}
nf :: forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf a -> b
f a
a = IO () -> Benchmarkable
Benchmarkable (IO () -> Benchmarkable) -> IO () -> Benchmarkable
forall a b. (a -> b) -> a -> b
$ do b
_ <- b -> IO b
forall a. a -> IO a
evaluate (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ b -> b
forall a. NFData a => a -> a
force (a -> b
f a
a)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whnf :: (a -> b) -> a -> Benchmarkable
{-# NOINLINE whnf #-}
whnf :: forall a b. (a -> b) -> a -> Benchmarkable
whnf a -> b
f a
a = IO () -> Benchmarkable
Benchmarkable (IO () -> Benchmarkable) -> IO () -> Benchmarkable
forall a b. (a -> b) -> a -> b
$ do b
_ <- b -> IO b
forall a. a -> IO a
evaluate (a -> b
f a
a)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whnfIO :: IO a -> Benchmarkable
{-# NOINLINE whnfIO #-}
whnfIO :: forall a. IO a -> Benchmarkable
whnfIO IO a
io = IO () -> Benchmarkable
Benchmarkable (IO () -> Benchmarkable) -> IO () -> Benchmarkable
forall a b. (a -> b) -> a -> b
$ do a
_ <- a -> IO a
forall a. a -> IO a
evaluate (a -> IO a) -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
io
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nfIO :: NFData a => IO a -> Benchmarkable
{-# NOINLINE nfIO #-}
nfIO :: forall a. NFData a => IO a -> Benchmarkable
nfIO IO a
io = IO () -> Benchmarkable
Benchmarkable (IO () -> Benchmarkable) -> IO () -> Benchmarkable
forall a b. (a -> b) -> a -> b
$ do a
a <- IO a
io
a
_ <- a -> IO a
forall a. a -> IO a
evaluate (a -> a
forall a. NFData a => a -> a
force a
a)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defaultMain :: [TestTree] -> IO ()
defaultMain :: [TestTree] -> IO ()
defaultMain
= [Ingredient] -> TestTree -> IO ()
defaultMainWithIngredients [Ingredient]
benchIngredients
(TestTree -> IO ())
-> ([TestTree] -> TestTree) -> [TestTree] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestTree] -> TestTree
testGroup TestName
"All"
benchIngredients :: [Ingredient]
benchIngredients :: [Ingredient]
benchIngredients =
[ Ingredient
listingTests
, Ingredient
consoleBenchReporter Ingredient -> Ingredient -> Ingredient
`composeReporters` Ingredient
csvReporter
]
consoleBenchReporter :: Ingredient
consoleBenchReporter :: Ingredient
consoleBenchReporter = ([TestName] -> Result -> IO Result) -> Ingredient
consoleTestReporterWithHook (([TestName] -> Result -> IO Result) -> Ingredient)
-> ([TestName] -> Result -> IO Result) -> Ingredient
forall a b. (a -> b) -> a -> b
$ \[TestName]
_ Result
r -> do
case forall a. Read a => ReadS a
reads @[CLLong] ReadS [CLLong] -> ReadS [CLLong]
forall a b. (a -> b) -> a -> b
$ Result -> TestName
resultDescription Result
r of
[([CLLong]
_,TestName
s)] -> Result -> IO Result
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r { resultDescription :: TestName
resultDescription = TestName
s }
[([CLLong], TestName)]
_ -> Result -> IO Result
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r
csvReporter :: Ingredient
csvReporter :: Ingredient
csvReporter = [OptionDescription]
-> (OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter [Proxy (Maybe CsvPath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Maybe CsvPath)), Proxy CounterSet -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @CounterSet)] ((OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient)
-> (OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$
\OptionSet
opts TestTree
tree -> do
CsvPath TestName
path <- OptionSet -> Maybe CsvPath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
let CounterSet [Counter]
counters = OptionSet -> CounterSet
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
let names :: [TestName]
names = OptionSet -> TestTree -> [TestName]
testsNames OptionSet
opts TestTree
tree
namesMap :: IntMap TestName
namesMap = [(Int, TestName)] -> IntMap TestName
forall a. [(Int, a)] -> IntMap a
IM.fromDistinctAscList ([(Int, TestName)] -> IntMap TestName)
-> [(Int, TestName)] -> IntMap TestName
forall a b. (a -> b) -> a -> b
$ [Int] -> [TestName] -> [(Int, TestName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [TestName]
names
(StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
case [TestName] -> Maybe TestName
forall a. Ord a => [a] -> Maybe a
findNonUniqueElement [TestName]
names of
Maybe TestName
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just TestName
name -> TestName -> IO ()
forall a. TestName -> IO a
die (TestName -> IO ()) -> TestName -> IO ()
forall a b. (a -> b) -> a -> b
$ TestName
"CSV report cannot proceed, because name '" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
name
TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"' corresponds to two or more benchmarks. Please disambiguate them."
TestName -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. TestName -> IOMode -> (Handle -> IO r) -> IO r
withFile TestName
path IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
Handle -> TestName -> IO ()
hPutStrLn Handle
h (TestName -> IO ()) -> TestName -> IO ()
forall a b. (a -> b) -> a -> b
$ TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"," ([TestName] -> TestName) -> [TestName] -> TestName
forall a b. (a -> b) -> a -> b
$ TestName
"benchmark" TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: TestName
"ALLOC" TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: (Counter -> TestName
forall a. Show a => a -> TestName
show (Counter -> TestName) -> [Counter] -> [TestName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Counter]
counters)
Handle -> IntMap (TestName, TVar Status) -> IO ()
csvOutput Handle
h (IntMap (TestName, TVar Status) -> IO ())
-> IntMap (TestName, TVar Status) -> IO ()
forall a b. (a -> b) -> a -> b
$ (TestName -> TVar Status -> (TestName, TVar Status))
-> IntMap TestName -> StatusMap -> IntMap (TestName, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap TestName
namesMap StatusMap
smap
(Double -> IO Bool) -> IO (Double -> IO Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> IO Bool) -> IO (Double -> IO Bool))
-> (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a b. (a -> b) -> a -> b
$ \Double
_ -> StatusMap -> IO Bool
isSuccessful StatusMap
smap
isSuccessful :: StatusMap -> IO Bool
isSuccessful :: StatusMap -> IO Bool
isSuccessful = [TVar Status] -> IO Bool
go ([TVar Status] -> IO Bool)
-> (StatusMap -> [TVar Status]) -> StatusMap -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusMap -> [TVar Status]
forall a. IntMap a -> [a]
IM.elems
where
go :: [TVar Status] -> IO Bool
go [] = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
go (TVar Status
tv : [TVar Status]
tvs) = do
Bool
b <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Bool) -> STM Bool
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> Bool
resultSuccessful Result
r); Status
_ -> STM Bool
forall a. STM a
retry
if Bool
b then [TVar Status] -> IO Bool
go [TVar Status]
tvs else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
findNonUniqueElement :: Ord a => [a] -> Maybe a
findNonUniqueElement :: forall a. Ord a => [a] -> Maybe a
findNonUniqueElement = Set a -> [a] -> Maybe a
forall {a}. Ord a => Set a -> [a] -> Maybe a
go Set a
forall a. Monoid a => a
mempty
where
go :: Set a -> [a] -> Maybe a
go Set a
_ [] = Maybe a
forall a. Maybe a
Nothing
go Set a
acc (a
x : [a]
xs)
| a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
acc = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Set a -> [a] -> Maybe a
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
acc) [a]
xs
csvOutput :: Handle -> IM.IntMap (TestName, TVar Status) -> IO ()
csvOutput :: Handle -> IntMap (TestName, TVar Status) -> IO ()
csvOutput Handle
h = ((TestName, TVar Status) -> IO ())
-> IntMap (TestName, TVar Status) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((TestName, TVar Status) -> IO ())
-> IntMap (TestName, TVar Status) -> IO ())
-> ((TestName, TVar Status) -> IO ())
-> IntMap (TestName, TVar Status)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(TestName
name, TVar Status
tv) -> do
Result
r <- STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Result) -> STM Result
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Done Result
r -> Result -> STM Result
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r
Status
_ -> STM Result
forall a. STM a
retry
case forall a. Read a => ReadS a
reads @[CLLong] ReadS [CLLong] -> ReadS [CLLong]
forall a b. (a -> b) -> a -> b
$ Result -> TestName
resultDescription Result
r of
[([CLLong]
meas,TestName
_)] -> Handle -> TestName -> IO ()
hPutStrLn Handle
h (TestName -> IO ()) -> TestName -> IO ()
forall a b. (a -> b) -> a -> b
$ TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"," ([TestName] -> TestName) -> [TestName] -> TestName
forall a b. (a -> b) -> a -> b
$ TestName -> TestName
encodeCsv TestName
name TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: (CLLong -> TestName
forall a. Show a => a -> TestName
show (CLLong -> TestName) -> [CLLong] -> [TestName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CLLong]
meas)
[([CLLong], TestName)]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
encodeCsv :: String -> String
encodeCsv :: TestName -> TestName
encodeCsv TestName
xs
| (Char -> Bool) -> TestName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> TestName -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TestName
xs) TestName
",\"\n\r" = Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName -> TestName
go TestName
xs
| Bool
otherwise = TestName
xs
where
go :: TestName -> TestName
go [] = Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: []
go (Char
'"' : TestName
ys) = Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName -> TestName
go TestName
ys
go (Char
y : TestName
ys) = Char
y Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName -> TestName
go TestName
ys