Tests for the preserve-logging flag. (IntersectMBO#6162)

plutus-core/plutus-ir/src/PlutusIR/Transform/EvaluateBuiltins.hs

@@ -28,10 +28,10 @@ evaluateBuiltinsPass :: (PLC.Typecheckable uni fun, PLC.GEq uni, Applicative m)
   -> BuiltinsInfo uni fun
   -> CostingPart uni fun
   -> Pass m TyName Name uni fun a
-evaluateBuiltinsPass tcconfig conservative binfo costModel =
+evaluateBuiltinsPass tcconfig preserveLogging binfo costModel =
   NamedPass "evaluate builtins" $
     Pass
-      (pure . evaluateBuiltins conservative binfo costModel)
+      (pure . evaluateBuiltins preserveLogging binfo costModel)
       [Typechecks tcconfig]
       [ConstCondition (Typechecks tcconfig)]
 
@@ -46,7 +46,7 @@ evaluateBuiltins
   -> CostingPart uni fun
   -> Term tyname name uni fun a
   -> Term tyname name uni fun a
-evaluateBuiltins conservative binfo costModel = transformOf termSubterms processTerm
+evaluateBuiltins preserveLogging binfo costModel = transformOf termSubterms processTerm
   where
     -- Nothing means "leave the original term as it was"
     eval
@@ -55,18 +55,18 @@ evaluateBuiltins conservative binfo costModel = transformOf termSubterms process
       -> Maybe (Term tyname name uni fun ())
     eval (BuiltinCostedResult _ getX) AppContextEnd =
         case getX of
-            BuiltinSuccess v           -> Just v
+            BuiltinSuccess term           -> Just term
             -- Evaluates successfully, but does logging. If we're being conservative
             -- then we should leave these in, so we don't remove people's logging!
             -- Otherwise `trace "hello" x` is a prime candidate for evaluation!
-            BuiltinSuccessWithLogs _ v -> if conservative then Nothing else Just v
+            BuiltinSuccessWithLogs _ term -> if preserveLogging then Nothing else Just term
             -- Evaluation failure. This can mean that the evaluation legitimately
             -- failed (e.g. `divideInteger 1 0`), or that it failed because the
             -- argument terms are not currently in the right form (because they're
             -- not evaluated, we're in the middle of a term here!). Since we can't
             -- distinguish these, we have to assume it's the latter case and just leave
             -- things alone.
-            BuiltinFailure{}           -> Nothing
+            BuiltinFailure{}              -> Nothing
     eval (BuiltinExpectArgument toRuntime) (TermAppContext arg _ ctx) =
         -- Builtin evaluation does not work with annotations, so we have to throw
         -- the argument annotation away here

plutus-tx-plugin/plutus-tx-plugin.cabal

@@ -155,6 +155,7 @@ test-suite plutus-tx-plugin-tests
     Plugin.NoTrace.Lib
     Plugin.NoTrace.Spec
     Plugin.NoTrace.WithoutTraces
+    Plugin.NoTrace.WithPreservedLogging
     Plugin.NoTrace.WithTraces
     Plugin.Optimization.Spec
     Plugin.Patterns.Spec

plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs

@@ -11,15 +11,16 @@ import Prelude
 import Plugin.NoTrace.Lib (countTraces)
 import Plugin.NoTrace.Lib qualified as Lib
 import Plugin.NoTrace.WithoutTraces qualified as WithoutTraces
+import Plugin.NoTrace.WithPreservedLogging qualified as WithPreservedLogging
 import Plugin.NoTrace.WithTraces qualified as WithTraces
 import Test.Tasty (testGroup)
 import Test.Tasty.Extras (TestNested, embed)
 import Test.Tasty.HUnit (assertBool, testCase, (@=?))
 
 noTrace :: TestNested
-noTrace = embed $ do
+noTrace = embed do
   testGroup "remove-trace"
-    [ testGroup "Trace calls are preserved"
+    [ testGroup "Trace calls are preserved (no-remove-trace)"
         [ testCase "trace-argument" $
             1 @=? countTraces WithTraces.traceArgument
         , testCase "trace-show" $
@@ -37,8 +38,26 @@ noTrace = embed $ do
         , testCase "trace-impure with effect" $ -- See Note [Impure trace messages]
             assertBool "Effect is missing" (Lib.evaluatesToError WithTraces.traceImpure)
         ]
+    , testGroup "Trace calls are preserved (preserve-logging)"
+        [ testCase "trace-argument" $
+            1 @=? countTraces WithPreservedLogging.traceArgument
+        , testCase "trace-show" $
+            1 @=? countTraces WithPreservedLogging.traceShow
+        , testCase "trace-complex" $
+            2 @=? countTraces WithPreservedLogging.traceComplex
+        , testCase "trace-direct" $
+            1 @=? countTraces WithPreservedLogging.traceDirect
+        , testCase "trace-non-constant" $
+            1 @=? countTraces WithPreservedLogging.traceNonConstant
+        , testCase "trace-repeatedly" $
+            3 @=? countTraces WithPreservedLogging.traceRepeatedly
+        , testCase "trace-impure" $
+            1 @=? countTraces WithPreservedLogging.traceImpure
+        , testCase "trace-impure with effect" $ -- See Note [Impure trace messages]
+            assertBool "Effect is missing" (Lib.evaluatesToError WithPreservedLogging.traceImpure)
+        ]
     , testGroup
-        "Trace calls are removed"
+        "Trace calls are removed (remove-trace)"
         [ testCase "trace-argument" $
             0 @=? countTraces WithoutTraces.traceArgument
         , testCase "trace-show" $

plutus-tx-plugin/test/Plugin/NoTrace/WithPreservedLogging.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-}
+{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-conservative-optimisation #-}
+{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:preserve-logging #-}
+
+module Plugin.NoTrace.WithPreservedLogging where
+
+import Data.Proxy (Proxy (..))
+import Plugin.NoTrace.Lib qualified as Lib
+import PlutusTx.Bool (Bool)
+import PlutusTx.Builtins (BuiltinString, Integer)
+import PlutusTx.Code (CompiledCode)
+import PlutusTx.Plugin (plc)
+
+traceArgument :: CompiledCode (BuiltinString -> ())
+traceArgument = plc (Proxy @"traceArgument") Lib.traceArgument
+
+traceShow :: CompiledCode ()
+traceShow = plc (Proxy @"traceShow") Lib.traceShow
+
+traceDirect :: CompiledCode ()
+traceDirect = plc (Proxy @"traceDirect") Lib.traceDirect
+
+traceNonConstant :: CompiledCode (BuiltinString -> BuiltinString)
+traceNonConstant = plc (Proxy @"traceNonConstant") Lib.traceNonConstant
+
+traceComplex :: CompiledCode (Bool -> ())
+traceComplex = plc (Proxy @"traceComplex") Lib.traceComplex
+
+traceRepeatedly :: CompiledCode Integer
+traceRepeatedly = plc (Proxy @"traceRepeatedly") Lib.traceRepeatedly
+
+traceImpure :: CompiledCode ()
+traceImpure = plc (Proxy @"traceImpure") Lib.traceImpure