Fix coverage, restore defun advice

.github/workflows/applications.yml

@@ -20,7 +20,7 @@ jobs:
           ghc: '8.10.7'
           cabal: '3.8'
           cabalcache: 'true'
-          flags: '-build-tool'
+          flags: '-build-tool +no-advice'
         - os: 'ubuntu-22.04'
           ghc: '9.0.2'
           cabal: '3.8'
@@ -289,4 +289,3 @@ jobs:
         labels: ${{ steps.meta.outputs.labels }}
         cache-from: type=local,src=/tmp/.buildx-cache
         cache-to: type=local,dest=/tmp/.buildx-cache
-

pact.cabal

@@ -418,6 +418,7 @@ test-suite hspec
         Analyze.TimeGen
         Analyze.Translate
         ClientSpec
+        CoverageSpec
         DocgenSpec
         GasModelSpec
         GoldenSpec

src-ghc/Pact/Coverage.hs

@@ -20,8 +20,6 @@ module Pact.Coverage
 
 import Control.Monad.IO.Class
 import Control.Monad.State.Strict
-import Control.Lens (set)
-import Data.Default
 import Data.Foldable
 import Data.IORef
 import qualified Data.HashMap.Strict as HM
@@ -38,10 +36,8 @@ import Pact.Types.Info
 import Pact.Types.Pretty
 import Pact.Types.Term hiding (App(..),Object(..),Step(..))
 import Pact.Types.Typecheck
-import Pact.Types.Runtime (ModuleData(..),eeAdvice)
-import Pact.Repl
-import Pact.Repl.Types
-
+import Pact.Types.Runtime (ModuleData(..))
+import Pact.Runtime.Utils
 
 mkCoverageAdvice :: IO (IORef LcovReport,Advice)
 mkCoverageAdvice = newIORef mempty >>= \r -> return (r,Advice $ cover r)
@@ -59,10 +55,10 @@ cover ref i ctx f = case _iInfo i of
     report (fn,l) = liftIO $ modifyIORef ref (<> newRep) >> return post
       where
         newRep = fr <> case ctx of
-          AdviceUser (fdef,_) -> mkFunLcov fdef
+          AdviceUser fdef -> mkFunLcov fdef
           _ -> mempty
         post = case ctx of
-          AdviceModule _m -> postModule
+          AdviceModule _m -> (postModule . inlineModuleData)
           _ -> const $ return ()
         fr = mkFileLcov fn mempty mempty $ lnReport l
 
@@ -133,11 +129,3 @@ writeCovReport' :: Bool -> FilePath -> IORef LcovReport -> IO ()
 writeCovReport' mkParentDir reportFile ref = do
   when mkParentDir $ createDirectoryIfMissing True $ takeDirectory reportFile
   readIORef ref >>= writeReport reportFile
-
--- _cover "examples/accounts/accounts.repl"
-_cover :: FilePath -> IO ()
-_cover fn = do
-  (ref,adv) <- mkCoverageAdvice
-  s <- set (rEnv . eeAdvice) adv <$> initReplState (Script False fn) Nothing
-  void $! runStateT (useReplLib >> loadFile def fn) s
-  writeCovReport ref

src/Pact/Eval.hs

@@ -1129,6 +1129,9 @@ reduceApp (App (TVar (Ref r) _) as ai) = reduceApp (App r as ai)
 reduceApp (App (TDef d@Def{..} _) as ai) = do
   case _dDefType of
     Defun ->
+#ifdef ADVICE
+      eAdvise ai (AdviceUser d) $ dup $
+#endif
       functionApp _dDefName _dFunType (Just _dModule) as _dDefBody (_mDocs _dMeta) ai
     Defpact -> do
       g <- computeUserAppGas d ai
@@ -1228,7 +1231,7 @@ evalUserAppBody :: Def Ref -> ([Term Name], FunType (Term Name)) -> Info -> Gas
                 -> (Term Ref -> Eval e (Term Name)) -> Eval e (Term Name)
 evalUserAppBody _d@Def{..} (as',ft') ai g run = guardRecursion fname (Just _dModule) $
 #ifdef ADVICE
