content: module TestTranslation
    (
      translationTests
    )
  where
  
  import qualified Data.Foldable as F
  import qualified Data.Map.Strict as Map
  import qualified Data.Sequence as Seq
  import qualified Data.Set as Set
  
  import qualified Test.Tasty as T
  import           Test.Tasty.HUnit ( testCase, (@=?) )
  import           Test.Tasty.QuickCheck ( testProperty )
  
  import           Lang.Crucible.LLVM.Translation.Aliases ( reverseAliases )
  
  
  translationTests :: T.TestTree
  translationTests =
    T.testGroup "Translation"
    [
      T.testGroup "Aliases" $
  
       ------------- Tests for reverseAliases
  
        let evenAlias xs x =
              let s = Set.fromList (F.toList xs)
              in if even x && Set.member x s
                 then Just (x `div` 2)
                 else Nothing
            addTargets xs = xs <> fmap (`div` 2) (Seq.filter even xs)
        in
          [ testCase "reverseAliases: empty" $
              Map.empty @=?
                reverseAliases id (const Nothing) (Seq.empty :: Seq.Seq Int)
  
          , testProperty "reverseAliases: singleton" $ \x ->
              Map.singleton (x :: Int) Set.empty ==
                reverseAliases id (const Nothing) (Seq.singleton x)
  
          , -- The result should not depend on ordering
            testProperty "reverseAliases: reverse" $ \xs ->
              let -- no self-aliasing allowed
                  xs' = addTargets (Seq.filter (/= 0) xs)
              in reverseAliases id (evenAlias xs) (xs' :: Seq.Seq Int) ==
                   reverseAliases id (evenAlias xs) (Seq.reverse xs')
  
          , -- Every item should appear exactly once
            testProperty "reverseAliases: xor" $ \xs ->
              let xs'    = addTargets (Seq.filter (/= 0) xs)
                  result = reverseAliases id (evenAlias xs) (xs' :: Seq.Seq Int)
                  keys   = Map.keysSet result
                  values = Set.unions (Map.elems result)
                  --
                  xor True a = not a
                  xor False a = a
                  --
              in all (\x -> Set.member x keys `xor` Set.member x values) xs'
          ]
  
    ]
  