DeadCode.hs

{-# LANGUAGE DeriveAnyClass, DerivingStrategies #-}

-- | Tests checking dead code avoidance in Lorentz.

module Test.Lorentz.DeadCode
  ( test_Test
  ) where

import Control.Spoon (spoon)
import Test.HUnit (assertBool, (@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import qualified Lorentz as L
import Lorentz.Base
import Lorentz.Run
import Michelson.Typed (Instr(Seq))
import qualified Michelson.Typed as T

test_Test :: [TestTree]
test_Test =
  [ testCase "Can construct normal instructions" $
      L.push @Integer 5 # L.drop
        `compilesTo` (T.PUSH (T.toVal @Integer 5) `Seq` T.DROP)

  , testCase "Dead code is cut off" $
      (L.unit # L.failWith) # L.drop
        `compilesTo` (T.UNIT `Seq` T.FAILWITH)

  , testCase "Dead code after all failing if branches is cut off" $
      (L.push True # L.if_ L.failWith L.failWith) # L.drop
        `compilesTo` (T.PUSH (T.toVal True) `Seq` T.IF T.FAILWITH T.FAILWITH)

  , testCase "Always failing DIP body is error" $
      L.dip (L.unit # L.failWith)
        & fails
  ]
  where
    compilesTo linstr instr =
      compileLorentz @'[()] linstr @?= instr
    infixr 0 `compilesTo`

    fails instr =
      assertBool "instruction construction didn't fail" . isNothing . spoon $
      compileLorentz instr