Fix name resolution within module redeploy

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"]

src/Pact/Eval.hs

@@ -90,7 +90,6 @@ import Pact.Types.Runtime
 import Pact.Types.SizeOf
 import Pact.Types.Namespace
 
-
 evalBeginTx :: Info -> Eval e (Maybe TxId)
 evalBeginTx i = view eeMode >>= beginTx i
 {-# INLINE evalBeginTx #-}
@@ -320,6 +319,9 @@ eval' (TModule _tm@(MDModule m) bod i) =
         capMName <-
           ifExecutionFlagSet' FlagPreserveNsModuleInstallBug (_mName m) (_mName mangledM)
         void $ acquireModuleAdminCapability capMName $ return ()
+        modifying (evalRefs.rsLoadedModules) (HM.delete (_mName mangledM))
+        modifying (evalRefs.rsQualifiedDeps) (HM.filterWithKey (\k _ -> _fqModule k /= _mName mangledM))
+
     -- build/install module from defs
     (g,govM) <- loadModule mangledM bod i g0
     szVer <- getSizeOfVersion
@@ -737,27 +739,60 @@ fullyQualifyDefs info mdef defs = do
     checkAddDep = \case
       Direct (TVar (FQName fq) _) -> modify' (Set.insert (_fqModule fq))
       _ -> pure ()
+
+    resolveOr f action = lift (resolveRefFQN f f) >>= \case
+      Just t -> checkAddDep t *> return (Right t)
+      Nothing -> action
+
+    resolveError f = lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f))
+
     -- | traverse to find deps and form graph
     traverseGraph allDefs memo = fmap stronglyConnCompR $ forM (HM.toList allDefs) $ \(defName,defTerm) -> do
       let defName' = FullyQualifiedName defName (_mName mdef) (moduleHash mdef)
-      defTerm' <- forM defTerm $ \(f :: Name) -> 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))
+      disablePact48 <- lift (isExecutionFlagSet FlagDisablePact48)
+      defTerm' <- if disablePact48 then
+        forM defTerm $ \(f :: Name) -> 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)) >>= \case
+                    Just mr -> return (Right mr) -- mod ref found
+                    Nothing -> resolveError f
+              -- for qualified names, simply fail
+              (Nothing, _) -> resolveError f
+        else
+        forM defTerm $ \case
+            f@(QName (QualifiedName qn fn _))
+              | qn == _mName mdef -> 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)) >>= \case
+                    Just mr -> return (Right mr) -- mod ref found
+                    Nothing -> resolveError f
+
+            f@(Name (BareName fn _)) -> resolveOr f
+              (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)) >>= \case
+                   Just mr -> return (Right mr) -- mod ref found
+                   Nothing -> resolveError f)
+
+            f@QName{} -> resolveOr f (resolveError f)
+            f@DName{} -> resolveOr f (resolveError f)
+            f@FQName{} -> resolveError f
 
       return (defTerm', defName', mapMaybe (either Just (const Nothing)) $ toList defTerm')
+
     moduleHash = _mhHash . _mHash
 
 

src/Pact/Types/Runtime.hs

@@ -189,6 +189,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

tests/pact/modrefs.repl

@@ -310,3 +310,63 @@
     (g selfref selfref)))
 
 (expect "exercise selfref" true (h))
+
+;; module redeploy
+
+(begin-tx)
+(namespace 'ns)
+(module m g
+  (defcap g () true)
+
+  (defcap test ()
+    (enforce false "boom"))
+
+  (defun f ()
+    (with-capability (test)
+      1))
+  )
+(commit-tx)
+
+(begin-tx)
+(namespace 'ns)
+(module m g
+  (defcap g () true)
+  (defcap test ()
+    true)
+  (defun f ()
+    (with-capability (ns.m.test)
+      1))
+  )
+(expect "return 1" 1 (f))
+(commit-tx)
+
+
+(begin-tx)
+(namespace 'ns)
+(module m g
+  (defcap g () true)
+
+  (defcap test ()
+    (enforce false "boom"))
+
+  (defun f ()
+    (with-capability (test)
+      1))
+  )
+(commit-tx)
+
+(begin-tx)
+(env-exec-config ["DisablePact48"])
+(namespace 'ns)
+(module m g
+  (defcap g () true)
+  (defcap test ()
+    true)
+  (defun f ()
+    (with-capability (ns.m.test)
+      1))
+  )
+
+(expect-failure "boom" (f))
+
+(commit-tx)