DeadCode.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- TODO [#549]: remove this pragma
{-# OPTIONS_GHC -Wno-deprecations #-}

-- | Tests checking dead code avoidance in Lorentz.

module Test.Lorentz.DeadCode
  ( test_Test
  ) where


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

import Lorentz qualified as L
import Lorentz.Base
import Lorentz.Run
import Morley.Michelson.Typed (Instr(Seq))
import Morley.Michelson.Typed qualified 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

  , testCase "Never is also \"failing\"" $
      compilesTo'
        ((L.never # L.push @Integer 5) # L.drop)
        T.NEVER
  ]
  where
    compilesTo' :: '[i] :-> s -> Instr '[T.ToT i] (T.ToTs s) -> Assertion
    compilesTo' linstr instr =
      compileLorentzWithOptions
        (defaultCompilationOptions { coOptimizerConf = Nothing })
        linstr
      @?= instr

    compilesTo = compilesTo' @()
    infixr 0 `compilesTo`

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