{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Array.Accelerate.Test.NoFib.Imaginary.SASUM (
test_sasum
) where
import Data.Proxy
import Data.Typeable
import Prelude as P
import Data.Array.Accelerate as A
import Data.Array.Accelerate.Array.Sugar as S
import Data.Array.Accelerate.Test.NoFib.Base
import Data.Array.Accelerate.Test.NoFib.Config
import Data.Array.Accelerate.Test.Similar
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty
import Test.Tasty.Hedgehog
test_sasum :: RunN -> TestTree
test_sasum runN =
testGroup "sasum"
[ at (Proxy::Proxy TestInt8) $ testElt i8
, at (Proxy::Proxy TestInt16) $ testElt i16
, at (Proxy::Proxy TestInt32) $ testElt i32
, at (Proxy::Proxy TestInt64) $ testElt i64
, at (Proxy::Proxy TestWord8) $ testElt w8
, at (Proxy::Proxy TestWord16) $ testElt w16
, at (Proxy::Proxy TestWord32) $ testElt w32
, at (Proxy::Proxy TestWord64) $ testElt w64
, at (Proxy::Proxy TestHalf) $ testElt f16
, at (Proxy::Proxy TestFloat) $ testElt f32
, at (Proxy::Proxy TestDouble) $ testElt f64
]
where
testElt :: forall a. (P.Num a, P.Ord a , A.Num a, A.Ord a , Similar a)
=> Gen a
-> TestTree
testElt e =
testProperty (show (typeOf (undefined :: a))) $ test_sasum' runN e
test_sasum'
:: (P.Num e, A.Num e, Similar e)
=> RunN
-> Gen e
-> Property
test_sasum' runN e =
property $ do
sh <- forAll ((Z:.) <$> Gen.int (Range.linear 0 16384))
xs <- forAll (array sh e)
let !go = runN sasum in go xs S.! Z ~~~ sasumRef xs
sasum :: A.Num e => Acc (Vector e) -> Acc (Scalar e)
sasum = A.fold (+) 0 . A.map abs
sasumRef :: P.Num e => Vector e -> e
sasumRef xs = P.sum [ abs x | x <- toList xs ]