diff --git a/CODEOWNERS b/CODEOWNERS index 3307338be..579c49c29 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -1,43 +1,43 @@ -* @jwiegley @emilypi -/src-ghc/Pact/ApiReq.hs @sirlensalot -/src-ghc/Pact/Bench.hs @sirlensalot -/src-ghc/Pact/Coverage.hs @sirlensalot -/src-ghc/Pact/Coverage/Report.hs @sirlensalot -/src-ghc/Pact/Interpreter.hs @sirlensalot -/src/Crypto/Hash/Blake2Native.hs @sirlensalot -/src/Pact/Compile.hs @sirlensalot -/src/Pact/Eval.hs @sirlensalot -/src/Pact/Gas.hs @sirlensalot -/src/Pact/Native.hs @sirlensalot -/src/Pact/Native/Capabilities.hs @sirlensalot -/src/Pact/Native/Db.hs @sirlensalot -/src/Pact/Native/Ops.hs @jmcardon -/src/Pact/Parse.hs @sirlensalot -/src/Pact/Persist.hs @sirlensalot -/src/Pact/PersistPactDb.hs @sirlensalot -/src/Pact/Repl.hs @sirlensalot -/src/Pact/Repl/Lib.hs @sirlensalot -/src/Pact/Repl/Types.hs @sirlensalot -/src/Pact/Runtime/Capabilities.hs @sirlensalot -/src/Pact/Runtime/Typecheck.hs @sirlensalot -/src/Pact/Typechecker.hs @sirlensalot -/src/Pact/Types/API.hs @sirlensalot -/src/Pact/Types/Advice.hs @sirlensalot -/src/Pact/Types/Capability.hs @sirlensalot -/src/Pact/Types/Codec.hs @sirlensalot -/src/Pact/Types/Command.hs @sirlensalot -/src/Pact/Types/Continuation.hs @sirlensalot -/src/Pact/Types/Exp.hs @sirlensalot -/src/Pact/Types/Hash.hs @sirlensalot -/src/Pact/Types/Info.hs @sirlensalot -/src/Pact/Types/KeySet.hs @sirlensalot -/src/Pact/Types/PactError.hs @sirlensalot -/src/Pact/Types/PactValue.hs @sirlensalot -/src/Pact/Types/Parser.hs @sirlensalot -/src/Pact/Types/Persistence.hs @sirlensalot -/src/Pact/Types/Purity.hs @sirlensalot -/src/Pact/Types/RPC.hs @sirlensalot -/src/Pact/Types/Runtime.hs @sirlensalot -/src/Pact/Types/Term.hs @sirlensalot -/src/Pact/Types/Type.hs @sirlensalot -/src/Pact/Types/Typecheck.hs @sirlensalot \ No newline at end of file +* @jwiegley @emilypi @jmcardon +/src-ghc/Pact/ApiReq.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Bench.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Coverage.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Coverage/Report.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Interpreter.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Crypto/Hash/Blake2Native.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Compile.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Eval.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Gas.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native/Capabilities.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native/Db.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native/Ops.hs @jmcardon @jwiegley @emilypi @jmcardon +/src/Pact/Parse.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Persist.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/PersistPactDb.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Repl.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Repl/Lib.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Repl/Types.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Runtime/Capabilities.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Runtime/Typecheck.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Typechecker.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/API.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Advice.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Capability.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Codec.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Command.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Continuation.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Exp.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Hash.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Info.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/KeySet.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/PactError.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/PactValue.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Parser.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Persistence.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Purity.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/RPC.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Runtime.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Term.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Type.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Typecheck.hs @sirlensalot @jwiegley @emilypi @jmcardon diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index b81765e68..67fa0da0c 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -1928,7 +1928,7 @@ Retreive any accumulated events and optionally clear event state. Object returne *→* `[string]` -Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"] +Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"] ```lisp pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config) ["DisableHistoryInTransactionalMode"] @@ -2022,7 +2022,7 @@ pact> (env-hash (hash "hello")) *keys* `[string]` *→* `string` -DEPRECATED in favor of 'set-sigs'. Set transaction signer KEYS. See 'env-sigs' for setting keys with associated capabilities. +DEPRECATED in favor of 'env-sigs'. Set transaction signer KEYS. See 'env-sigs' for setting keys with associated capabilities. ```lisp pact> (env-keys ["my-key" "admin-key"]) "Setting transaction keys" diff --git a/docs/en/pact-functions.rst b/docs/en/pact-functions.rst index 621e24a09..c4288a725 100644 --- a/docs/en/pact-functions.rst +++ b/docs/en/pact-functions.rst @@ -2319,7 +2319,7 @@ env-keys *keys* ``[string]`` *→* ``string`` -DEPRECATED in favor of ‘set-sigs’. Set transaction signer KEYS. See +DEPRECATED in favor of ‘env-sigs’. Set transaction signer KEYS. See ‘env-sigs’ for setting keys with associated capabilities. .. code:: lisp diff --git a/docs/en/pact-reference.md b/docs/en/pact-reference.md index fcc86918c..3f8ea851d 100644 --- a/docs/en/pact-reference.md +++ b/docs/en/pact-reference.md @@ -923,10 +923,10 @@ new `env-sigs` REPL function as follows: ... ) -(set-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) +(env-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) (accounts.pay "alice" "bob" 10.0) ;; works as the cap match the signature caps -(set-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) +(env-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) (expect-failure "payment to bob will no longer be able to enforce alice's keyset" (accounts.pay "alice" "bob" 10.0)) ``` diff --git a/docs/en/pact-reference.rst b/docs/en/pact-reference.rst index c357ca858..2ae0c65c2 100644 --- a/docs/en/pact-reference.rst +++ b/docs/en/pact-reference.rst @@ -1189,10 +1189,10 @@ as follows: ... ) - (set-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) + (env-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) (accounts.pay "alice" "bob" 10.0) ;; works as the cap match the signature caps - (set-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) + (env-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) (expect-failure "payment to bob will no longer be able to enforce alice's keyset" (accounts.pay "alice" "bob" 10.0)) diff --git a/pact.cabal b/pact.cabal index 4afcbf3c0..9d2eff49b 100644 --- a/pact.cabal +++ b/pact.cabal @@ -50,7 +50,7 @@ flag tests-in-lib -- Pact library library - cpp-options: -DLEGACY_PARSER -DPACT_TOJSON + cpp-options: -DLEGACY_PARSER -- common to all configurations: hs-source-dirs: src default-language: Haskell2010 @@ -397,7 +397,7 @@ test-suite hspec hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints - cpp-options: -DLEGACY_PARSER -DDELTA_BYTES=1 -DPACT_TOJSON + cpp-options: -DLEGACY_PARSER -DDELTA_BYTES=1 build-tool-depends: pact:pact build-depends: , aeson diff --git a/src-ghc/Pact/ApiReq.hs b/src-ghc/Pact/ApiReq.hs index 2640396b0..4bcbe4ac2 100644 --- a/src-ghc/Pact/ApiReq.hs +++ b/src-ghc/Pact/ApiReq.hs @@ -171,7 +171,7 @@ instance J.Encode ApiPublicMeta where , "gasPrice" J..?= _apmGasPrice o , "sender" J..?= _apmSender o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance Arbitrary ApiPublicMeta where arbitrary = ApiPublicMeta @@ -217,7 +217,7 @@ instance J.Encode ApiReq where , "dataFile" J..= fmap (J.text . pack) (_ylDataFile o) , "nonce" J..= _ylNonce o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance Arbitrary ApiReq where arbitrary = scale (min 5) $ ApiReq @@ -248,7 +248,7 @@ instance J.Encode AddSigsReq where [ "sigs" J..= J.Array (_asrSigs o) , "unsigned" J..= _asrUnsigned o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance Arbitrary AddSigsReq where arbitrary = AddSigsReq diff --git a/src-ghc/Pact/Bench.hs b/src-ghc/Pact/Bench.hs index be993c816..4094b06b9 100644 --- a/src-ghc/Pact/Bench.hs +++ b/src-ghc/Pact/Bench.hs @@ -328,6 +328,21 @@ main = do let tt = evalReplEval def replS (mapM eval timeTest) void $! eitherDie "timeTest failed" . fmapL show =<< tt + wrap10Cmd <- parseCode "(bench.wrap10 100)" + wrap10MonoCmd <- parseCode "(bench.wrap10_integer 100)" + + arityCmd0 <- parseCode "(bench.arity_tc_0)" + arityCmd1 <- parseCode "(bench.arity_tc_1 1)" + arityCmd10 <- parseCode "(bench.arity_tc_10 1 1 1 1 1 1 1 1 1 1)" + arityCmd40 <- parseCode "(bench.arity_tc_40 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)" + + aritySmallObj <- parseCode "(bench.arity_small_obj {\"a\": 1})" + arityMediumObj <- parseCode "(bench.arity_medium_obj {\"a\":1, \"b\":true, \"c\":1, \"d\":{\"a\":1}, \"e\":1, \"f\":true, \"g\":1, \"h\":{\"a\":1} })" + arityLargeObj <- parseCode "(bench.arity_large_obj {\"a\":1, \"b\":true, \"c\":1, \"d\":{\"a\":1}, \"e\":1, \"f\":true, \"g\":1, \"h\":{\"a\":1}, \"i\":1, \"j\":true, \"k\":1, \"l\":{\"a\":1}, \"m\":1, \"n\":true, \"o\":1, \"p\":{\"a\":1} })" + + accumCmd0 <- parseCode "(bench.accum (enumerate 1 0))" + accumCmd1 <- parseCode "(bench.accum (enumerate 1 1))" + accumCmd100 <- parseCode "(bench.accum (enumerate 1 100))" let cleanupSqlite = do c <- readMVar $ pdPactDbVar sqliteDb @@ -385,4 +400,27 @@ main = do , benchNFIO "round4" $ runPactExec def "round4" [] Null Nothing pureDb round4 ] , benchNFIO "time" $ fmap fst <$> evalReplEval def replS (mapM eval timeTest) + , bgroup "defun" + [ bgroup "return-type-tc" + [ benchNFIO "wrap10" $ runPactExec def "wrap10" [] Null Nothing pureDb wrap10Cmd + , benchNFIO "wrap10_mono" $ runPactExec def "wrap10_mono" [] Null Nothing pureDb wrap10MonoCmd + , benchNFIO "accum100" $ runPactExec def "accum100" [] Null Nothing pureDb accumCmd100 + ] + , bgroup "arity" + [ benchNFIO "00-args" $ runPactExec def "00-args" [] Null Nothing pureDb arityCmd0 + , benchNFIO "01-args" $ runPactExec def "01-args" [] Null Nothing pureDb arityCmd1 + , benchNFIO "10-args" $ runPactExec def "10-args" [] Null Nothing pureDb arityCmd10 + , benchNFIO "40-args" $ runPactExec def "40-args" [] Null Nothing pureDb arityCmd40 + ] + , bgroup "object-size" + [ benchNFIO "small-obj" $ runPactExec def "small-obj" [] Null Nothing pureDb aritySmallObj + , benchNFIO "medium-obj" $ runPactExec def "medium-obj" [] Null Nothing pureDb arityMediumObj + , benchNFIO "large-obj" $ runPactExec def "large-obj" [] Null Nothing pureDb arityLargeObj + ] + , bgroup "list-tc" + [ benchNFIO "000-items" $ runPactExec def "000-items" [] Null Nothing pureDb accumCmd0 + , benchNFIO "001-items" $ runPactExec def "001-items" [] Null Nothing pureDb accumCmd1 + , benchNFIO "100-items" $ runPactExec def "100-items" [] Null Nothing pureDb accumCmd100 + ] + ] ] diff --git a/src-ghc/Pact/Persist/SQLite.hs b/src-ghc/Pact/Persist/SQLite.hs index 11aaa8e45..d78361b5a 100644 --- a/src-ghc/Pact/Persist/SQLite.hs +++ b/src-ghc/Pact/Persist/SQLite.hs @@ -51,7 +51,7 @@ data SQLite = SQLite { conn :: Database , config :: SQLiteConfig , logger :: Logger - , tableStmts :: (M.Map Utf8 TableStmts) + , tableStmts :: M.Map Utf8 TableStmts , txStmts :: TxStmts } diff --git a/src-tool/Pact/Analyze/Parse/Prop.hs b/src-tool/Pact/Analyze/Parse/Prop.hs index 714334454..946775e97 100644 --- a/src-tool/Pact/Analyze/Parse/Prop.hs +++ b/src-tool/Pact/Analyze/Parse/Prop.hs @@ -520,6 +520,12 @@ inferPreProp preProp = case preProp of _ -> throwErrorIn preProp $ pretty op' <> " applied to wrong number of arguments" + PreApp s [PreApp a p1, PreApp b p2 , c] | s == SOrQ -> + inferPreProp (PreApp SLogicalDisjunction [PreApp a (p1 ++ [c]), PreApp b (p2 ++ [c])]) + + PreApp s [PreApp a p1, PreApp b p2 , c] | s == SAndQ -> + inferPreProp (PreApp SLogicalConjunction [PreApp a (p1 ++ [c]), PreApp b (p2 ++ [c])]) + PreApp s [a, b] | s == SLogicalImplication -> do propNotA <- PNot <$> checkPreProp SBool a Some SBool . POr propNotA <$> checkPreProp SBool b diff --git a/src/Pact/Compile.hs b/src/Pact/Compile.hs index b64e4eeef..d183eb540 100644 --- a/src/Pact/Compile.hs +++ b/src/Pact/Compile.hs @@ -585,7 +585,8 @@ abstractBody :: Compile (Term Name) -> [Arg (Term Name)] -> Compile (Scope Int T abstractBody term args = abstractBody' args =<< bodyForm term abstractBody' :: [Arg (Term Name)] -> Term Name -> Compile (Scope Int Term Name) -abstractBody' args body = traverse enrichDynamic $ abstract (`elemIndex` bNames) body +abstractBody' args body = + (if M.null modRefArgs then pure else traverse enrichDynamic) $ abstract (`elemIndex` bNames) body where bNames = map arg2Name args diff --git a/src/Pact/Eval.hs b/src/Pact/Eval.hs index 9d9e35a13..6e667423a 100644 --- a/src/Pact/Eval.hs +++ b/src/Pact/Eval.hs @@ -319,6 +319,11 @@ eval' (TModule _tm@(MDModule m) bod i) = capMName <- ifExecutionFlagSet' FlagPreserveNsModuleInstallBug (_mName m) (_mName mangledM) void $ acquireModuleAdminCapability capMName $ return () + + unlessExecutionFlagSet FlagDisablePact48 $ do + evalRefs.rsLoadedModules %= HM.delete (_mName mangledM) + evalRefs.rsQualifiedDeps %= HM.filterWithKey (\k _ -> _fqModule k /= _mName mangledM) + -- build/install module from defs (g,govM) <- loadModule mangledM bod i g0 szVer <- getSizeOfVersion @@ -736,27 +741,42 @@ fullyQualifyDefs info mdef defs = do checkAddDep = \case Direct (TVar (FQName fq) _) -> modify' (Set.insert (_fqModule fq)) _ -> pure () - -- | traverse to find deps and form graph - traverseGraph allDefs memo = fmap stronglyConnCompR $ forM (LHM.sortByKey $ HM.toList allDefs) $ \(defName,defTerm) -> do - let defName' = FullyQualifiedName defName (_mName mdef) (moduleHash mdef) - defTerm' <- forM defTerm $ \(f :: Name) -> do + + resolveBareName memo f@(BareName fn _) = case HM.lookup fn defs of + Just _ -> do + let name' = FullyQualifiedName fn (_mName mdef) (moduleHash mdef) + return (Left name') -- decl found + Nothing -> lift (resolveBareModRef info f fn memo (MDModule mdef)) >>= \case + Just mr -> return (Right mr) -- mod ref found + Nothing -> resolveError f + + resolveError f = lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f)) + + resolveName flagPact48Disabled memo = \case + (QName (QualifiedName (ModuleName mn mNs) fn i)) + | not flagPact48Disabled + && mn == _mnName (_mName mdef) + && isNsMatch -> resolveBareName memo (BareName fn i) + where + isNsMatch = fromMaybe True (liftA2 (==) modNs mNs) + modNs = _mnNamespace (_mName mdef) + f -> do dm <- lift (resolveRefFQN f f) -- lookup ref, don't try modules for barenames case (dm, f) of (Just t, _) -> checkAddDep t *> return (Right t) -- ref found - -- for barenames, check decls and finally modules - (Nothing, Name (BareName fn _)) -> - case HM.lookup fn allDefs of - Just _ -> do - let name' = FullyQualifiedName fn (_mName mdef) (moduleHash mdef) - return (Left name') -- decl found - Nothing -> lift (resolveBareModRef info f fn memo (MDModule mdef)) >>= \r -> case r of - Just mr -> return (Right mr) -- mod ref found - Nothing -> - lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f)) - -- for qualified names, simply fail - (Nothing, _) -> lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f)) + -- for barenames, check decls and finally modules + (Nothing, Name bn@BareName{}) -> resolveBareName memo bn + -- for qualified names, simply fail + (Nothing, _) -> resolveError f + + -- | traverse to find deps and form graph + traverseGraph allDefs memo = fmap stronglyConnCompR $ forM (LHM.sortByKey $ HM.toList allDefs) $ \(defName,defTerm) -> do + let defName' = FullyQualifiedName defName (_mName mdef) (moduleHash mdef) + disablePact48 <- lift (isExecutionFlagSet FlagDisablePact48) + defTerm' <- forM defTerm $ \(f :: Name) -> resolveName disablePact48 memo f return (defTerm', defName', mapMaybe (either Just (const Nothing)) $ toList defTerm') + moduleHash = _mhHash . _mHash diff --git a/src/Pact/Native/Internal.hs b/src/Pact/Native/Internal.hs index c0cd20e7a..5dac1dba1 100644 --- a/src/Pact/Native/Internal.hs +++ b/src/Pact/Native/Internal.hs @@ -270,7 +270,7 @@ argsToParams :: Info -> [Term Name] -> Eval e [PactValue] argsToParams i args = do elideFun <- ifExecutionFlagSet' FlagDisablePact40 id elideModRefInfo forM args $ \arg -> case toPactValue arg of - Right pv -> return $! elideFun pv + Right pv -> return $ elideFun pv Left e -> evalError i $ "Invalid capability argument: " <> pretty e -- | Workhorse to convert App to Capability by capturing Def, diff --git a/src/Pact/PersistPactDb.hs b/src/Pact/PersistPactDb.hs index 8ce66361a..64754bf8b 100644 --- a/src/Pact/PersistPactDb.hs +++ b/src/Pact/PersistPactDb.hs @@ -92,7 +92,7 @@ instance FromJSON UserTableInfo instance J.Encode UserTableInfo where build o = J.object [ "utModule" J..= utModule o ] - {-# INLINE build #-} + {-# INLINABLE build #-} userTable :: TableName -> TableId userTable tn = TableId $ "USER_" <> asString tn diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index 1775902b9..c348af01f 100644 --- a/src/Pact/Repl/Lib.hs +++ b/src/Pact/Repl/Lib.hs @@ -120,7 +120,7 @@ replDefs = ("Repl", "Transform PUBLIC-KEY into an address (i.e. a Pact Runtime Public Key) depending on its SCHEME." ,defZRNative "env-keys" setsigs (funType tTyString [("keys",TyList tTyString)]) ["(env-keys [\"my-key\" \"admin-key\"])"] - ("DEPRECATED in favor of 'set-sigs'. Set transaction signer KEYS. "<> + ("DEPRECATED in favor of 'env-sigs'. Set transaction signer KEYS. "<> "See 'env-sigs' for setting keys with associated capabilities.") ,defZNative "env-sigs" setsigs' (funType tTyString [("sigs",TyList (tTyObject TyAny))]) [LitExample $ "(env-sigs [{'key: \"my-key\", 'caps: [(accounts.USER_GUARD \"my-account\")]}, " <> diff --git a/src/Pact/Types/Command.hs b/src/Pact/Types/Command.hs index 6b8e5b862..5791ce9fe 100644 --- a/src/Pact/Types/Command.hs +++ b/src/Pact/Types/Command.hs @@ -252,7 +252,7 @@ data Signer = Signer -- ^ pub key value , _siAddress :: !(Maybe Text) -- ^ optional "address", for different pub key formats like ETH - , _siCapList :: ![SigCapability] + , _siCapList :: [SigCapability] -- ^ clist for designating signature to specific caps } deriving (Eq, Ord, Show, Generic) diff --git a/src/Pact/Types/Continuation.hs b/src/Pact/Types/Continuation.hs index d7f737a1c..09ae89fd9 100644 --- a/src/Pact/Types/Continuation.hs +++ b/src/Pact/Types/Continuation.hs @@ -66,7 +66,7 @@ import qualified Pact.JSON.Encode as J -- data to 'endorse' a yield object. -- data Provenance = Provenance - { _pTargetChainId :: ChainId + { _pTargetChainId :: !ChainId -- ^ the target chain id for the endorsement , _pModuleHash :: ModuleHash -- ^ a hash of current containing module @@ -89,7 +89,7 @@ instance J.Encode Provenance where [ "targetChainId" J..= _pTargetChainId o , "moduleHash" J..= _pModuleHash o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON Provenance where parseJSON = lensyParseJSON 2 @@ -120,7 +120,7 @@ instance J.Encode Yield where , "source" J..?= _ySourceChain o , "provenance" J..= _yProvenance o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON Yield where parseJSON = withObject "Yield" $ \o -> @@ -150,8 +150,8 @@ instance Pretty PactStep where -- | The type of pact continuations (i.e. defpact) -- data PactContinuation = PactContinuation - { _pcDef :: !Name - , _pcArgs :: ![PactValue] + { _pcDef :: Name + , _pcArgs :: [PactValue] } deriving (Eq, Show, Generic) instance Pretty PactContinuation where @@ -169,7 +169,7 @@ instance J.Encode PactContinuation where [ "args" J..= J.Array (_pcArgs o) , "def" J..= _pcDef o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON PactContinuation where parseJSON = lensyParseJSON 3 @@ -179,7 +179,7 @@ instance FromJSON PactContinuation where parseJSON = lensyParseJSON 3 data PactExec = PactExec { _peStepCount :: Int -- ^ Count of steps in pact (discovered when code is executed) - , _peYield :: Maybe Yield + , _peYield :: !(Maybe Yield) -- ^ Yield value if invoked , _peExecuted :: Maybe Bool -- ^ Only populated for private pacts, indicates if step was executed or skipped. @@ -220,7 +220,7 @@ instance J.Encode PactExec where , "continuation" J..= _peContinuation o , "stepCount" J..= J.Aeson (_peStepCount o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON PactExec where parseJSON = withObject "PactExec" $ \o -> @@ -247,7 +247,7 @@ data NestedPactExec = NestedPactExec -- ^ Step that was executed or skipped , _npePactId :: PactId -- ^ Pact id. On a new pact invocation, is copied from tx id. - , _npeContinuation :: !PactContinuation + , _npeContinuation :: PactContinuation -- ^ Strict (in arguments) application of pact, for future step invocations. , _npeNested :: Map PactId NestedPactExec -- ^ Track whether a current step has nested defpact evaluation results @@ -272,7 +272,7 @@ instance J.Encode NestedPactExec where , "continuation" J..= _npeContinuation o , "stepCount" J..= J.Aeson (_npeStepCount o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON NestedPactExec where parseJSON = withObject "NestedPactExec" $ \o -> diff --git a/src/Pact/Types/Exp.hs b/src/Pact/Types/Exp.hs index 50c7db123..fec4058ba 100644 --- a/src/Pact/Types/Exp.hs +++ b/src/Pact/Types/Exp.hs @@ -58,7 +58,7 @@ import Data.Decimal import Control.DeepSeq import Data.Ratio ((%), denominator) import Data.Serialize (Serialize) -import Data.String (IsString, fromString) +import Data.String (IsString) import Test.QuickCheck import Test.QuickCheck.Instances () @@ -225,7 +225,7 @@ instance J.Encode Separator where build Colon = J.build @Text ":" build ColonEquals = J.build @Text ":=" build Comma = J.build @Text "," - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON Separator where parseJSON = withText "Separator" $ \t -> case t of @@ -238,7 +238,7 @@ instance Arbitrary Separator where arbitrary = elements [Colon, ColonEquals, Comma] expInfoField :: IsString a => a -expInfoField = fromString "i" +expInfoField = "i" data LiteralExp i = LiteralExp { _litLiteral :: !Literal @@ -256,7 +256,7 @@ instance J.Encode i => J.Encode (LiteralExp i) where [ expInfoField J..= _litInfo o , "lit" J..= _litLiteral o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON i => FromJSON (LiteralExp i) where parseJSON = withObject "LiteralExp" $ \o -> @@ -268,8 +268,8 @@ instance Pretty (LiteralExp i) where data AtomExp i = AtomExp { _atomAtom :: !Text , _atomQualifiers :: ![Text] - , _atomDynamic :: !Bool - , _atomInfo :: !i + , _atomDynamic :: Bool + , _atomInfo :: i } deriving (Eq,Ord,Generic,Functor,Foldable,Traversable,Show) instance HasInfo (AtomExp Info) where getInfo = _atomInfo @@ -285,7 +285,7 @@ instance J.Encode i => J.Encode (AtomExp i) where , "q" J..= J.array (_atomQualifiers o) , expInfoField J..= _atomInfo o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON i => FromJSON (AtomExp i) where parseJSON = withObject "AtomExp" $ \o -> @@ -316,7 +316,7 @@ instance J.Encode i => J.Encode (ListExp i) where , "d" J..= _listDelimiter o , expInfoField J..= _listInfo o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON i => FromJSON (ListExp i) where parseJSON = withObject "ListExp" $ \o -> @@ -347,7 +347,7 @@ instance J.Encode i => J.Encode (SeparatorExp i) where [ "sep" J..= _sepSeparator o , expInfoField J..= _sepInfo o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance Pretty (SeparatorExp i) where pretty (SeparatorExp sep' _) = pretty sep' @@ -394,7 +394,7 @@ instance J.Encode i => J.Encode (Exp i) where build (EAtom a) = J.build a build (EList a) = J.build a build (ESeparator a) = J.build a - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON i => FromJSON (Exp i) where parseJSON v = diff --git a/src/Pact/Types/Hash.hs b/src/Pact/Types/Hash.hs index a7e14252d..29269bcb1 100644 --- a/src/Pact/Types/Hash.hs +++ b/src/Pact/Types/Hash.hs @@ -84,7 +84,7 @@ instance NFData Hash instance J.Encode Hash where build = J.build . hashToText - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON Hash where parseJSON = withText "Hash" parseText @@ -92,7 +92,7 @@ instance FromJSON Hash where instance FromJSONKey Hash where fromJSONKey = FromJSONKeyTextParser parseText - {-# INLINE fromJSONKey #-} + {-# INLINABLE fromJSONKey #-} instance ParseText Hash where parseText s = Hash . toShort <$> parseB64UrlUnpaddedText s @@ -139,7 +139,7 @@ instance NFData (TypedHash h) instance J.Encode (TypedHash h) where build = J.build . typedHashToText - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON (TypedHash h) where parseJSON = withText "Hash" parseText diff --git a/src/Pact/Types/Info.hs b/src/Pact/Types/Info.hs index b141dd69b..fe0fe9990 100644 --- a/src/Pact/Types/Info.hs +++ b/src/Pact/Types/Info.hs @@ -123,7 +123,7 @@ instance SizeOf Info where -- This method is currently only used in testing and benchmarking in chainweb. -- mkInfo :: Text -> Info -mkInfo !t = Info $ Just (Code t,Parsed delt len) +mkInfo t = Info $ Just (Code t,Parsed delt len) where len = B.length $ encodeUtf8 t delt = Directed (encodeUtf8 t) 0 0 (fromIntegral len) (fromIntegral len) diff --git a/src/Pact/Types/KeySet.hs b/src/Pact/Types/KeySet.hs index d96182154..a67f798f7 100644 --- a/src/Pact/Types/KeySet.hs +++ b/src/Pact/Types/KeySet.hs @@ -157,7 +157,7 @@ instance J.Encode KeySet where [ "pred" J..= _ksPredFun o , "keys" J..= J.Array (_ksKeys o) ] - {-# INLINE build #-} + {-# INLINABLE build #-} -- -------------------------------------------------------------------------- -- -- KeySetName diff --git a/src/Pact/Types/Names.hs b/src/Pact/Types/Names.hs index 197b33d3c..0bc26a441 100644 --- a/src/Pact/Types/Names.hs +++ b/src/Pact/Types/Names.hs @@ -126,7 +126,7 @@ instance J.Encode ModuleName where [ "namespace" J..= _mnNamespace o , "name" J..= _mnName o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON ModuleName where parseJSON = lensyParseJSON 3 @@ -200,8 +200,8 @@ parseQualifiedName i = AP.parseOnly (qualifiedNameParser i <* eof) data BareName = BareName - { _bnName :: !Text - , _bnInfo :: !Info + { _bnName :: Text + , _bnInfo :: Info } deriving (Generic,Eq,Show) instance Arbitrary BareName where arbitrary = BareName <$> genBareText <*> arbitrary @@ -219,7 +219,7 @@ data DynamicName = DynamicName { _dynMember :: !Text , _dynRefArg :: !Text , _dynInterfaces :: !(Set ModuleName) - , _dynInfo :: !Info + , _dynInfo :: Info } deriving (Generic,Eq,Show) instance NFData DynamicName instance Arbitrary DynamicName where diff --git a/src/Pact/Types/Namespace.hs b/src/Pact/Types/Namespace.hs index 439291960..494ffead0 100644 --- a/src/Pact/Types/Namespace.hs +++ b/src/Pact/Types/Namespace.hs @@ -54,7 +54,7 @@ instance J.Encode a => J.Encode (Namespace a) where , "user" J..= _nsUser o , "name" J..= _nsName o ] - {-# INLINE build #-} + {-# INLINABLE build #-} instance FromJSON a => FromJSON (Namespace a) where parseJSON = lensyParseJSON 3 diff --git a/src/Pact/Types/PactError.hs b/src/Pact/Types/PactError.hs index 58bb109d0..fe7a56fc2 100644 --- a/src/Pact/Types/PactError.hs +++ b/src/Pact/Types/PactError.hs @@ -190,7 +190,7 @@ data PactErrorType | SyntaxError | GasError | ContinuationError - deriving (Show,Eq,Generic) + deriving (Show,Eq,Generic, Bounded, Enum) instance NFData PactErrorType instance FromJSON PactErrorType @@ -203,10 +203,10 @@ instance J.Encode PactErrorType where build SyntaxError = J.text "SyntaxError" build GasError = J.text "GasError" build ContinuationError = J.text "ContinuationError" - {-# INLINE build #-} + {-# INLINABLE build #-} instance Arbitrary PactErrorType where - arbitrary = elements [ EvalError, ArgsError, DbError, TxFailure, SyntaxError, GasError ] + arbitrary = elements [ minBound .. maxBound ] -- -------------------------------------------------------------------------- -- -- PactError diff --git a/src/Pact/Types/PactValue.hs b/src/Pact/Types/PactValue.hs index 93263c35a..5df46d370 100644 --- a/src/Pact/Types/PactValue.hs +++ b/src/Pact/Types/PactValue.hs @@ -55,11 +55,11 @@ import Pact.Types.Type (Type(TyAny)) import qualified Pact.JSON.Encode as J data PactValue - = PLiteral !Literal - | PList !(Vector PactValue) - | PObject !(ObjectMap PactValue) - | PGuard !(Guard PactValue) - | PModRef !ModRef + = PLiteral Literal + | PList (Vector PactValue) + | PObject (ObjectMap PactValue) + | PGuard (Guard PactValue) + | PModRef ModRef deriving (Eq,Show,Generic,Ord) instance NFData PactValue diff --git a/src/Pact/Types/RPC.hs b/src/Pact/Types/RPC.hs index ba9cb09d0..aa9243622 100644 --- a/src/Pact/Types/RPC.hs +++ b/src/Pact/Types/RPC.hs @@ -60,8 +60,8 @@ instance Arbitrary c => Arbitrary (PactRPC c) where arbitrary = oneof [Exec <$> arbitrary, Continuation <$> arbitrary] data ExecMsg c = ExecMsg - { _pmCode :: !c - , _pmData :: !LegacyValue + { _pmCode :: c + , _pmData :: LegacyValue } deriving (Eq,Generic,Show,Functor,Foldable,Traversable) instance NFData c => NFData (ExecMsg c) diff --git a/src/Pact/Types/RowData.hs b/src/Pact/Types/RowData.hs index 68f1cb4dc..aa5fb233c 100644 --- a/src/Pact/Types/RowData.hs +++ b/src/Pact/Types/RowData.hs @@ -83,7 +83,7 @@ instance J.Encode RowDataValue where , "refName" J..= refName ] ] - {-# INLINE build #-} + {-# INLINABLE build #-} tagged :: J.Encode v => Text -> v -> J.Builder tagged t rv = J.object diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs index 88560ebb7..e0918d336 100644 --- a/src/Pact/Types/Runtime.hs +++ b/src/Pact/Types/Runtime.hs @@ -196,6 +196,8 @@ data ExecutionFlag | FlagDisablePact47 -- | Disable runtime return type checking. | FlagDisableRuntimeReturnTypeChecking + -- | Disable Pact 4.8 Features + | FlagDisablePact48 deriving (Eq,Ord,Show,Enum,Bounded) -- | Flag string representation diff --git a/src/Pact/Types/Scheme.hs b/src/Pact/Types/Scheme.hs index da6f00522..9df9e1ce8 100644 --- a/src/Pact/Types/Scheme.hs +++ b/src/Pact/Types/Scheme.hs @@ -29,7 +29,7 @@ import qualified Pact.JSON.Encode as J --------- PPKSCHEME DATA TYPE --------- data PPKScheme = ED25519 | ETH - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, Bounded, Enum) instance NFData PPKScheme @@ -46,7 +46,7 @@ instance ParseText PPKScheme where {-# INLINE parseText #-} instance Arbitrary PPKScheme where - arbitrary = elements [ED25519, ETH] + arbitrary = elements [ minBound .. maxBound ] instance J.Encode PPKScheme where build ED25519 = J.text "ED25519" diff --git a/src/Pact/Types/Term.hs b/src/Pact/Types/Term.hs index 116071ce6..3a691ac56 100644 --- a/src/Pact/Types/Term.hs +++ b/src/Pact/Types/Term.hs @@ -154,7 +154,7 @@ import qualified Pact.JSON.Encode as J -- | Capture function application metadata data FunApp = FunApp - { _faInfo :: !Info + { _faInfo :: Info , _faName :: !Text , _faModule :: !(Maybe ModuleName) , _faDefType :: !DefType @@ -403,7 +403,7 @@ data Term n = , _tInfo :: !Info } | TLam { - _tLam :: !(Lam n) + _tLam :: Lam n , _tInfo :: !Info } | TObject { diff --git a/src/Pact/Types/Type.hs b/src/Pact/Types/Type.hs index d3efb24dd..4e22b2ac5 100644 --- a/src/Pact/Types/Type.hs +++ b/src/Pact/Types/Type.hs @@ -119,9 +119,9 @@ instance Arbitrary TypeName where -- | Pair a name and a type (arguments, bindings etc) data Arg o = Arg { - _aName :: !Text, - _aType :: !(Type o), - _aInfo :: !Info + _aName :: Text, + _aType :: Type o, + _aInfo :: Info } deriving (Eq,Ord,Functor,Foldable,Traversable,Generic,Show) instance NFData o => NFData (Arg o) diff --git a/src/Pact/Types/Util.hs b/src/Pact/Types/Util.hs index e46b77283..a0c43929f 100644 --- a/src/Pact/Types/Util.hs +++ b/src/Pact/Types/Util.hs @@ -82,9 +82,6 @@ import Test.QuickCheck hiding (Result, Success) import Pact.Types.Parser (style, symbols) -#ifdef ENABLE_TOJSON_WARNING -import Debug.Trace -#endif import GHC.Stack (HasCallStack) import qualified Pact.JSON.Encode as J @@ -248,24 +245,12 @@ k .?= v = case v of -- be to define a custom type for property names, which would allow to define -- backward compatile 'Ord' instances. -- -#ifdef ENABLE_TOJSON -enableToJSON - :: String - -> Value - -> Value -#ifdef ENABLE_TOJSON_WARNING -enableToJSON t x = traceStack (t <> ": called 'toJSON'" <> show x) x -#else -enableToJSON _ a = a -#endif -#else enableToJSON :: HasCallStack => String -> Value -> Value enableToJSON t _ = error $ t <> ": encoding to Data.Aeson.Value is unstable and therefore not supported" -#endif {-# INLINE enableToJSON #-} -- | Utility for unsafe parse of JSON diff --git a/tests/AnalyzeSpec.hs b/tests/AnalyzeSpec.hs index bc1998866..5025a63d4 100644 --- a/tests/AnalyzeSpec.hs +++ b/tests/AnalyzeSpec.hs @@ -4594,3 +4594,38 @@ spec = describe "analyze" $ do , "block-time" := block-time } (* block-height x))) |] + + describe "Properties involving `or?` and `and?` are handled" $ do + expectVerified [text| + (defun test() + @model [ (property (or? (> 1) (> 2) 1))] + true) + |] + expectFalsified [text| + (defun test() + @model [ (property (or? (> 1) (> 2) 3))] + true) + |] + expectVerified [text| + (defun test() + @model [ (property (and? (> 1) (> 2) 0))] + true) + |] + expectFalsified [text| + (defun test() + @model [ (property (and? (> 1) (> 2) 3))] + true) + |] + + expectVerified [text| + (defun test(x: integer y: integer z: integer) + @model [ (property (or? (> x) (> y) z))] + (enforce (or? (> x) (> y) z) "") + true) + |] + expectVerified [text| + (defun test(x: integer y: integer z: integer) + @model [ (property (and? (> x) (> y) z))] + (enforce (and? (> x) (> y) z) "") + true) + |] diff --git a/tests/bench/bench.pact b/tests/bench/bench.pact index 8ffacd3c2..f25ff0084 100644 --- a/tests/bench/bench.pact +++ b/tests/bench/bench.pact @@ -89,14 +89,49 @@ (defun wrap10 (a) (id (id (id (id (id (id (id (id (id (id a))))))))))) + (defun wrap10_integer:integer (a:integer) (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer a))))))))))) + (defun rep10 (a) (id a) (id a) (id a) (id a) (id a) (id a) (id a) (id a) (id a) (id a)) (defun withr () (with-read bench-accounts "Acct1" { "balance":= b } b)) + (defun accum:integer (xs) (fold (+) 0 xs)) + (defun fst (a b) a) (defun snd (a b) b) (defun id (a) a) + (defun id_integer:integer (a:integer) a) + + (defun arity_tc_0:integer + () 1) + + (defun arity_tc_1:integer + (a:integer) 1) + + (defun arity_tc_10:integer + (a:integer b:integer c:integer d:integer e:integer f:integer g:integer h:integer i:integer j:integer) 1) + + (defun arity_tc_40:integer + (a1:integer b1:integer c1:integer d1:integer e1:integer f1:integer g1:integer h1:integer i1:integer j1:integer a2:integer b2:integer c2:integer d2:integer e2:integer f2:integer g2:integer h2:integer i2:integer j2:integer a3:integer b3:integer c3:integer d3:integer e3:integer f3:integer g3:integer h3:integer i3:integer j3:integer a4:integer b4:integer c4:integer d4:integer e4:integer f4:integer g4:integer h4:integer i4:integer j4:integer) 1) + + + (defschema small_object + a:integer) + (defun arity_small_obj:integer (arg:object{small_object}) 1) + + (defschema medium_object + a:integer b:bool c:integer d:object{small_object} + e:integer f:bool g:integer h:object{small_object} + ) + (defun arity_medium_obj:integer (arg:object{medium_object}) 1) + (defschema large_object + a:integer b:bool c:integer d:object{small_object} + e:integer f:bool g:integer h:object{small_object} + i:integer j:bool k:integer l:object{small_object} + m:integer n:bool o:integer p:object{small_object} + ) + (defun arity_large_obj:integer (arg:object{large_object}) 1) ) (create-table bench-accounts) diff --git a/tests/pact/fqns.repl b/tests/pact/fqns.repl index 4234f61c1..015e9c646 100644 --- a/tests/pact/fqns.repl +++ b/tests/pact/fqns.repl @@ -77,3 +77,94 @@ (expect "selects correct test" (modB.get-test) "hello") (commit-tx) + +;; +;; Module redeploy name resolution +;; + +; In the following tests, we define a module `test-mod-redeploy-ref`, and then +; redeploy the same module with the change to one capability: `test`. +; In the old version, the `test` capability fails, in the new one it passes. + +(begin-tx) +; First, demonstrate the behavior prior to pact-4.8. +(env-exec-config ["DisablePact48"]) + +(namespace 'free) +(module test-mod-redeploy-ref g + (defcap g () true) + + (defcap test () + (enforce false "boom")) + + (defun f () + (with-capability (test) + 1)) + ) +; Before pact-4.8, the updated capability will be ignored, and calls to a function +; requiring that capability will fail. +(expect-failure "Demonstrate defcap resolution." (f)) + +(commit-tx) + +; The following module redeployment changed the capability `test` to pass. +(begin-tx) +(namespace 'free) +(module test-mod-redeploy-ref g + (defcap g () true) + (defcap test () + true) + + (defun f () + (with-capability (free.test-mod-redeploy-ref.test) + 1)) + + (defun f1 () + (with-capability (test-mod-redeploy-ref.test) + 1)) + + ) +; Before pact-4.8, the capability update (passing `test`) was ignored as the +; full-qualified reference referenced the previously deployed version of the module. +(expect-failure "Reproduce upgrade resolution bug with fully-qualified reference." (f)) +(expect-failure "Reproduce upgrade resolution bug with non-namespace-qualified reference." (f1)) +(commit-tx) + + +;; Check Pact48 behaviour + +(begin-tx) +(namespace 'free) +(module test-mod-redeploy-ref g + (defcap g () true) + + (defcap test () + (enforce false "boom")) + + (defun f () + (with-capability (test) + 1)) + ) +(commit-tx) + +(begin-tx) +(namespace 'free) +(env-exec-config []) ; reset + +(module test-mod-redeploy-ref g + (defcap g () true) + (defcap test () + true) + (defun f () + (with-capability (free.test-mod-redeploy-ref.test) + 1)) + + (defun f1 () + (with-capability (test-mod-redeploy-ref.test) + 1)) + ) +; These tests show that f now references the updated version of the capability. +(expect "Demonstrate correct resolution with fully-qualified reference." 1 (f)) +(expect "Demonstrate correct resolution with non-namespace-qualified reference." 1 (f1)) + +(commit-tx)