wip

Author: zeme-wana

cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs

@@ -22,6 +22,7 @@ import Data.Maybe
 import Data.String
 import System.FilePath
 import Test.Tasty
+import Test.Tasty.Extras (ignoreTestIfHpcEnabled)
 import Test.Tasty.Golden
 
 import Helpers.Guardrail
@@ -67,11 +68,11 @@ test_readable_uplc = testGroup "ReadableUplc" $ M.elems $
 
 tests :: TestTreeWithTestState
 tests = testGroup' "Golden" $ fmap const
-        [ test_cbor
-        , test_budget_large
-        , test_budget_small
+        [ ignoreTestIfHpcEnabled test_cbor
+        , ignoreTestIfHpcEnabled test_budget_large
+        , ignoreTestIfHpcEnabled test_budget_small
         , test_readable_pir
-        , test_readable_uplc
+        , ignoreTestIfHpcEnabled test_readable_uplc
         ]
 
 -- HELPERS

nix/project.nix

@@ -28,10 +28,10 @@ let
           packages.plutus-core.doCoverage = true;
           packages.plutus-executables.doCoverage = true;
           packages.plutus-tx-test-util.doCoverage = true;
-          # packages.plutus-ledger-api.doCoverage = true;
+          packages.plutus-ledger-api.doCoverage = true;
 
-          packages.plutus-core.configureFlags = [ "--ghc-option=-D__USING_HPC__" ];
-          packages.plutus-ledger-api.configureFlags = [ "--ghc-option=-D__USING_HPC__" ];
+          packages.plutus-core.configureFlags = [ "--ghc-option=-D__HPC_ENABLED__" ];
+          packages.plutus-ledger-api.configureFlags = [ "--ghc-option=-D__HPC_ENABLED__" ];
         }];
         ghc810.compiler-nix-name = "ghc810";
         ghc98.compiler-nix-name = "ghc98";

plutus-core/plutus-core.cabal

@@ -465,7 +465,6 @@ test-suite untyped-plutus-core-test
     , serialise
     , split
     , tasty
-    , tasty-expected-failure
     , tasty-golden
     , tasty-hedgehog
     , tasty-hunit
@@ -820,6 +819,7 @@ library plutus-core-testlib
     , Stream
     , tagged
     , tasty
+    , tasty-expected-failure
     , tasty-golden
     , tasty-hedgehog
     , tasty-hunit

plutus-core/testlib/Test/Tasty/Extras.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BlockArguments        #-}
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
@@ -33,6 +34,7 @@ module Test.Tasty.Extras
     , assertEqualPretty
     , (%=?)
     , (%?=)
+    , ignoreTestIfHpcEnabled
     ) where
 
 import PlutusPrelude hiding (toList)
@@ -51,6 +53,7 @@ import GHC.Stack (HasCallStack)
 import System.FilePath (joinPath, (</>))
 import System.Info (compilerVersion)
 import Test.Tasty (TestName, TestTree, testGroup)
+import Test.Tasty.ExpectedFailure (ignoreTest)
 import Test.Tasty.Golden (createDirectoriesAndWriteFile, goldenVsStringDiff)
 import Test.Tasty.Golden.Advanced (goldenTest)
 import Test.Tasty.HUnit (Assertion, assertFailure)
@@ -313,3 +316,16 @@ expected %=? actual = assertEqualPretty "" expected actual
   -- ^ The expected value
   -> Assertion
 actual %?= expected = assertEqualPretty "" expected actual
+
+{-|
+Some tests inspect GHC code, but GHC code gets instrumented when using hpc.
+This flag disables those tests when the custom __HPC_ENABLED__ flag is defined.
+-}
+ignoreTestIfHpcEnabled :: TestTree -> TestTree
+ignoreTestIfHpcEnabled t =
+#ifdef __HPC_ENABLED__
+    ignoreTest t
+#else
+    let _preventsUnusedBindsWarnings = ignoreTest t
+    in t
+#endif

plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs

@@ -72,9 +72,7 @@ import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 import Prettyprinter (vsep)
 import Test.Tasty (TestTree, testGroup)
-#ifdef __USING_HPC__
-import Test.Tasty.ExpectedFailure (ignoreTest)
-#endif
+import Test.Tasty.Extras (ignoreTestIfHpcEnabled)
 import Test.Tasty.Hedgehog (testPropertyNamed)
 import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@=?), (@?=))
 import Test.Tasty.QuickCheck qualified as QC
@@ -502,7 +500,7 @@ test_TrackCostsRestricting =
 
 test_TrackCostsRetaining :: TestTree
 test_TrackCostsRetaining =
-#if MIN_VERSION_base(4,15,0) && !defined(__USING_HPC__)
+#if MIN_VERSION_base(4,15,0)
     test_TrackCostsWith "retaining" 10000 $ \term -> do
         let -- An 'ExBudgetMode' that retains all the individual budgets by sticking them into a
             -- 'DList'.
@@ -1251,11 +1249,7 @@ test_definition =
         , test_SwapEls
         , test_IdBuiltinData
         , test_TrackCostsRestricting
-#ifdef __USING_HPC__
-        , ignoreTest test_TrackCostsRetaining
-#else
-        , test_TrackCostsRetaining
-#endif
+        , ignoreTestIfHpcEnabled test_TrackCostsRetaining
         , test_SerialiseDataImpossible
         , test_fixId
         , runTestNestedHere

plutus-ledger-api/test/Spec/Data/Eval.hs

@@ -1,7 +1,6 @@
 -- editorconfig-checker-disable-file
 -- TODO: merge this module to Versions.hs ?
 {-# LANGUAGE BangPatterns     #-}
-{-# LANGUAGE CPP              #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies     #-}
 module Spec.Data.Eval (tests) where
@@ -33,10 +32,8 @@ import Data.Maybe (fromJust)
 import Data.Set qualified as Set
 import NoThunks.Class
 import Test.Tasty
-#ifdef __USING_HPC__
 import Test.Tasty.ExpectedFailure (ignoreTest)
-#endif
-import Test.Tasty.HUnit
+import Test.Tasty.Extras (ignoreTestIfHpcEnabled)
 
 {- Note [Direct UPLC code]
 For this test-suite we write the programs directly in the UPLC AST,

plutus-ledger-api/test/Spec/Eval.hs

@@ -1,7 +1,6 @@
 -- editorconfig-checker-disable-file
 -- TODO: merge this module to Versions.hs ?
 {-# LANGUAGE BangPatterns     #-}
-{-# LANGUAGE CPP              #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies     #-}
 module Spec.Eval (tests) where
@@ -33,9 +32,7 @@ import Data.Maybe (fromJust)
 import Data.Set qualified as Set
 import NoThunks.Class
 import Test.Tasty
-#ifdef __USING_HPC__
-import Test.Tasty.ExpectedFailure (ignoreTest)
-#endif
+import Test.Tasty.Extras (ignoreTestIfHpcEnabled)
 import Test.Tasty.HUnit
 
 {- Note [Direct UPLC code]
@@ -135,10 +132,7 @@ tests = testGroup "eval"
     [ testAPI
 --    , testUnlifting
     , evaluationContextCacheIsComplete
-#ifdef __USING_HPC__
-    , ignoreTest evaluationContextNoThunks
-#else
+    , ignoreTestIfHpcFlagDefined evaluationContextNoThunks
     , evaluationContextNoThunks
-#endif
     ]