{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} module Clash.Tests.NFDataX where import Test.Tasty import Test.Tasty.HUnit import GHC.Generics (Generic) import Clash.Class.BitPack (pack) import Clash.Sized.Vector (Vec(..)) import Clash.XException (NFDataX(rnfX, hasUndefined, deepErrorX), errorX, ensureSpine) import Data.Ord (Down (Down)) data Void deriving (Generic, NFDataX) data Unit = Unit deriving (Generic, NFDataX) data Wrapper = Wrapper Int deriving (Generic, NFDataX) data Sum = SumTypeA | SumTypeB deriving (Generic, NFDataX) data BigSum = BS1 | BS2 | BS3 | BS4 | BS5 deriving (Generic, NFDataX) data Product = Product Int Int deriving (Generic, NFDataX) data SP = S Int Int | P Int deriving (Generic, NFDataX) data Rec0 = Rec0 { } deriving (Generic, NFDataX) data Rec1 = Rec1 { a :: Int } deriving (Generic, NFDataX) data Rec2 = Rec2 { b :: Int, c :: Int } deriving (Generic, NFDataX) data ProductRec = ProductRec Rec1 (Unit, Sum) deriving (Generic, NFDataX) sundef :: NFDataX a => a sundef = ensureSpine undef dundef :: NFDataX a => a dundef = deepErrorX "!" undef :: a undef = errorX "!" {-# NOINLINE undef #-} tests :: TestTree tests = testGroup "NFDataX" [ testGroup "GenericRnf" [ testCase "Unit" $ rnfX (undef :: Unit) @?= () , testCase "Wrapper1" $ rnfX (undef :: Wrapper) @?= () , testCase "Wrapper2" $ rnfX (Wrapper undef) @?= () , testCase "Sum" $ rnfX (undef :: Sum) @?= () , testCase "BigSum" $ rnfX (undef :: BigSum) @?= () , testCase "Product1" $ rnfX (undef :: Product) @?= () , testCase "Product2" $ rnfX (Product undef undef :: Product) @?= () , testCase "Product3" $ rnfX (Product 3 undef :: Product) @?= () , testCase "Product4" $ rnfX (Product undef 5 :: Product) @?= () , testCase "SP1" $ rnfX (undef :: SP) @?= () , testCase "SP2" $ rnfX (S undef undef :: SP) @?= () , testCase "SP3" $ rnfX (S 3 undef :: SP) @?= () , testCase "SP3" $ rnfX (S undef 5 :: SP) @?= () , testCase "SP4" $ rnfX (P undef :: SP) @?= () , testCase "Rec0" $ rnfX (undef :: Rec0) @?= () , testCase "Rec1_1" $ rnfX (undef :: Rec1) @?= () , testCase "Rec1_2" $ rnfX (Rec1 undef) @?= () , testCase "Rec2_1" $ rnfX (undef :: Rec2) @?= () , testCase "Rec2_2" $ rnfX (Rec2 3 undef) @?= () , testCase "Rec2_3" $ rnfX (Rec2 undef 5) @?= () , testCase "Void" $ rnfX (undef :: Void) @?= () ] , testGroup "Tuples" [ -- Test Template Haskell generated hasUndefined instance for tuples testCase "HU1" $ hasUndefined (undef :: (Int, Int)) @?= True , testCase "HU3" $ hasUndefined ((undef, undef) :: (Int, Int)) @?= True , testCase "HU2" $ hasUndefined ((undef, 1) :: (Int, Int)) @?= True , testCase "HU4" $ hasUndefined ((1, undef) :: (Int, Int)) @?= True , testCase "HU4" $ hasUndefined ((1, 2) :: (Int, Int)) @?= False , testCase "HU5" $ hasUndefined ((undef, 1) :: (Rec2, Int)) @?= True , testCase "HU6" $ hasUndefined ((Rec2 undef undef, 1) :: (Rec2, Int)) @?= True , testCase "HU7" $ hasUndefined ((Rec2 1 undef, 1) :: (Rec2, Int)) @?= True , testCase "HU8" $ hasUndefined ((Rec2 1 1, 1) :: (Rec2, Int)) @?= False -- Test Template Haskell generated rnfX instance for tuples , testCase "RnfX1" $ rnfX (undef :: (Int, Int)) @?= () , testCase "RnfX3" $ rnfX ((undef, undef) :: (Int, Int)) @?= () , testCase "RnfX2" $ rnfX ((undef, 1) :: (Int, Int)) @?= () , testCase "RnfX4" $ rnfX ((1, undef) :: (Int, Int)) @?= () , testCase "RnfX4" $ rnfX ((1, 2) :: (Int, Int)) @?= () , testCase "RnfX5" $ rnfX ((undef, 1) :: (Rec2, Int)) @?= () , testCase "RnfX6" $ rnfX ((Rec2 undef undef, 1) :: (Rec2, Int)) @?= () , testCase "RnfX7" $ rnfX ((Rec2 1 undef, 1) :: (Rec2, Int)) @?= () , testCase "RnfX8" $ rnfX ((Rec2 1 1, 1) :: (Rec2, Int)) @?= () -- Test Template Haskell generated deepErrorX/ensureSpine instance for tuples , testCase "DU" $ case dundef @(Unit, Unit) of (Unit, Unit) -> () @?= () , testCase "ES1" $ case ensureSpine undef of () -> () @?= () , testCase "ES1" $ case ensureSpine undef of ((), ()) -> () @?= () , testCase "ES2" $ case ensureSpine @(Unit, Unit) undef of (Unit, Unit) -> () @?= () ] , testGroup "ManualRnf" [ testCase "List1" $ rnfX (undef :: [Int]) @?= () , testCase "List2" $ rnfX ([undef] :: [Int]) @?= () , testCase "Maybe1" $ rnfX (undef :: Maybe Int) @?= () , testCase "Maybe2" $ rnfX (Just undef :: Maybe Int) @?= () , testCase "Either1" $ rnfX (undef :: Either Int Int) @?= () , testCase "Either2" $ rnfX (Left undef :: Either Int Int) @?= () , testCase "Either3" $ rnfX (Right undef :: Either Int Int) @?= () , testCase "Down1" $ rnfX (Down undef :: Down Int) @?= () , testCase "Down2" $ rnfX (undef :: Down Int) @?= () ] , testGroup "GenericHasUndefinedTrue" [ testCase "Unit" $ hasUndefined (undef :: Unit) @?= True , testCase "Wrapper1" $ hasUndefined (undef :: Wrapper) @?= True , testCase "Wrapper2" $ hasUndefined (Wrapper undef) @?= True , testCase "Sum" $ hasUndefined (undef :: Sum) @?= True , testCase "BigSum" $ hasUndefined (undef :: BigSum) @?= True , testCase "Product1" $ hasUndefined (undef :: Product) @?= True , testCase "Product2" $ hasUndefined (Product undef undef :: Product) @?= True , testCase "Product3" $ hasUndefined (Product 3 undef :: Product) @?= True , testCase "Product4" $ hasUndefined (Product undef 5 :: Product) @?= True , testCase "SP1" $ hasUndefined (undef :: SP) @?= True , testCase "SP2" $ hasUndefined (S undef undef :: SP) @?= True , testCase "SP3" $ hasUndefined (S 3 undef :: SP) @?= True , testCase "SP3" $ hasUndefined (S undef 5 :: SP) @?= True , testCase "SP4" $ hasUndefined (P undef :: SP) @?= True , testCase "Rec0" $ hasUndefined (undef :: Rec0) @?= True , testCase "Rec1_1" $ hasUndefined (undef :: Rec1) @?= True , testCase "Rec1_2" $ hasUndefined (Rec1 undef) @?= True , testCase "Rec2_1" $ hasUndefined (undef :: Rec2) @?= True , testCase "Rec2_2" $ hasUndefined (Rec2 3 undef) @?= True , testCase "Rec2_3" $ hasUndefined (Rec2 undef 5) @?= True , testCase "Void" $ hasUndefined (undef :: Void) @?= True ] , testGroup "GenericHasUndefinedFalse" [ testCase "Unit" $ hasUndefined () @?= False , testCase "Wrapper" $ hasUndefined (Wrapper 0:: Wrapper) @?= False , testCase "SumA" $ hasUndefined (SumTypeA :: Sum) @?= False , testCase "SumB" $ hasUndefined (SumTypeB :: Sum) @?= False , testCase "BigSum1" $ hasUndefined (BS1 :: BigSum) @?= False , testCase "BigSum2" $ hasUndefined (BS2 :: BigSum) @?= False , testCase "BigSum3" $ hasUndefined (BS3 :: BigSum) @?= False , testCase "BigSum4" $ hasUndefined (BS4 :: BigSum) @?= False , testCase "BigSum5" $ hasUndefined (BS5 :: BigSum) @?= False , testCase "Product" $ hasUndefined (Product 3 5 :: Product) @?= False , testCase "SP1" $ hasUndefined (S 3 5 :: SP) @?= False , testCase "SP2" $ hasUndefined (P 5 :: SP) @?= False , testCase "Rec2_3" $ hasUndefined (Rec2 3 5) @?= False ] , testGroup "ManualHasUndefined" [ testCase "Vec1" $ hasUndefined (3 :> errorX "X" :: Vec 5 Int) @?= True , testCase "Vec2" $ hasUndefined (errorX "X" :: Vec 5 Int) @?= True , testCase "Maybe" $ hasUndefined (Nothing :: Maybe Bool) @?= False , testCase "BitVector1" $ hasUndefined (pack (Nothing :: Maybe Bool)) @?= True , testCase "BitVector2" $ hasUndefined (pack (Just True:: Maybe Bool)) @?= False ] , testGroup "GenericDeepErrorX" [ testCase "Unit" $ case dundef @Unit of Unit -> () @?= () , testCase "Wrapper1" $ case dundef @Wrapper of Wrapper _ -> () @?= () , testCase "Product1" $ case dundef @Product of Product _ _ -> () @?= () , testCase "Rec1_1" $ case dundef @Rec1 of Rec1 {} -> () @?= () , testCase "Rec2_1" $ case dundef @Rec2 of Rec2 {} -> () @?= () , testCase "ProductRec" $ case dundef @ProductRec of ProductRec (Rec1 _) (Unit, _) -> () @?= () ] , testGroup "GenericEnsureSpine" [ testCase "Unit" $ case sundef @Unit of Unit -> () @?= () , testCase "Wrapper1" $ case sundef @Wrapper of Wrapper _ -> () @?= () , testCase "Product1" $ case sundef @Product of Product _ _ -> () @?= () , testCase "Rec1_1" $ case sundef @Rec1 of Rec1 {} -> () @?= () , testCase "Rec2_1" $ case sundef @Rec2 of Rec2 {} -> () @?= () , testCase "ProductRec" $ case sundef @ProductRec of ProductRec (Rec1 _) (Unit, _) -> () @?= () ] ]