-  eAdvise ai (AdviceUser (_d,as')) $ dup $ appCall fa ai as' $ fmap (g,) $ run bod'
+  eAdvise ai (AdviceUser _d) $ dup $ appCall fa ai as' $ fmap (g,) $ run bod'
 #else
   appCall fa ai as' $ fmap (g,) $ run bod'
 #endif

src/Pact/Types/Advice.hs

@@ -49,7 +49,7 @@ data DbContext =
 -- the bracketed operation.
 data AdviceContext r where
     -- | Advise on user function, return result
-    AdviceUser :: !(Def Ref,[Term Name]) -> AdviceContext (Term Name)
+    AdviceUser :: !(Def Ref) -> AdviceContext (Term Name)
     -- | Advise on native, return result
     AdviceNative :: !NativeDefName -> AdviceContext (Term Name)
     -- | Transaction execution wrapper

tests/CoverageSpec.hs

@@ -0,0 +1,28 @@
+module CoverageSpec (spec) where
+
+
+import Control.Lens
+import Control.Monad
+import Test.Hspec
+
+import Pact.Coverage
+import Pact.Repl
+import Pact.Repl.Types
+import Pact.Types.Runtime
+
+spec :: Spec
+spec = do
+  testCover
+
+
+testCover :: Spec
+testCover = do
+  runIO $ do
+    let fn = "tests/lcov/lcov.repl"
+    (ref,adv) <- mkCoverageAdvice
+    s <- initReplState (Script False fn) Nothing
+    void $! execScriptState' fn s (set (rEnv . eeAdvice) adv)
+    writeCovReportInDir "tests/lcov" ref
+  golden <- runIO $ readFile "tests/lcov/coverage/lcov.info.golden"
+  actual <- runIO $ readFile "tests/lcov/coverage/lcov.info"
+  it "should match golden" $ actual `shouldBe` golden

tests/lcov/coverage/lcov.info.golden

@@ -0,0 +1,54 @@
+TN:
+SF:tests/lcov/lcov.repl
+FNF:0
+FNH:0
+BRF:0
+BRH:0
+DA:1,1
+DA:17,1
+DA:2,1
+DA:3,1
+DA:20,1
+DA:5,2
+DA:7,1
+DA:10,1
+DA:13,1
+DA:15,1
+LF:10
+LH:10
+end_of_record
+TN:
+SF:tests/lcov/lcov.pact
+FN:30,covtest.update-val
+FN:4,covtest.GOVERNANCE
+FN:15,covtest.CAP
+FN:37,covtest.increase
+FN:20,covtest.create
+FNDA:2,covtest.update-val
+FNDA:0,covtest.GOVERNANCE
+FNDA:2,covtest.CAP
+FNDA:1,covtest.increase
+FNDA:1,covtest.create
+FNF:5
+FNH:4
+BRF:0
+BRH:0
+DA:16,2
+DA:17,2
+DA:2,1
+DA:18,2
+DA:34,4
+DA:35,1
+DA:4,0
+DA:20,1
+DA:37,1
+DA:25,1
+DA:41,2
+DA:42,2
+DA:43,0
+DA:30,2
+DA:15,2
+DA:47,1
+LF:16
+LH:14
+end_of_record

tests/lcov/lcov.pact

@@ -0,0 +1,47 @@
+
+(module covtest GOVERNANCE
+
+  (defcap GOVERNANCE:bool () true)
+
+  (defconst CONST:decimal 1.0)
+
+  (defschema sch
+      guard:guard
+      val:decimal
+      )
+
+  (deftable tbl:{sch})
+
+  (defcap CAP:bool (k:string)
+    (enforce-guard
+     (at 'guard
+         (read tbl k))))
+
+  (defun create:string
+    ( k:string
+      g:guard
+      val:decimal
+    )
+    (insert tbl k
+            { 'guard: g
+            , 'val: val
+              }))
+
+  (defun update-val:string
+    ( k:string
+      val:decimal
+    )
+    (with-capability (CAP k)
+        (update tbl k { 'val: val })))
+
+  (defun increase:string
+    ( k:string
+      d:decimal
+    )
+    (let ((curr (at 'val (read tbl k))))
+      (enforce (> d curr) "must increase")
+      (update-val k d)) ;; deliberately skipping this
+    )
+)
+
+(create-table tbl)

tests/lcov/lcov.repl

@@ -0,0 +1,22 @@
+(load "lcov.pact")
+(typecheck 'covtest)
+(env-data { 'k: ["key"] })
+
+(create 'a (read-keyset 'k) CONST)
+
+(expect-failure
+  "update guard"
+  "Keyset failure"
+  (update-val 'a 2.0)
+  )
+
+(env-keys ['key])
+
+(update-val 'a 2.0)
+
+(expect-failure
+  "must increase"
+  "must increase"
+  (increase 'a 1.0))
+
+;; skip success test