packages feed

lorentz-0.3.0: test/Test/Lorentz/DeadCode.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | 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 =
      compileLorentzWithOptions @'[()]
        (defaultCompilationOptions { coOptimizerConf = Nothing })
        linstr
      @?= instr
    infixr 0 `compilesTo`

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