Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Test for error thunking in pactestsspec #1050

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Test for error thunking in pactestsspec #1050

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
de639aa
lazyness in pact error test
jmcardon Sep 22, 2022
b327dc5
s/error/undefined
jmcardon Sep 22, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 31 additions & 0 deletions tests/PactTestsSpec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,15 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}

module PactTestsSpec (spec) where


import Test.Hspec

import Control.Lens
import Control.Concurrent
import Control.Monad.State.Strict

import Data.Either (isLeft, isRight)
import Data.List
import Data.Default
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
import Data.Maybe
Expand All @@ -25,12 +29,21 @@ import Pact.Persist.SQLite as SQLite
import Pact.Interpreter
import Pact.Parse (parsePact, legacyParsePact)

import Pact.Gas
import Pact.MockDb
import Pact.Types.Native
import Pact.Types.Type
import Pact.Native.Internal

import System.Directory
import System.FilePath

import Control.DeepSeq
import Control.Exception

spec :: Spec
spec = do
errForceTest
pactTests
badTests
accountsTest
Expand All @@ -39,6 +52,24 @@ spec = do
prodParserTests
legacyProdParserTests

errForceTest :: Spec
errForceTest = do
describe "error force tests" $ runIO $ do
let md = initMsgData pactInitialHash
db <- mkMockEnv def
let refStore = over rsNatives (HM.insert "blah" nNative) initRefStore
env' <- setupEvalEnv db Nothing Transactional md refStore freeGasEnv permissiveNamespacePolicy undefined def def
let expr = either undefined id $ parsePact "(blah)"
interp = defaultInterpreter
pactAction = catchesPactError $ evalExec interp env' expr
(print =<< pactAction) `shouldThrow` anyException
(fmap (set _Left defaultError) pactAction) `shouldReturn` (Left defaultError)
where
defaultError = PactError ArgsError def [] ""
nNative = Direct $ snd $ defZRNative "blah" blahDef (funType TyAny []) [] ""
blahDef :: RNativeFun e
blahDef i as = argsError i ([error "boom!"] ++ as)


pactTests :: Spec
pactTests = do
Expand Down