PrimitiveTests.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Futhark.IR.PrimitiveTests
       ( tests
       , arbitraryPrimValOfType
       )
       where

import Control.Applicative

import Test.QuickCheck
import Test.Tasty
import Test.Tasty.HUnit

import Prelude

import Futhark.IR.Primitive

tests :: TestTree
tests = testGroup "PrimitiveTests" propPrimValuesHaveRightType

propPrimValuesHaveRightType :: [TestTree]
propPrimValuesHaveRightType = [ testCase (show t ++ " has blank of right type") $
                                primValueType (blankPrimValue t) @?= t
                              | t <- [minBound..maxBound]
                              ]

instance Arbitrary IntType where
  arbitrary = elements [minBound..maxBound]

instance Arbitrary FloatType where
  arbitrary = elements [minBound..maxBound]

instance Arbitrary PrimType where
  arbitrary = elements [minBound..maxBound]

instance Arbitrary IntValue where
  arbitrary = oneof [ Int8Value <$> arbitrary
                    , Int16Value <$> arbitrary
                    , Int32Value <$> arbitrary
                    , Int64Value <$> arbitrary ]

instance Arbitrary FloatValue where
  arbitrary = oneof [ Float32Value <$> arbitrary
                    , Float64Value <$> arbitrary ]

instance Arbitrary PrimValue where
  arbitrary = oneof [ IntValue <$> arbitrary
                    , FloatValue <$> arbitrary
                    , BoolValue <$> arbitrary
                    , pure Checked
                    ]

arbitraryPrimValOfType :: PrimType -> Gen PrimValue
arbitraryPrimValOfType (IntType Int8) = IntValue . Int8Value <$> arbitrary
arbitraryPrimValOfType (IntType Int16) = IntValue . Int16Value <$> arbitrary
arbitraryPrimValOfType (IntType Int32) = IntValue . Int32Value <$> arbitrary
arbitraryPrimValOfType (IntType Int64) = IntValue . Int64Value <$> arbitrary
arbitraryPrimValOfType (FloatType Float32) = FloatValue . Float32Value <$> arbitrary
arbitraryPrimValOfType (FloatType Float64) = FloatValue . Float32Value <$> arbitrary
arbitraryPrimValOfType Bool = BoolValue <$> arbitrary
arbitraryPrimValOfType Cert = return Checked