From 75ab43ca09f733dbb3c0894fcda0beb74e1beab9 Mon Sep 17 00:00:00 2001 From: effectfully Date: Thu, 2 May 2024 15:47:34 +0200 Subject: [PATCH 1/2] [Test] Add do-notation support for 'TestNested' --- plutus-benchmark/lists/test/Lookup/Spec.hs | 8 +- plutus-benchmark/lists/test/Sum/Spec.hs | 8 +- plutus-benchmark/marlowe/test/Spec.hs | 10 +- plutus-benchmark/nofib/test/Spec.hs | 14 +- plutus-benchmark/script-contexts/test/Spec.hs | 12 +- .../src/PlutusCore/Executable/Common.hs | 1 - plutus-core/plutus-core.cabal | 1 + .../plutus-core/src/PlutusCore/MkPlc.hs | 22 +-- .../plutus-core/test/Pretty/Readable.hs | 3 +- plutus-core/plutus-core/test/Spec.hs | 1 - .../plutus-core/test/TypeSynthesis/Spec.hs | 24 ++-- .../PlutusIR/Analysis/RetainedSize/Tests.hs | 4 +- .../test/PlutusIR/Compiler/Datatype/Tests.hs | 22 +-- .../test/PlutusIR/Compiler/Error/Tests.hs | 9 +- .../test/PlutusIR/Compiler/Let/Tests.hs | 9 +- .../test/PlutusIR/Compiler/Recursion/Tests.hs | 16 +-- .../plutus-ir/test/PlutusIR/Core/Tests.hs | 67 ++++----- .../plutus-ir/test/PlutusIR/Purity/Tests.hs | 18 +-- .../test/PlutusIR/Transform/Beta/Tests.hs | 4 +- .../PlutusIR/Transform/CaseOfCase/Tests.hs | 4 +- .../test/PlutusIR/Transform/DeadCode/Tests.hs | 4 +- .../Transform/EvaluateBuiltins/Tests.hs | 4 +- .../test/PlutusIR/Transform/Inline/Tests.hs | 4 +- .../test/PlutusIR/Transform/KnownCon/Tests.hs | 4 +- .../PlutusIR/Transform/LetFloatIn/Tests.hs | 6 +- .../PlutusIR/Transform/LetFloatOut/Tests.hs | 4 +- .../PlutusIR/Transform/NonStrict/Tests.hs | 4 +- .../test/PlutusIR/Transform/RecSplit/Tests.hs | 4 +- .../test/PlutusIR/Transform/Rename/Tests.hs | 4 +- .../PlutusIR/Transform/RewriteRules/Tests.hs | 37 +++-- .../Transform/StrictifyBindings/Tests.hs | 4 +- .../Transform/ThunkRecursions/Tests.hs | 4 +- .../test/PlutusIR/Transform/Unwrap/Tests.hs | 4 +- .../test/PlutusIR/TypeCheck/Tests.hs | 79 ++++++----- plutus-core/prelude/PlutusPrelude.hs | 4 +- plutus-core/testlib/PlutusIR/Test.hs | 4 +- plutus-core/testlib/Test/Tasty/Extras.hs | 112 +++++++++++---- .../untyped-plutus-core/test/Analysis/Spec.hs | 13 +- .../test/DeBruijn/FlatNatWord.hs | 15 +- .../test/DeBruijn/Scope.hs | 2 +- .../untyped-plutus-core/test/DeBruijn/Spec.hs | 13 +- .../test/Evaluation/Machines.hs | 15 +- plutus-ledger-api/test-plugin/Spec/Budget.hs | 3 +- plutus-ledger-api/test-plugin/Spec/Value.hs | 9 +- .../src/PlutusTx/Compiler/Expr.hs | 2 +- plutus-tx-plugin/test/AsData/Budget/Spec.hs | 3 +- plutus-tx-plugin/test/Blueprint/Tests/Lib.hs | 4 +- plutus-tx-plugin/test/Budget/Spec.hs | 4 +- .../NoStrict/NegativeLiterals/Spec.hs | 2 +- .../NoStrict/NoNegativeLiterals/Spec.hs | 2 +- .../Strict/NegativeLiterals/Spec.hs | 2 +- .../Strict/NoNegativeLiterals/Spec.hs | 2 +- plutus-tx-plugin/test/IsData/Spec.hs | 4 +- plutus-tx-plugin/test/Lift/Spec.hs | 4 +- plutus-tx-plugin/test/Optimization/Spec.hs | 4 +- plutus-tx-plugin/test/Plugin/Basic/Spec.hs | 5 +- plutus-tx-plugin/test/Plugin/Coverage/Spec.hs | 4 +- plutus-tx-plugin/test/Plugin/Data/Spec.hs | 4 +- .../test/Plugin/Debug/9.6/fib.pir.golden | 134 +++++++++--------- .../test/Plugin/Debug/9.6/letFun.pir.golden | 30 ++-- plutus-tx-plugin/test/Plugin/Debug/Spec.hs | 3 +- plutus-tx-plugin/test/Plugin/Errors/Spec.hs | 34 ++--- .../test/Plugin/Functions/Spec.hs | 6 +- plutus-tx-plugin/test/Plugin/Laziness/Spec.hs | 8 +- plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs | 10 +- .../test/Plugin/Optimization/Spec.hs | 4 +- plutus-tx-plugin/test/Plugin/Patterns/Spec.hs | 6 +- .../test/Plugin/Primitives/Spec.hs | 4 +- .../test/Plugin/Profiling/Spec.hs | 4 +- plutus-tx-plugin/test/Plugin/Strict/Spec.hs | 4 +- .../test/Plugin/Typeclasses/Spec.hs | 22 +-- plutus-tx-plugin/test/Spec.hs | 45 +++--- plutus-tx-plugin/test/StdLib/Spec.hs | 14 +- plutus-tx-plugin/test/Strictness/Spec.hs | 3 +- plutus-tx-plugin/test/TH/Spec.hs | 24 ++-- plutus-tx-plugin/test/size/Main.hs | 110 +++++++------- .../test/size/abs-specialized.size.golden | 1 - .../test/size/compare.size.golden | 1 - .../test/size/denominator.size.golden | 1 - plutus-tx-plugin/test/size/equal.size.golden | 1 - .../test/size/fromBuiltinData.size.golden | 1 - .../test/size/fromInteger.size.golden | 1 - .../test/size/greater-than-equal.size.golden | 1 - .../test/size/greater-than.size.golden | 1 - .../test/size/less-than-equal.size.golden | 1 - .../test/size/less-than.size.golden | 1 - plutus-tx-plugin/test/size/max.size.golden | 1 - plutus-tx-plugin/test/size/min.size.golden | 1 - plutus-tx-plugin/test/size/minus.size.golden | 1 - .../test/size/negate-specialized.size.golden | 1 - .../test/size/not-equal.size.golden | 1 - .../test/size/numerator.size.golden | 1 - plutus-tx-plugin/test/size/one.size.golden | 1 - plutus-tx-plugin/test/size/plus.size.golden | 1 - .../test/size/properFraction.size.golden | 1 - plutus-tx-plugin/test/size/ratio.size.golden | 1 - plutus-tx-plugin/test/size/recip.size.golden | 1 - plutus-tx-plugin/test/size/round.size.golden | 1 - plutus-tx-plugin/test/size/scale.size.golden | 1 - plutus-tx-plugin/test/size/times.size.golden | 1 - .../test/size/toBuiltinData.size.golden | 1 - .../test/size/truncate.size.golden | 1 - .../size/unsafeFromBuiltinData.size.golden | 1 - .../test/size/unsafeRatio.size.golden | 1 - plutus-tx-plugin/test/size/zero.size.golden | 1 - plutus-tx/plutus-tx.cabal | 2 +- plutus-tx/src/PlutusTx/Lift.hs | 2 +- .../test/Show/{ => Golden}/gadt.show.golden | 0 .../{ => Golden}/infix-type-2.show.golden | 0 .../Show/{ => Golden}/infix-type.show.golden | 0 .../test/Show/{ => Golden}/poly.show.golden | 0 .../{ => Golden}/product-type-2.show.golden | 0 .../{ => Golden}/product-type.show.golden | 0 .../Show/{ => Golden}/record-type.show.golden | 0 .../Show/{ => Golden}/sum-type-1.show.golden | 0 .../Show/{ => Golden}/sum-type-2.show.golden | 0 plutus-tx/test/Show/Spec.hs | 12 +- plutus-tx/test/Spec.hs | 3 +- 118 files changed, 593 insertions(+), 579 deletions(-) delete mode 100644 plutus-tx-plugin/test/size/abs-specialized.size.golden delete mode 100644 plutus-tx-plugin/test/size/compare.size.golden delete mode 100644 plutus-tx-plugin/test/size/denominator.size.golden delete mode 100644 plutus-tx-plugin/test/size/equal.size.golden delete mode 100644 plutus-tx-plugin/test/size/fromBuiltinData.size.golden delete mode 100644 plutus-tx-plugin/test/size/fromInteger.size.golden delete mode 100644 plutus-tx-plugin/test/size/greater-than-equal.size.golden delete mode 100644 plutus-tx-plugin/test/size/greater-than.size.golden delete mode 100644 plutus-tx-plugin/test/size/less-than-equal.size.golden delete mode 100644 plutus-tx-plugin/test/size/less-than.size.golden delete mode 100644 plutus-tx-plugin/test/size/max.size.golden delete mode 100644 plutus-tx-plugin/test/size/min.size.golden delete mode 100644 plutus-tx-plugin/test/size/minus.size.golden delete mode 100644 plutus-tx-plugin/test/size/negate-specialized.size.golden delete mode 100644 plutus-tx-plugin/test/size/not-equal.size.golden delete mode 100644 plutus-tx-plugin/test/size/numerator.size.golden delete mode 100644 plutus-tx-plugin/test/size/one.size.golden delete mode 100644 plutus-tx-plugin/test/size/plus.size.golden delete mode 100644 plutus-tx-plugin/test/size/properFraction.size.golden delete mode 100644 plutus-tx-plugin/test/size/ratio.size.golden delete mode 100644 plutus-tx-plugin/test/size/recip.size.golden delete mode 100644 plutus-tx-plugin/test/size/round.size.golden delete mode 100644 plutus-tx-plugin/test/size/scale.size.golden delete mode 100644 plutus-tx-plugin/test/size/times.size.golden delete mode 100644 plutus-tx-plugin/test/size/toBuiltinData.size.golden delete mode 100644 plutus-tx-plugin/test/size/truncate.size.golden delete mode 100644 plutus-tx-plugin/test/size/unsafeFromBuiltinData.size.golden delete mode 100644 plutus-tx-plugin/test/size/unsafeRatio.size.golden delete mode 100644 plutus-tx-plugin/test/size/zero.size.golden rename plutus-tx/test/Show/{ => Golden}/gadt.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/infix-type-2.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/infix-type.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/poly.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/product-type-2.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/product-type.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/record-type.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/sum-type-1.show.golden (100%) rename plutus-tx/test/Show/{ => Golden}/sum-type-2.show.golden (100%) diff --git a/plutus-benchmark/lists/test/Lookup/Spec.hs b/plutus-benchmark/lists/test/Lookup/Spec.hs index 941f8e80e11..132ead7ec62 100644 --- a/plutus-benchmark/lists/test/Lookup/Spec.hs +++ b/plutus-benchmark/lists/test/Lookup/Spec.hs @@ -1,7 +1,7 @@ module Lookup.Spec (tests) where import Test.Tasty -import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc) +import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc) import PlutusBenchmark.Lists.Lookup.Compiled qualified as Compiled @@ -9,12 +9,12 @@ import PlutusTx.Test qualified as Tx -- Make a set of golden tests with results stored in a given subdirectory -- inside a subdirectory determined by the GHC version. -testGroupGhcIn :: [FilePath] -> [TestNested] -> TestTree -testGroupGhcIn dir = runTestGroupNestedGhc (["lists", "test"] ++ dir) +runTestGhc :: [FilePath] -> [TestNested] -> TestTree +runTestGhc path = runTestNested (["lists", "test"] ++ path) . pure . testNestedGhc tests :: TestTree tests = - testGroupGhcIn ["Lookup"] $ + runTestGhc ["Lookup"] $ flip concatMap sizes $ \sz -> [ Tx.goldenBudget ("match-scott-list-" ++ show sz) $ Compiled.mkMatchWithListsCode (Compiled.workloadOfSize sz) diff --git a/plutus-benchmark/lists/test/Sum/Spec.hs b/plutus-benchmark/lists/test/Sum/Spec.hs index d62dc551b4a..89892581fd0 100644 --- a/plutus-benchmark/lists/test/Sum/Spec.hs +++ b/plutus-benchmark/lists/test/Sum/Spec.hs @@ -2,7 +2,7 @@ module Sum.Spec (tests) where import Test.Tasty -import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc) +import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc) import Test.Tasty.QuickCheck import PlutusBenchmark.Common (Term, cekResultMatchesHaskellValue) @@ -14,8 +14,8 @@ import PlutusTx.Test qualified as Tx -- Make a set of golden tests with results stored in a given subdirectory -- inside a subdirectory determined by the GHC version. -testGroupGhcIn :: [FilePath] -> [TestNested] -> TestTree -testGroupGhcIn dir = runTestGroupNestedGhc (["lists", "test"] ++ dir) +runTestGhc :: [FilePath] -> [TestNested] -> TestTree +runTestGhc path = runTestNested (["lists", "test"] ++ path) . pure . testNestedGhc -- | Check that the various summation functions all give the same result as 'sum' @@ -37,7 +37,7 @@ tests = , testProperty "Compiled left fold (built-in lists)" $ prop_sum Compiled.mkSumLeftBuiltinTerm , testProperty "Compiled left fold (data lists)" $ prop_sum Compiled.mkSumLeftDataTerm ] - , testGroupGhcIn ["Sum"] + , runTestGhc ["Sum"] [ Tx.goldenBudget "right-fold-scott" $ Compiled.mkSumRightScottCode input , Tx.goldenBudget "right-fold-built-in" $ Compiled.mkSumRightBuiltinCode input , Tx.goldenBudget "right-fold-data" $ Compiled.mkSumRightDataCode input diff --git a/plutus-benchmark/marlowe/test/Spec.hs b/plutus-benchmark/marlowe/test/Spec.hs index 2603e9da0e6..e3591c2f4b1 100644 --- a/plutus-benchmark/marlowe/test/Spec.hs +++ b/plutus-benchmark/marlowe/test/Spec.hs @@ -4,7 +4,7 @@ module Main (main) where import Test.Tasty -import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc) +import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc) import PlutusBenchmark.Marlowe.BenchUtil (benchmarkToUPLC, rolePayoutBenchmarks, semanticsBenchmarks) @@ -30,8 +30,8 @@ mkBudgetTest validator bm@M.Benchmark{..} = -- Make a set of golden tests with results stored in a given subdirectory -- inside a subdirectory determined by the GHC version. -testGroupGhcIn :: [FilePath] -> [TestNested] -> TestTree -testGroupGhcIn path = runTestGroupNestedGhc (["marlowe", "test"] ++ path) +runTestGhc :: [FilePath] -> [TestNested] -> TestTree +runTestGhc path = runTestNested (["marlowe", "test"] ++ path) . pure . testNestedGhc main :: IO () main = do @@ -45,13 +45,13 @@ main = do let allTests :: TestTree allTests = testGroup "plutus-benchmark Marlowe tests" - [ testGroupGhcIn ["semantics"] $ + [ runTestGhc ["semantics"] $ goldenSize "semantics" marloweValidator : [ goldenUEvalBudget name [value] | bench <- semanticsMBench , let (name, value) = mkBudgetTest marloweValidator bench ] - , testGroupGhcIn ["role-payout"] $ + , runTestGhc ["role-payout"] $ goldenSize "role-payout" rolePayoutValidator : [ goldenUEvalBudget name [value] | bench <- rolePayoutMBench diff --git a/plutus-benchmark/nofib/test/Spec.hs b/plutus-benchmark/nofib/test/Spec.hs index 3a2d81c828a..d7722d27ad9 100644 --- a/plutus-benchmark/nofib/test/Spec.hs +++ b/plutus-benchmark/nofib/test/Spec.hs @@ -8,7 +8,7 @@ run to completion. -} module Main where import Test.Tasty -import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc) +import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc) import Test.Tasty.HUnit import Test.Tasty.QuickCheck @@ -26,8 +26,8 @@ import PlutusTx.Test qualified as Tx -- Make a set of golden tests with results stored in subdirectories determined -- by the GHC version. -testGroupGhc :: [TestNested] -> TestTree -testGroupGhc = runTestGroupNestedGhc ["nofib", "test"] +runTestGhc :: [TestNested] -> TestTree +runTestGhc = runTestNested ["nofib", "test"] . pure . testNestedGhc -- Unit tests comparing PLC and Haskell computations on given inputs @@ -47,7 +47,7 @@ testClausify = testGroup "clausify" , testCase "formula3" $ mkClausifyTest Clausify.F3 , testCase "formula4" $ mkClausifyTest Clausify.F4 , testCase "formula5" $ mkClausifyTest Clausify.F5 - , testGroupGhc + , runTestGhc [ Tx.goldenPirReadable "clausify-F5" formula5example , Tx.goldenSize "clausify-F5" formula5example , Tx.goldenBudget "clausify-F5" formula5example @@ -70,7 +70,7 @@ testKnights = testGroup "knights" -- Odd sizes call "error" because there are n , testCase "depth 100, 4x4" $ mkKnightsTest 100 4 , testCase "depth 100, 6x6" $ mkKnightsTest 100 6 , testCase "depth 100, 8x8" $ mkKnightsTest 100 8 - , testGroupGhc + , runTestGhc [ Tx.goldenPirReadable "knights10-4x4" knightsExample , Tx.goldenSize "knights10-4x4" knightsExample , Tx.goldenBudget "knights10-4x4" knightsExample @@ -93,7 +93,7 @@ testQueens = testGroup "queens" , testCase "Bjbt1" $ mkQueensTest 4 Queens.Bjbt1 , testCase "Bjbt2" $ mkQueensTest 4 Queens.Bjbt2 , testCase "Fc" $ mkQueensTest 4 Queens.Fc - , testGroupGhc + , runTestGhc [ Tx.goldenPirReadable "queens4-bt" queens4btExample , Tx.goldenSize "queens4-bt" queens4btExample , Tx.goldenBudget "queens4-bt" queens4btExample @@ -106,7 +106,7 @@ testQueens = testGroup "queens" , testCase "Bjbt1" $ mkQueensTest 5 Queens.Bjbt1 , testCase "Bjbt2" $ mkQueensTest 5 Queens.Bjbt2 , testCase "Fc" $ mkQueensTest 5 Queens.Fc - , testGroupGhc + , runTestGhc [ Tx.goldenPirReadable "queens5-fc" queens5fcExample , Tx.goldenSize "queens5-fc" queens5fcExample , Tx.goldenBudget "queens5-fc" queens5fcExample diff --git a/plutus-benchmark/script-contexts/test/Spec.hs b/plutus-benchmark/script-contexts/test/Spec.hs index fad9a3815b0..62557c4ccb5 100644 --- a/plutus-benchmark/script-contexts/test/Spec.hs +++ b/plutus-benchmark/script-contexts/test/Spec.hs @@ -5,7 +5,7 @@ module Main (main) where import Data.Text qualified as Text import Test.Tasty -import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc) +import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc) import Test.Tasty.HUnit import PlutusBenchmark.Common (Term, compiledCodeToTerm, runTermCek, unsafeRunTermCek) @@ -17,8 +17,8 @@ import PlutusTx.Test qualified as Tx -- Make a set of golden tests with results stored in subdirectories determined -- by the GHC version. -testGroupGhc :: [TestNested] -> TestTree -testGroupGhc = runTestGroupNestedGhc ["script-contexts", "test"] +runTestGhc :: [TestNested] -> TestTree +runTestGhc = runTestNested ["script-contexts", "test"] . pure . testNestedGhc assertSucceeded :: Term -> Assertion assertSucceeded t = @@ -43,7 +43,7 @@ testCheckSc1 = testGroup "checkScriptContext1" compiledCodeToTerm $ mkCheckScriptContext1Code (mkScriptContext 4) , testCase "fails on 5" . assertFailed $ compiledCodeToTerm $ mkCheckScriptContext1Code (mkScriptContext 5) - , testGroupGhc [ Tx.goldenSize "checkScriptContext1" $ + , runTestGhc [ Tx.goldenSize "checkScriptContext1" $ mkCheckScriptContext1Code (mkScriptContext 1) , Tx.goldenPirReadable "checkScriptContext1" $ mkCheckScriptContext1Code (mkScriptContext 1) @@ -64,7 +64,7 @@ testCheckSc2 = testGroup "checkScriptContext2" compiledCodeToTerm $ mkCheckScriptContext2Code (mkScriptContext 4) , testCase "succeed on 5" . assertSucceeded $ compiledCodeToTerm $ mkCheckScriptContext2Code (mkScriptContext 5) - , testGroupGhc [ Tx.goldenSize "checkScriptContext2" $ + , runTestGhc [ Tx.goldenSize "checkScriptContext2" $ mkCheckScriptContext2Code (mkScriptContext 1) , Tx.goldenPirReadable "checkScriptContext2" $ mkCheckScriptContext2Code (mkScriptContext 1) @@ -81,7 +81,7 @@ testCheckSc2 = testGroup "checkScriptContext2" testCheckScEquality :: TestTree testCheckScEquality = testGroup "checkScriptContextEquality" - [ testGroupGhc [ Tx.goldenBudget "checkScriptContextEqualityData-20" $ + [ runTestGhc [ Tx.goldenBudget "checkScriptContextEqualityData-20" $ mkScriptContextEqualityDataCode (mkScriptContext 20) , Tx.goldenEvalCekCatch "checkScriptContextEqualityData-20" $ [mkScriptContextEqualityDataCode (mkScriptContext 20)] diff --git a/plutus-core/executables/src/PlutusCore/Executable/Common.hs b/plutus-core/executables/src/PlutusCore/Executable/Common.hs index 5c678b0a589..c673d9221e2 100644 --- a/plutus-core/executables/src/PlutusCore/Executable/Common.hs +++ b/plutus-core/executables/src/PlutusCore/Executable/Common.hs @@ -71,7 +71,6 @@ import PlutusIR.Parser qualified as PIR (parse, program) import Control.Monad.Except import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BSL -import Data.Foldable (traverse_) import Data.HashMap.Monoidal qualified as H import Data.Kind (Type) import Data.List (intercalate) diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index af8cf84b0c3..239780d40eb 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -816,6 +816,7 @@ library plutus-core-testlib , data-default-class , dependent-map >=0.4.0.0 , filepath + , free , hashable , hedgehog >=1.0 , lazy-search diff --git a/plutus-core/plutus-core/src/PlutusCore/MkPlc.hs b/plutus-core/plutus-core/src/PlutusCore/MkPlc.hs index afc44d0d92d..cef4f70725e 100644 --- a/plutus-core/plutus-core/src/PlutusCore/MkPlc.hs +++ b/plutus-core/plutus-core/src/PlutusCore/MkPlc.hs @@ -29,7 +29,7 @@ module PlutusCore.MkPlc , mkTyVar , tyDeclVar , Def (..) - , embed + , embedTerm , TermDef , TypeDef , FunctionType (..) @@ -121,20 +121,20 @@ instance TermLike (Term tyname name uni fun) tyname name uni fun where constr = Constr kase = Case -embed :: TermLike term tyname name uni fun => Term tyname name uni fun ann -> term ann -embed = \case +embedTerm :: TermLike term tyname name uni fun => Term tyname name uni fun ann -> term ann +embedTerm = \case Var a n -> var a n - TyAbs a tn k t -> tyAbs a tn k (embed t) - LamAbs a n ty t -> lamAbs a n ty (embed t) - Apply a t1 t2 -> apply a (embed t1) (embed t2) + TyAbs a tn k t -> tyAbs a tn k (embedTerm t) + LamAbs a n ty t -> lamAbs a n ty (embedTerm t) + Apply a t1 t2 -> apply a (embedTerm t1) (embedTerm t2) Constant a c -> constant a c Builtin a bi -> builtin a bi - TyInst a t ty -> tyInst a (embed t) ty + TyInst a t ty -> tyInst a (embedTerm t) ty Error a ty -> error a ty - Unwrap a t -> unwrap a (embed t) - IWrap a ty1 ty2 t -> iWrap a ty1 ty2 (embed t) - Constr a ty i es -> constr a ty i (fmap embed es) - Case a ty arg cs -> kase a ty (embed arg) (fmap embed cs) + Unwrap a t -> unwrap a (embedTerm t) + IWrap a ty1 ty2 t -> iWrap a ty1 ty2 (embedTerm t) + Constr a ty i es -> constr a ty i (fmap embedTerm es) + Case a ty arg cs -> kase a ty (embedTerm arg) (fmap embedTerm cs) -- | Make a 'Var' referencing the given 'VarDecl'. mkVar :: TermLike term tyname name uni fun => ann -> VarDecl tyname name uni ann -> term ann diff --git a/plutus-core/plutus-core/test/Pretty/Readable.hs b/plutus-core/plutus-core/test/Pretty/Readable.hs index 0a1f91cfb5d..a346e264b71 100644 --- a/plutus-core/plutus-core/test/Pretty/Readable.hs +++ b/plutus-core/plutus-core/test/Pretty/Readable.hs @@ -31,8 +31,7 @@ test_PrettyReadable = where folder :: Pretty fun => PlcFolderContents DefaultUni fun -> TestTree folder - = runTestNestedIn ["plutus-core", "test", "Pretty", "Golden"] - . testNested "Readable" + = runTestNested ["plutus-core", "test", "Pretty", "Golden", "Readable"] . foldPlcFolderContents testNested testReadable testReadable test_Pretty :: TestTree diff --git a/plutus-core/plutus-core/test/Spec.hs b/plutus-core/plutus-core/test/Spec.hs index df56d7f15b4..daf13d8b770 100644 --- a/plutus-core/plutus-core/test/Spec.hs +++ b/plutus-core/plutus-core/test/Spec.hs @@ -36,7 +36,6 @@ import PlutusCore.Test import Control.Monad.Except import Data.ByteString.Lazy qualified as BSL -import Data.Foldable (for_) import Data.Proxy import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8) diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs b/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs index 7d0f7d76810..874e2d29cae 100644 --- a/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs +++ b/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs @@ -67,8 +67,7 @@ foldAssertWell -> PlcFolderContents DefaultUni fun -> TestTree foldAssertWell semvar - = runTestNestedIn ["plutus-core", "test", "TypeSynthesis"] - . testNested "Golden" + = runTestNested ["plutus-core", "test", "TypeSynthesis", "Golden"] . foldPlcFolderContents testNested (\name -> nestedGoldenVsErrorOrThing name . kindcheck) (\name -> nestedGoldenVsErrorOrThing name . typecheck semvar) @@ -126,29 +125,28 @@ test_typecheckIllTyped = TypeErrorE (NameMismatch {}) -> True _ -> False ] - test_typecheckAllFun - :: forall fun. (ToBuiltinMeaning DefaultUni fun, Show fun) + :: forall fun. (ToBuiltinMeaning DefaultUni fun, Show fun, Show (BuiltinSemanticsVariant fun)) => String -> BuiltinSemanticsVariant fun - -> TestTree -test_typecheckAllFun name semvar - = runTestNestedIn ["plutus-core", "test", "TypeSynthesis", "Golden"] - . testNested name + -> TestNested +test_typecheckAllFun name semVar + = testNestedNamed name (show semVar) . map testFun $ enumerate @fun where testFun fun = - nestedGoldenVsErrorOrThing (show fun) . kindcheck $ typeOfBuiltinFunction semvar fun + nestedGoldenVsErrorOrThing (show fun) . kindcheck $ typeOfBuiltinFunction semVar fun test_typecheckDefaultFuns :: TestTree test_typecheckDefaultFuns = -- This checks that for each set of builtins the Plutus type of every builtin is the same -- regardless of versioning. - testGroup "builtins" $ concat - [ map (test_typecheckAllFun @DefaultFun "DefaultFun") enumerate - , map (test_typecheckAllFun @ExtensionFun "ExtensionFun") enumerate - ] + testGroup "builtins" . pure $ + runTestNested ["plutus-core", "test", "TypeSynthesis", "Golden"] $ concat + [ map (test_typecheckAllFun @DefaultFun "DefaultFun") enumerate + , map (test_typecheckAllFun @ExtensionFun "ExtensionFun") enumerate + ] test_typecheck :: TestTree test_typecheck = diff --git a/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs index d01b58b2f60..f7d91041b37 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs @@ -13,8 +13,8 @@ import PlutusIR.Test import PlutusPrelude test_retainedSize :: TestTree -test_retainedSize = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Analysis"] $ - testNested "RetainedSize" $ +test_retainedSize = + runTestNested ["plutus-ir", "test", "PlutusIR", "Analysis", "RetainedSize"] $ map (goldenPir renameAndAnnotate pTerm) [ "typeLet" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/Tests.hs index b203e842d7b..8f6239dc040 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/Tests.hs @@ -8,15 +8,15 @@ import Test.Tasty.Extras test_datatypes :: TestTree test_datatypes = - runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Compiler"] $ testNested "Datatype" - [ goldenPlcFromPir pTermAsProg "maybe" - , goldenPlcFromPir pTermAsProg "listMatch" - , goldenPlcFromPir pTermAsProg "idleAll" - , goldenPlcFromPir pTermAsProg "some" - , goldenEvalPir pTermAsProg "listMatchEval" - , goldenTypeFromPir topSrcSpan pTerm "dataEscape" - , testNested "scott" - [ goldenPlcFromPirScott pTermAsProg "maybe" - , goldenPlcFromPirScott pTermAsProg "listMatch" + runTestNested ["plutus-ir", "test", "PlutusIR", "Compiler", "Datatype"] + [ goldenPlcFromPir pTermAsProg "maybe" + , goldenPlcFromPir pTermAsProg "listMatch" + , goldenPlcFromPir pTermAsProg "idleAll" + , goldenPlcFromPir pTermAsProg "some" + , goldenEvalPir pTermAsProg "listMatchEval" + , goldenTypeFromPir topSrcSpan pTerm "dataEscape" + , testNested "scott" + [ goldenPlcFromPirScott pTermAsProg "maybe" + , goldenPlcFromPirScott pTermAsProg "listMatch" + ] ] - ] diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/Tests.hs index 142a50592a8..f0029cb077e 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/Tests.hs @@ -6,7 +6,8 @@ import Test.Tasty import Test.Tasty.Extras test_error :: TestTree -test_error = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Compiler"] $ testNested "Error" - [ goldenPlcFromPir pTermAsProg "mutuallyRecursiveTypes" - , goldenPlcFromPir pTermAsProg "recursiveTypeBind" - ] +test_error = + runTestNested ["plutus-ir", "test", "PlutusIR", "Compiler", "Error"] + [ goldenPlcFromPir pTermAsProg "mutuallyRecursiveTypes" + , goldenPlcFromPir pTermAsProg "recursiveTypeBind" + ] diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/Tests.hs index 4cb37e52e70..478ea013cac 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/Tests.hs @@ -22,10 +22,11 @@ import Test.Tasty.Extras import Test.Tasty.QuickCheck test_lets :: TestTree -test_lets = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Compiler"] $ testNested "Let" - [ goldenPlcFromPir pTermAsProg "letInLet" - , goldenPlcFromPir pTermAsProg "letDep" - ] +test_lets = + runTestNested ["plutus-ir", "test", "PlutusIR", "Compiler", "Let"] + [ goldenPlcFromPir pTermAsProg "letInLet" + , goldenPlcFromPir pTermAsProg "letDep" + ] -- FIXME: this fails because some of the let passes expect certain things to be -- gone, e.g. non-strict bindings. We should a) add pre-/post-conditions for these, diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs index 17926d14a6e..7d6963954e5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs @@ -7,11 +7,11 @@ import Test.Tasty.Extras test_recursion :: TestTree test_recursion = - runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Compiler"] $ testNested "Recursion" - [ goldenNamedUPlcFromPir pTermAsProg "factorial" - , goldenPlcFromPir pTermAsProg "even3" - , goldenEvalPir pTermAsProg "even3Eval" - , goldenPlcFromPir pTermAsProg "stupidZero" - , goldenPlcFromPir pTermAsProg "mutuallyRecursiveValues" - , goldenEvalPir pTermAsProg "errorBinding" - ] + runTestNested ["plutus-ir", "test", "PlutusIR", "Compiler", "Recursion"] + [ goldenNamedUPlcFromPir pTermAsProg "factorial" + , goldenPlcFromPir pTermAsProg "even3" + , goldenEvalPir pTermAsProg "even3Eval" + , goldenPlcFromPir pTermAsProg "stupidZero" + , goldenPlcFromPir pTermAsProg "mutuallyRecursiveValues" + , goldenEvalPir pTermAsProg "errorBinding" + ] diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs index 306b053749e..4f4275370d1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs @@ -13,42 +13,45 @@ import Data.Functor import Flat test_prettyprinting :: TestTree -test_prettyprinting = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Core"] $ - testNested "prettyprinting" - $ map (goldenPir id pTerm) - [ "basic" - , "maybe" - ] +test_prettyprinting = + runTestNested ["plutus-ir", "test", "PlutusIR", "Core", "prettyprinting"] $ + map + (goldenPir id pTerm) + [ "basic" + , "maybe" + ] test_prettyprintingReadable :: TestTree -test_prettyprintingReadable = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Core"] $ - testNested "prettyprintingReadable" - $ map (goldenPirDoc prettyPirReadable pTerm) - [ "basic" - , "maybe" - , "letInLet" - , "letDep" - , "listMatch" - , "idleAll" - , "some" - , "even3" - , "stupidZero" - , "mutuallyRecursiveValues" - , "errorBinding" - , "some" - , "stupidZero" - , "recursiveTypeBind" - ] +test_prettyprintingReadable = + runTestNested ["plutus-ir", "test", "PlutusIR", "Core", "prettyprintingReadable"] $ + map + (goldenPirDoc prettyPirReadable pTerm) + [ "basic" + , "maybe" + , "letInLet" + , "letDep" + , "listMatch" + , "idleAll" + , "some" + , "even3" + , "stupidZero" + , "mutuallyRecursiveValues" + , "errorBinding" + , "some" + , "stupidZero" + , "recursiveTypeBind" + ] test_serialization :: TestTree -test_serialization = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Core"] $ - testNested "serialization" - $ map (goldenPir roundTripPirTerm pTerm) - [ "serializeBasic" - , "serializeMaybePirTerm" - , "serializeEvenOdd" - , "serializeListMatch" - ] +test_serialization = + runTestNested ["plutus-ir", "test", "PlutusIR", "Core", "serialization"] $ + map + (goldenPir roundTripPirTerm pTerm) + [ "serializeBasic" + , "serializeMaybePirTerm" + , "serializeEvenOdd" + , "serializeListMatch" + ] roundTripPirTerm :: Term TyName Name PLC.DefaultUni PLC.DefaultFun a diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs index 6fbfe364824..e947317a266 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs @@ -41,11 +41,13 @@ dangerTerm = runQuote $ do pure $ Apply () (Apply () (Var () n) (Var () m)) undefined test_evalOrder :: TestTree -test_evalOrder = runTestNestedIn ["plutus-ir", "test", "PlutusIR"] $ testNested "Purity" - [ goldenEvalOrder "letFun" - , goldenEvalOrder "builtinAppUnsaturated" - , goldenEvalOrder "builtinAppSaturated" - , goldenEvalOrder "pureLet" - , goldenEvalOrder "nestedLets1" - , pure $ testCase "evalOrderLazy" $ 4 @=? length (unEvalOrder $ computeEvalOrderCoarse dangerTerm) - ] +test_evalOrder = + runTestNested ["plutus-ir", "test", "PlutusIR", "Purity"] + [ goldenEvalOrder "letFun" + , goldenEvalOrder "builtinAppUnsaturated" + , goldenEvalOrder "builtinAppSaturated" + , goldenEvalOrder "pureLet" + , goldenEvalOrder "nestedLets1" + , embed $ testCase "evalOrderLazy" $ + 4 @=? length (unEvalOrder $ computeEvalOrderCoarse dangerTerm) + ] diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/Tests.hs index 17d72f900a7..c19a221d010 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/Tests.hs @@ -10,8 +10,8 @@ import Test.Tasty import Test.Tasty.Extras test_beta :: TestTree -test_beta = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "Beta" $ +test_beta = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "Beta"] $ map (goldenPir (runQuote . runTestPass betaPassSC) pTerm) [ "lamapp" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/Tests.hs index 9732d9f4a3a..221f02c5cbb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/Tests.hs @@ -12,8 +12,8 @@ import PlutusPrelude import Test.QuickCheck.Property (Property, withMaxSuccess) test_caseOfCase :: TestTree -test_caseOfCase = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "CaseOfCase" $ +test_caseOfCase = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "CaseOfCase"] $ map (goldenPir (runQuote . runTestPass (\tc -> CaseOfCase.caseOfCasePassSC tc def True mempty)) pTerm) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/Tests.hs index 4b4e74cb0af..70b4fe7f9de 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/Tests.hs @@ -16,8 +16,8 @@ import Test.Tasty.QuickCheck test_deadCode :: TestTree -test_deadCode = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "DeadCode" $ +test_deadCode = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "DeadCode"] $ map (goldenPir (runQuote . runTestPass (\tc -> removeDeadBindingsPassSC tc def)) pTerm) [ "typeLet" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs index 8d6aca9048d..da91258a806 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs @@ -14,8 +14,8 @@ import PlutusPrelude import Test.QuickCheck.Property (Property, withMaxSuccess) test_evaluateBuiltins :: TestTree -test_evaluateBuiltins = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "EvaluateBuiltins" $ +test_evaluateBuiltins = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "EvaluateBuiltins"] $ conservative ++ nonConservative where conservative = diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/Tests.hs index beb34587714..e90a4097458 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/Tests.hs @@ -15,8 +15,8 @@ import Test.Tasty (TestTree) -- | Tests of the inliner, include global uniqueness test. test_inline :: TestTree -test_inline = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "Inline" $ +test_inline = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "Inline"] $ map (runTest withConstantInlining) [ "var" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/Tests.hs index afa0335080f..7eb7f7ac053 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/Tests.hs @@ -11,8 +11,8 @@ import PlutusIR.Transform.KnownCon qualified as KnownCon import Test.QuickCheck test_knownCon :: TestTree -test_knownCon = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "KnownCon" $ +test_knownCon = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "KnownCon"] $ map (goldenPir (runQuote . runTestPass KnownCon.knownConPassSC) pTerm) [ "applicative" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/Tests.hs index 1ee11a89a51..cd75a35e967 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/Tests.hs @@ -18,8 +18,7 @@ import Test.QuickCheck.Property (Property, withMaxSuccess) test_letFloatInConservative :: TestTree test_letFloatInConservative = - runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform", "LetFloatIn"] $ - testNested "conservative" $ + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "LetFloatIn", "conservative"] $ map (goldenPir (runQuote . runTestPass testPass) pTerm) [ "avoid-floating-into-lam" @@ -32,8 +31,7 @@ test_letFloatInConservative = test_letFloatInRelaxed :: TestTree test_letFloatInRelaxed = - runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform", "LetFloatIn"] $ - testNested "relaxed" $ + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "LetFloatIn", "relaxed"] $ map (goldenPir (runQuote . runTestPass testPass) pTerm) [ "avoid-floating-into-RHS" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/Tests.hs index 7eefa7ad929..806f6616cb3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/Tests.hs @@ -19,8 +19,8 @@ import PlutusPrelude import Test.QuickCheck.Property (Property, withMaxSuccess) test_letFloatOut :: TestTree -test_letFloatOut = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "LetFloatOut" $ +test_letFloatOut = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "LetFloatOut"] $ map (goldenPir (runQuote . runTestPass testPass) pTerm) [ "letInLet" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/Tests.hs index e9574329bef..ead1b734693 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/Tests.hs @@ -12,8 +12,8 @@ import PlutusIR.Transform.Rename () import Test.QuickCheck test_nonStrict :: TestTree -test_nonStrict = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "NonStrict" $ +test_nonStrict = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "NonStrict"] $ map (goldenPir (runQuote . runTestPass (\tc -> NonStrict.compileNonStrictBindingsPassSC tc False)) pTerm) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/Tests.hs index 02cc57ad0a5..57d46d0fd77 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/Tests.hs @@ -12,8 +12,8 @@ import PlutusIR.Transform.RecSplit import Test.Tasty.QuickCheck test_recSplit :: TestTree -test_recSplit = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "RecSplit" $ +test_recSplit = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "RecSplit"] $ map (goldenPir (runQuote . runTestPass recSplitPass) pTerm) [ "truenonrec" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs index 5857f13358f..c767ecf4cca 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs @@ -13,8 +13,8 @@ import PlutusIR.Transform.Rename () import Test.Tasty.QuickCheck test_rename :: TestTree -test_rename = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "Rename" $ +test_rename = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "Rename"] $ map (goldenPir (PLC.AttachPrettyConfig debugConfig . runQuote . runTestPass (const renamePass)) pTerm) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs index 0cdbfc797ca..a4afde2d2fc 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs @@ -13,25 +13,24 @@ import Test.QuickCheck import Test.Tasty test_rewriteRules :: TestTree -test_rewriteRules = runTestNestedIn ["plutus-ir/test/PlutusIR/Transform"] $ - testNested "RewriteRules" $ - (fmap - (goldenPir (runQuote . runTestPass (\tc -> rewritePassSC tc def)) pTerm) - [ "equalsInt.pir" -- this tests that the function works on equalInteger - , "divideInt.pir" -- this tests that the function excludes not commutative functions - , "multiplyInt.pir" -- this tests that the function works on multiplyInteger - , "let.pir" -- this tests that it works in the subterms - , "unConstrConstrDataFst.pir" - , "unConstrConstrDataSnd.pir" - ] - ) - ++ - (fmap - (goldenPirEvalTrace pTermAsProg) - [ "unConstrConstrDataFst.pir.eval" - ] - ) - +test_rewriteRules = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "RewriteRules"] $ + (fmap + (goldenPir (runQuote . runTestPass (\tc -> rewritePassSC tc def)) pTerm) + [ "equalsInt.pir" -- this tests that the function works on equalInteger + , "divideInt.pir" -- this tests that the function excludes not commutative functions + , "multiplyInt.pir" -- this tests that the function works on multiplyInteger + , "let.pir" -- this tests that it works in the subterms + , "unConstrConstrDataFst.pir" + , "unConstrConstrDataSnd.pir" + ] + ) + ++ + (fmap + (goldenPirEvalTrace pTermAsProg) + [ "unConstrConstrDataFst.pir.eval" + ] + ) where goldenPirEvalTrace = goldenPirM $ \ast -> ppCatch $ do -- we need traces to remain for checking the evaluation-order diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/Tests.hs index fc2af546710..7869ccc9ab1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/Tests.hs @@ -14,8 +14,8 @@ import PlutusPrelude import Test.QuickCheck.Property (Property, withMaxSuccess) test_strictifyBindings :: TestTree -test_strictifyBindings = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "StrictifyBindings" $ +test_strictifyBindings = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "StrictifyBindings"] $ map (goldenPir (runIdentity . runTestPass (\tc -> strictifyBindingsPass tc def)) pTerm) [ "pure1" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/Tests.hs index 1b80679868c..021ed53e695 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/Tests.hs @@ -16,8 +16,8 @@ import PlutusPrelude import Test.QuickCheck.Property (Property, withMaxSuccess) test_thunkRecursions :: TestTree -test_thunkRecursions = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "ThunkRecursions" $ +test_thunkRecursions = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "ThunkRecursions"] $ map (goldenPir (runIdentity . runTestPass (\tc -> thunkRecursionsPass tc def)) pTerm) [ "listFold" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/Tests.hs index 5c4aa3a31dd..265682b9961 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/Tests.hs @@ -12,8 +12,8 @@ import Data.Functor.Identity import Test.QuickCheck.Property (Property, withMaxSuccess) test_unwrap :: TestTree -test_unwrap = runTestNestedIn ["plutus-ir", "test", "PlutusIR", "Transform"] $ - testNested "Unwrap" $ +test_unwrap = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "Unwrap"] $ map (goldenPir (runIdentity . runTestPass unwrapCancelPass) pTerm) [ "unwrapWrap" diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/Tests.hs index 0b3b22880a3..52ea41e0f64 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/Tests.hs @@ -8,42 +8,43 @@ import PlutusIR.Test import PlutusIR.Transform.Rename () test_types :: TestTree -test_types = runTestNestedIn ["plutus-ir", "test", "PlutusIR"] $ - testNested "TypeCheck" - $ map (goldenTypeFromPir topSrcSpan pTerm) - [ "letInLet" - ,"listMatch" - ,"maybe" - ,"ifError" - ,"mutuallyRecursiveTypes" - ,"mutuallyRecursiveValues" - ,"nonrec1" - ,"nonrec2" - ,"nonrec3" - ,"nonrec4" - ,"nonrec6" - ,"nonrec7" - ,"nonrec8" - ,"rec1" - ,"rec2" - ,"rec3" - ,"rec4" - ,"nonrecToRec" - ,"nonrecToNonrec" - ,"oldLength" - ,"strictValue" - ,"strictNonValue" - ,"strictNonValue2" - ,"strictNonValue3" - ,"strictValueNonValue" - ,"strictValueValue" - ,"strictNonValueDeep" - ,"even3Eval" - ,"sameNameDifferentEnv" - , "typeLet" - , "typeLetRec" - -- errrors - , "wrongDataConstrReturnType" - , "nonSelfRecursive" - , "typeLetWrong" - ] +test_types = + runTestNested ["plutus-ir", "test", "PlutusIR", "TypeCheck"] $ + map + (goldenTypeFromPir topSrcSpan pTerm) + [ "letInLet" + , "listMatch" + , "maybe" + , "ifError" + , "mutuallyRecursiveTypes" + , "mutuallyRecursiveValues" + , "nonrec1" + , "nonrec2" + , "nonrec3" + , "nonrec4" + , "nonrec6" + , "nonrec7" + , "nonrec8" + , "rec1" + , "rec2" + , "rec3" + , "rec4" + , "nonrecToRec" + , "nonrecToNonrec" + , "oldLength" + , "strictValue" + , "strictNonValue" + , "strictNonValue2" + , "strictNonValue3" + , "strictValueNonValue" + , "strictValueValue" + , "strictNonValueDeep" + , "even3Eval" + , "sameNameDifferentEnv" + , "typeLet" + , "typeLetRec" + -- errors + , "wrongDataConstrReturnType" + , "nonSelfRecursive" + , "typeLetWrong" + ] diff --git a/plutus-core/prelude/PlutusPrelude.hs b/plutus-core/prelude/PlutusPrelude.hs index f0353c63814..16f7182dac3 100644 --- a/plutus-core/prelude/PlutusPrelude.hs +++ b/plutus-core/prelude/PlutusPrelude.hs @@ -22,6 +22,8 @@ module PlutusPrelude , fromMaybe , guard , foldl' + , for_ + , traverse_ , fold , for , throw @@ -114,7 +116,7 @@ import Data.Char (toLower) import Data.Coerce (Coercible, coerce) import Data.Default.Class import Data.Either (fromRight, isLeft, isRight) -import Data.Foldable (fold, toList) +import Data.Foldable (fold, for_, toList, traverse_) import Data.Function (on) import Data.Functor (($>)) import Data.List (foldl') diff --git a/plutus-core/testlib/PlutusIR/Test.hs b/plutus-core/testlib/PlutusIR/Test.hs index fe5ad055e70..b7422409eb3 100644 --- a/plutus-core/testlib/PlutusIR/Test.hs +++ b/plutus-core/testlib/PlutusIR/Test.hs @@ -21,7 +21,7 @@ import Test.Tasty.Extras import Control.Exception import Control.Lens hiding (op, transform) import Control.Monad.Except -import Control.Monad.Morph +import Control.Monad.Morph (hoist) import Control.Monad.Reader as Reader import PlutusCore qualified as PLC @@ -125,7 +125,7 @@ withGoldenFileM name op = do dir <- currentDir let testFile = dir name goldenFile = dir name ++ ".golden" - return $ goldenVsTextM name goldenFile (op =<< T.readFile testFile) + embed $ goldenVsTextM name goldenFile (op =<< T.readFile testFile) where currentDir = joinPath <$> ask diff --git a/plutus-core/testlib/Test/Tasty/Extras.hs b/plutus-core/testlib/Test/Tasty/Extras.hs index 2537a07416e..877cb97faf2 100644 --- a/plutus-core/testlib/Test/Tasty/Extras.hs +++ b/plutus-core/testlib/Test/Tasty/Extras.hs @@ -1,10 +1,24 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} + module Test.Tasty.Extras - ( TestNested - , runTestNestedIn + ( Layer (..) + , embed + , nestWith + , TestNestedM (..) + , TestNested + , runTestNestedM + , testNestedNamedM + , testNestedM + , testNestedGhcM , runTestNested + , testNestedNamed , testNested , testNestedGhc - , runTestGroupNestedGhc , goldenVsText , goldenVsTextM , goldenVsDoc @@ -16,19 +30,20 @@ module Test.Tasty.Extras , makeVersionedFilePath ) where -import PlutusPrelude +import PlutusPrelude hiding (toList) +import Control.Monad.Free.Church (F (runF), MonadFree, liftF) import Control.Monad.Reader import Data.ByteString.Lazy qualified as BSL import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Version +import GHC.Exts import System.FilePath (joinPath, ()) import System.Info import Test.Tasty import Test.Tasty.Golden - -- | We use the GHC version number to create directories with names like `9.2` -- and `9.6` containing golden files whose contents depend on the GHC version. -- For consistency all such directories should be leaves in the directory @@ -50,31 +65,75 @@ ghcVersion = showVersion compilerVersion makeVersionedFilePath :: [FilePath] -> FilePath -> FilePath makeVersionedFilePath path file = joinPath path ghcVersion file +newtype Layer a r = Layer + { unLayer :: F ((,) a) r + } deriving newtype (Functor, Applicative, Monad, MonadFree ((,) a)) + +instance r ~ () => Semigroup (Layer a r) where + (<>) = (*>) + +instance r ~ () => Monoid (Layer a r) where + mempty = pure () + +instance r ~ () => IsList (Layer a r) where + type Item (Layer a r) = a + fromList = traverse_ embed + toList layer = runF (unLayer layer) mempty $ uncurry (:) + +-- | A.k.a. @Streaming.yield@. +embed :: MonadFree ((,) a) m => a -> m () +embed x = liftF (x, ()) + +nestWith :: ([a] -> a) -> Layer a () -> Layer a () +nestWith f = embed . f . toList + +newtype TestNestedM r = TestNestedM + { unTestNestedM :: ReaderT [FilePath] (Layer TestTree) r + } deriving newtype + (Functor, Applicative, Monad, MonadReader [FilePath], MonadFree ((,) TestTree)) + -- | A 'TestTree' of tests under some name prefix. -type TestNested = Reader [FilePath] TestTree +type TestNested = TestNestedM () --- | Run a 'TestTree' of tests with a given name prefix. This doesn't actually --- run the tests: instead it runs a computation in the Reader monad. -runTestNestedIn :: [FilePath] -> TestNested -> TestTree -runTestNestedIn path test = runReader test path +instance r ~ () => Semigroup (TestNestedM r) where + (<>) = (*>) --- | Run a 'TestTree' of tests with an empty prefix. This doesn't actually run --- the tests: instead it runs a computation in the Reader monad. -runTestNested :: TestNested -> TestTree -runTestNested = runTestNestedIn [] +instance r ~ () => Monoid (TestNestedM r) where + mempty = pure () --- | Descend into a name prefix. -testNested :: FilePath -> [TestNested] -> TestNested -testNested folderName = - local (++ [folderName]) . fmap (testGroup folderName) . sequence +-- | Run a 'TestTree' of tests with a given name prefix. This doesn't actually run the tests: +-- instead it runs a computation in the Reader monad. +runTestNestedM :: [String] -> TestNested -> TestTree +runTestNestedM [] _ = error "Path cannot be empty" +runTestNestedM path test = testGroup (last path) . toList $ runReaderT (unTestNestedM test) path + +-- | Descend into a folder. +testNestedNamedM :: FilePath -> String -> TestNested -> TestNested +testNestedNamedM folderName testName + = TestNestedM + . local (++ [folderName]) + . mapReaderT (nestWith $ testGroup testName) + . unTestNestedM + +-- | Descend into a folder. +testNestedM :: FilePath -> TestNested -> TestNested +testNestedM folderName = testNestedNamedM folderName folderName --- | Like `testNested` but adds a subdirectory corresponding to the GHC version being used. -testNestedGhc :: FilePath -> [TestNested] -> TestNested -testNestedGhc folderName = testNested (folderName ghcVersion) +-- | Like 'testNestedM' but adds a subdirectory corresponding to the GHC version being used. +testNestedGhcM :: TestNested -> TestNested +testNestedGhcM = testNestedM ghcVersion + +runTestNested :: [String] -> [TestNested] -> TestTree +runTestNested path = runTestNestedM path . fold + +testNestedNamed :: FilePath -> String -> [TestNested] -> TestNested +testNestedNamed folderName testName = testNestedNamedM folderName testName . fold + +testNested :: FilePath -> [TestNested] -> TestNested +testNested folderName = testNestedM folderName . fold --- Create a TestTree which runs in the directory 'path/ -runTestGroupNestedGhc :: [FilePath] -> [TestNested] -> TestTree -runTestGroupNestedGhc path = runTestNested . testNestedGhc (joinPath path) +testNestedGhc :: [TestNested] -> TestNested +testNestedGhc = testNestedGhcM . fold -- | Check the contents of a file against a 'Text'. goldenVsText :: TestName -> FilePath -> Text -> TestTree @@ -84,7 +143,7 @@ goldenVsText name ref = goldenVsTextM name ref . pure goldenVsTextM :: TestName -> FilePath -> IO Text -> TestTree goldenVsTextM name ref val = goldenVsStringDiff name (\expected actual -> ["diff", "-u", expected, actual]) ref $ - BSL.fromStrict . encodeUtf8 <$> val + BSL.fromStrict . encodeUtf8 <$> val -- | Check the contents of a file against a 'Doc'. goldenVsDoc :: TestName -> FilePath -> Doc ann -> TestTree @@ -102,8 +161,7 @@ nestedGoldenVsText name ext = nestedGoldenVsTextM name ext . pure nestedGoldenVsTextM :: TestName -> FilePath -> IO Text -> TestNested nestedGoldenVsTextM name ext text = do path <- ask - -- TODO: make more generic - return $ goldenVsTextM name (foldr () (name ++ ext ++ ".golden") path) text + embed $ goldenVsTextM name (foldr () (name ++ ext ++ ".golden") path) text -- | Check the contents of a file under a name prefix against a 'Text'. nestedGoldenVsDoc :: TestName -> FilePath -> Doc ann -> TestNested diff --git a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs index dd8e045dd4c..78b8efec252 100644 --- a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs +++ b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs @@ -49,9 +49,10 @@ letImpure = runQuote $ do (Apply () (Var () m) intConst) evalOrder :: TestTree -evalOrder = runTestNestedIn ["untyped-plutus-core", "test", "Analysis"] $ testNested "evalOrder" - [ goldenEvalOrder "letFun" letFun - , goldenEvalOrder "letImpure" letImpure - , pure $ testCase "evalOrderLazy" $ - 4 @=? length (unEvalOrder $ termEvaluationOrder def dangerTerm) - ] +evalOrder = + runTestNested ["untyped-plutus-core", "test", "Analysis", "evalOrder"] + [ goldenEvalOrder "letFun" letFun + , goldenEvalOrder "letImpure" letImpure + , embed . testCase "evalOrderLazy" $ + 4 @=? length (unEvalOrder $ termEvaluationOrder def dangerTerm) + ] diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/FlatNatWord.hs b/plutus-core/untyped-plutus-core/test/DeBruijn/FlatNatWord.hs index b95fbc41e85..b4165d57ff7 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/FlatNatWord.hs +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/FlatNatWord.hs @@ -73,13 +73,14 @@ prop_OldVsNewIndex = testProperty "oldVsNew Index" $ property $ do Hedgehog.assert $ unflat @Index encoded `isCompatible` unflat @OldIndex encoded test_flatNatWord :: TestNested -test_flatNatWord = testNested "FlatNatWord" $ fmap pure - [ test_MinBound - , test_MaxBound - , prop_CompatInBounds - , prop_DecLarger - , prop_OldVsNewIndex - ] +test_flatNatWord = + testNested "FlatNatWord" $ map embed + [ test_MinBound + , test_MaxBound + , prop_CompatInBounds + , prop_DecLarger + , prop_OldVsNewIndex + ] -- * Old implementation of Flat Index copy-pasted and renamed to OldIndex diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Scope.hs b/plutus-core/untyped-plutus-core/test/DeBruijn/Scope.hs index 1b17ef34857..f6b08829132 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Scope.hs +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Scope.hs @@ -43,7 +43,7 @@ testsFail = ] test_scope :: TestNested -test_scope = testNested "Scope" $ pure . uncurry testCase <$> +test_scope = testNested "Scope" $ embed . uncurry testCase <$> (second testPasses <$> testsOk) <> (second testThrows <$> testsFail) where diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Spec.hs b/plutus-core/untyped-plutus-core/test/DeBruijn/Spec.hs index f79266ccb81..9d3dc471891 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Spec.hs +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TypeFamilies #-} module DeBruijn.Spec (test_debruijn) where import DeBruijn.FlatNatWord (test_flatNatWord) @@ -8,9 +7,9 @@ import Test.Tasty import Test.Tasty.Extras test_debruijn :: TestTree -test_debruijn = runTestNestedIn ["untyped-plutus-core","test"] $ - testNested "DeBruijn" - [ test_undebruijnify - , test_scope - , test_flatNatWord - ] +test_debruijn = + runTestNested ["untyped-plutus-core", "test", "DeBruijn"] $ + [ test_undebruijnify + , test_scope + , test_flatNatWord + ] diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs index f2d25e512bc..5dc79d671c5 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs @@ -119,8 +119,7 @@ test_budget :: TestTree test_budget -- Error diffs are very big = localOption (SizeCutoff 1000000) - . runTestNestedIn ["untyped-plutus-core", "test", "Evaluation", "Machines"] - . testNested "Budget" + . runTestNested ["untyped-plutus-core", "test", "Evaluation", "Machines", "Budget"] $ concat [ folder Plc.defaultBuiltinsRuntime bunchOfFibs , folder (toBuiltinsRuntime def ()) bunchOfIdNats @@ -128,10 +127,7 @@ test_budget ] where folder runtime = - foldPlcFolderContents - testNested - (\name _ -> pure $ testGroup name []) - (\name -> testBudget runtime name . eraseTerm) + foldPlcFolderContents testNested mempty (\name -> testBudget runtime name . eraseTerm) testTallying :: TestName -> Term Name DefaultUni DefaultFun () -> TestNested testTallying name term = @@ -145,9 +141,6 @@ test_tallying :: TestTree test_tallying = -- Error diffs are very big localOption (SizeCutoff 1000000) - . runTestNestedIn ["untyped-plutus-core", "test", "Evaluation", "Machines"] - . testNested "Tallying" - . foldPlcFolderContents testNested - (\name _ -> pure $ testGroup name []) - (\name -> testTallying name . eraseTerm) + . runTestNested ["untyped-plutus-core", "test", "Evaluation", "Machines", "Tallying"] + . foldPlcFolderContents testNested mempty (\name -> testTallying name . eraseTerm) $ bunchOfFibs diff --git a/plutus-ledger-api/test-plugin/Spec/Budget.hs b/plutus-ledger-api/test-plugin/Spec/Budget.hs index f2393bf912f..f0376041e84 100644 --- a/plutus-ledger-api/test-plugin/Spec/Budget.hs +++ b/plutus-ledger-api/test-plugin/Spec/Budget.hs @@ -27,8 +27,7 @@ import PlutusTx.TH (compile) tests :: TestTree tests = - runTestNestedIn ["test-plugin", "Spec"] $ - testNestedGhc "Budget" $ + runTestNested ["test-plugin", "Spec", "Budget"] . pure . testNestedGhc $ [ goldenPirReadable "gt" compiledGt , goldenPirReadable "currencySymbolValueOf" compiledCurrencySymbolValueOf ] diff --git a/plutus-ledger-api/test-plugin/Spec/Value.hs b/plutus-ledger-api/test-plugin/Spec/Value.hs index 87ad1c6ec24..e4e9389dc13 100644 --- a/plutus-ledger-api/test-plugin/Spec/Value.hs +++ b/plutus-ledger-api/test-plugin/Spec/Value.hs @@ -223,8 +223,7 @@ test_EqCurrencyList name currencyLists = test_EqValue :: TestTree test_EqValue = - runTestNestedIn ["test-plugin", "Spec"] $ - testNestedGhc "Value" - [ test_EqCurrencyList "Short" currencyListOptions - , test_EqCurrencyList "Long" currencyLongListOptions - ] + runTestNested ["test-plugin", "Spec", "Value"] . pure . testNestedGhc $ + [ test_EqCurrencyList "Short" currencyListOptions + , test_EqCurrencyList "Long" currencyLongListOptions + ] diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 32ab0827668..11c2ae93f0d 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -120,7 +120,7 @@ compileLiteral :: m (PIRTerm uni fun) compileLiteral = \case -- Just accept any kind of number literal, we'll complain about types we don't support elsewhere - (GHC.LitNumber _ i) -> pure $ PIR.embed $ PLC.mkConstant annMayInline i + (GHC.LitNumber _ i) -> pure $ PIR.embedTerm $ PLC.mkConstant annMayInline i GHC.LitString _ -> throwPlain $ UnsupportedError "Literal string (maybe you need to use OverloadedStrings)" GHC.LitChar _ -> throwPlain $ UnsupportedError "Literal char" GHC.LitFloat _ -> throwPlain $ UnsupportedError "Literal float" diff --git a/plutus-tx-plugin/test/AsData/Budget/Spec.hs b/plutus-tx-plugin/test/AsData/Budget/Spec.hs index f17e22b94c2..d1041a54c47 100644 --- a/plutus-tx-plugin/test/AsData/Budget/Spec.hs +++ b/plutus-tx-plugin/test/AsData/Budget/Spec.hs @@ -20,8 +20,7 @@ import AsData.Budget.Types tests :: TestNested tests = - testNestedGhc - ("AsData" "Budget") + testNested ("AsData" "Budget") . pure $ testNestedGhc [ goldenPirReadable "onlyUseFirstField" onlyUseFirstField , goldenUPlcReadable "onlyUseFirstField" onlyUseFirstField , goldenEvalCekCatch "onlyUseFirstField" [onlyUseFirstField `unsafeApplyCode` inp] diff --git a/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs b/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs index 8965828178a..21c609e72bb 100644 --- a/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs +++ b/plutus-tx-plugin/test/Blueprint/Tests/Lib.hs @@ -44,7 +44,7 @@ import PlutusTx.TH qualified as PlutusTx import Prelude import System.FilePath (()) import Test.Tasty (TestName) -import Test.Tasty.Extras (TestNested) +import Test.Tasty.Extras (TestNested, embed) import Test.Tasty.Golden (goldenVsFile) import UntypedPlutusCore qualified as UPLC @@ -172,4 +172,4 @@ goldenJson name cb = do goldenPath <- asks $ foldr () name let actual = goldenPath ++ ".actual.json" let golden = goldenPath ++ ".golden.json" - pure $ goldenVsFile name golden actual (cb actual) + embed $ goldenVsFile name golden actual (cb actual) diff --git a/plutus-tx-plugin/test/Budget/Spec.hs b/plutus-tx-plugin/test/Budget/Spec.hs index 3c779f5177d..cfdb8e1d61a 100644 --- a/plutus-tx-plugin/test/Budget/Spec.hs +++ b/plutus-tx-plugin/test/Budget/Spec.hs @@ -35,8 +35,8 @@ AsData.asData [d| makeLift ''MaybeD tests :: TestNested -tests = testNestedGhc "Budget" [ - goldenBudget "sum" compiledSum +tests = testNested "Budget" . pure $ testNestedGhc + [ goldenBudget "sum" compiledSum , goldenUPlcReadable "sum" compiledSum , goldenPirReadable "sum" compiledSum , goldenEvalCekCatch "sum" [compiledSum] diff --git a/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NegativeLiterals/Spec.hs b/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NegativeLiterals/Spec.hs index 90a328e54b1..f18db70247e 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NegativeLiterals/Spec.hs +++ b/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NegativeLiterals/Spec.hs @@ -20,7 +20,7 @@ import PlutusTx.TH (compile) import Test.Tasty.Extras tests :: TestNested -tests = testNestedGhc "IntegerLiterals" +tests = testNested "IntegerLiterals" . pure $ testNestedGhc [ goldenPir "integerLiterals-NoStrict-NegativeLiterals" integerLiterals ] diff --git a/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NoNegativeLiterals/Spec.hs b/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NoNegativeLiterals/Spec.hs index 9928b6f0607..131ced5b40a 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NoNegativeLiterals/Spec.hs +++ b/plutus-tx-plugin/test/IntegerLiterals/NoStrict/NoNegativeLiterals/Spec.hs @@ -19,7 +19,7 @@ import PlutusTx.TH (compile) import Test.Tasty.Extras tests :: TestNested -tests = testNestedGhc "IntegerLiterals" +tests = testNested "IntegerLiterals" . pure $ testNestedGhc [ goldenPir "integerLiterals-NoStrict-NoNegativeLiterals" integerLiterals ] diff --git a/plutus-tx-plugin/test/IntegerLiterals/Strict/NegativeLiterals/Spec.hs b/plutus-tx-plugin/test/IntegerLiterals/Strict/NegativeLiterals/Spec.hs index c38f8a80ddd..027974207dc 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/Strict/NegativeLiterals/Spec.hs +++ b/plutus-tx-plugin/test/IntegerLiterals/Strict/NegativeLiterals/Spec.hs @@ -20,7 +20,7 @@ import PlutusTx.TH (compile) import Test.Tasty.Extras tests :: TestNested -tests = testNestedGhc "IntegerLiterals" +tests = testNested "IntegerLiterals" . pure $ testNestedGhc [ goldenPir "integerLiterals-Strict-NegativeLiterals" integerLiterals ] diff --git a/plutus-tx-plugin/test/IntegerLiterals/Strict/NoNegativeLiterals/Spec.hs b/plutus-tx-plugin/test/IntegerLiterals/Strict/NoNegativeLiterals/Spec.hs index 9476f8c94ed..ac458116d06 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/Strict/NoNegativeLiterals/Spec.hs +++ b/plutus-tx-plugin/test/IntegerLiterals/Strict/NoNegativeLiterals/Spec.hs @@ -19,7 +19,7 @@ import PlutusTx.TH (compile) import Test.Tasty.Extras tests :: TestNested -tests = testNestedGhc "IntegerLiterals" +tests = testNested "IntegerLiterals" . pure $ testNestedGhc [ goldenPir "integerLiterals-Strict-NoNegativeLiterals" integerLiterals ] diff --git a/plutus-tx-plugin/test/IsData/Spec.hs b/plutus-tx-plugin/test/IsData/Spec.hs index 9bd5f538b95..2cd9edab9ac 100644 --- a/plutus-tx-plugin/test/IsData/Spec.hs +++ b/plutus-tx-plugin/test/IsData/Spec.hs @@ -112,8 +112,8 @@ fieldAccessor :: CompiledCode (RecordConstructor Integer -> Integer) fieldAccessor = plc (Proxy @"fieldAccessor") (\r -> x r) tests :: TestNested -tests = testNestedGhc "IsData" [ - goldenUEval "int" [plc (Proxy @"int") (isDataRoundtrip (1::Integer))] +tests = testNested "IsData" . pure $ testNestedGhc + [ goldenUEval "int" [plc (Proxy @"int") (isDataRoundtrip (1::Integer))] , goldenUEval "tuple" [plc (Proxy @"tuple") (isDataRoundtrip (1::Integer, 2::Integer))] , goldenUEval "tupleInterop" [ getPlcNoAnn (plc (Proxy @"tupleInterop") (\(d :: P.BuiltinData) -> case IsData.fromBuiltinData d of { Just t -> t P.== (1::Integer, 2::Integer); Nothing -> False})) diff --git a/plutus-tx-plugin/test/Lift/Spec.hs b/plutus-tx-plugin/test/Lift/Spec.hs index 1f888f9695b..39f97e079b1 100644 --- a/plutus-tx-plugin/test/Lift/Spec.hs +++ b/plutus-tx-plugin/test/Lift/Spec.hs @@ -47,8 +47,8 @@ data SynExample = SynExample { unSE :: Syn } Lift.makeLift ''SynExample tests :: TestNested -tests = testNestedGhc "Lift" [ - goldenUPlc "int" (snd (Lift.liftProgramDef (1::Integer))) +tests = testNested "Lift" . pure $ testNestedGhc + [ goldenUPlc "int" (snd (Lift.liftProgramDef (1::Integer))) , goldenUPlc "tuple" (snd (Lift.liftProgramDef (1::Integer, 2::Integer))) , goldenUPlc "mono" (snd (Lift.liftProgramDef (Mono2 2))) , goldenUEval "monoInterop" [ getPlcNoAnn monoCase, snd (Lift.liftProgramDef (Mono1 1 2)) ] diff --git a/plutus-tx-plugin/test/Optimization/Spec.hs b/plutus-tx-plugin/test/Optimization/Spec.hs index 3a79790867a..d579ca7f591 100644 --- a/plutus-tx-plugin/test/Optimization/Spec.hs +++ b/plutus-tx-plugin/test/Optimization/Spec.hs @@ -34,8 +34,8 @@ AsData.asData [d| -- This can be interesting to make sure that important optimizations fire, including -- ones that run on UPLC. tests :: TestNested -tests = testNestedGhc "Optimization" [ - goldenUPlc "maybeFun" maybeFun +tests = testNested "Optimization" . pure $ testNestedGhc + [ goldenUPlc "maybeFun" maybeFun , goldenPirReadable "matchAsData" matchAsData , goldenPirReadable "unsafeDeconstructData" unsafeDeconstructData ] diff --git a/plutus-tx-plugin/test/Plugin/Basic/Spec.hs b/plutus-tx-plugin/test/Plugin/Basic/Spec.hs index a753ec8b7b2..8b674e0f56c 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Basic/Spec.hs @@ -25,12 +25,11 @@ import PlutusTx.Prelude qualified as P import PlutusTx.Test (goldenPir, goldenUPlc) import Data.Proxy (Proxy (..)) -import Test.Tasty.Extras (TestNested, testNestedGhc) +import Test.Tasty.Extras (TestNested, testNested, testNestedGhc) basic :: TestNested basic = - testNestedGhc - "Basic" + testNested "Basic" . pure $ testNestedGhc [ goldenPir "monoId" monoId , goldenPir "monoK" monoK , goldenPir "letFun" letFun diff --git a/plutus-tx-plugin/test/Plugin/Coverage/Spec.hs b/plutus-tx-plugin/test/Plugin/Coverage/Spec.hs index 24dc93cabae..b8c4051e318 100644 --- a/plutus-tx-plugin/test/Plugin/Coverage/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Coverage/Spec.hs @@ -49,8 +49,8 @@ boolQualifiedDisappears :: CompiledCode (() -> Bool) boolQualifiedDisappears = plc (Proxy @"boolQualifiedDisappears") (\ () -> Haskell.True) coverage :: TestNested -coverage = testNestedGhc "Coverage" - [ pure $ testGroup "Application heads and line coverage" +coverage = testNested "Coverage" . pure $ testNestedGhc + [ embed $ testGroup "Application heads and line coverage" [ mkTests "noBool" noBool Set.empty [31] , mkTests "boolTrueFalse" boolTrueFalse (Set.singleton "&&") [34] , mkTests "boolOtherFunction" boolOtherFunction (Set.fromList ["&&", "=="]) [37, 41, 42, 43] diff --git a/plutus-tx-plugin/test/Plugin/Data/Spec.hs b/plutus-tx-plugin/test/Plugin/Data/Spec.hs index cc3a1f9a1fd..f52ab917410 100644 --- a/plutus-tx-plugin/test/Plugin/Data/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Data/Spec.hs @@ -30,8 +30,8 @@ import PlutusTx.Test import Data.Proxy datat :: TestNested -datat = testNestedGhc "Data" [ - monoData +datat = testNested "Data" . pure . testNestedGhc $ + [ monoData , polyData , newtypes , recursiveTypes diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden index cd570b0445c..45afefbea79 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden @@ -296,151 +296,151 @@ n (con { no-src-span } integer) (let - { test/Plugin/Debug/Spec.hs:47:15-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72 } (nonrec) (termbind - { test/Plugin/Debug/Spec.hs:47:15-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72 } (strict) (vardecl - { test/Plugin/Debug/Spec.hs:47:15-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72 } n - (con { test/Plugin/Debug/Spec.hs:47:15-56:72 } integer) + (con { test/Plugin/Debug/Spec.hs:46:15-55:72 } integer) ) - { test/Plugin/Debug/Spec.hs:47:15-56:72 } n + { test/Plugin/Debug/Spec.hs:46:15-55:72 } n ) { - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } { - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } Bool_match [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } equalsInteger - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:48:43-48:43 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:47:43-47:43 } n ] (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:48:45-48:45 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:47:45-47:45 } integer 0 ) ] ] (all - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } integer ) ) } (abs - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:49:26-49:26 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:48:26-48:26 } integer 0 ) ) ] (abs - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) { - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } { - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } Bool_match [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } equalsInteger - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:51:51-51:51 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:50:51-50:51 } n ] (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:51:53-51:53 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:50:53-50:53 } integer 1 ) ] ] (all - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } integer ) ) } (abs - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:52:34-52:34 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:51:34-51:34 } integer 1 ) ) ] (abs - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } addInteger [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72 } fib [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } subtractInteger - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:68-55:68 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71, test/Plugin/Debug/Spec.hs:54:68-54:68 } n ] (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:70-55:70 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71, test/Plugin/Debug/Spec.hs:54:70-54:70 } integer 1 ) @@ -448,20 +448,20 @@ ] ] [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } fib [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72, test/Plugin/Debug/Spec.hs:56:42-56:71 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } [ - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72, test/Plugin/Debug/Spec.hs:56:42-56:71 } - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72, test/Plugin/Debug/Spec.hs:56:42-56:71 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } subtractInteger - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72, test/Plugin/Debug/Spec.hs:56:42-56:71, test/Plugin/Debug/Spec.hs:56:68-56:68 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:68-55:68 } n ] (con - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72, test/Plugin/Debug/Spec.hs:54:33-56:72, test/Plugin/Debug/Spec.hs:56:37-56:72, test/Plugin/Debug/Spec.hs:56:42-56:71, test/Plugin/Debug/Spec.hs:56:70-56:70 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:70-55:70 } integer 2 ) @@ -471,29 +471,29 @@ ) ] (all - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72, test/Plugin/Debug/Spec.hs:51:25-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } dead ) } ) ] (all - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } dead - ({ test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) - { test/Plugin/Debug/Spec.hs:47:15-56:72, test/Plugin/Debug/Spec.hs:48:17-56:72 } + { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } dead ) } ) ) ) - { test/Plugin/Debug/Spec.hs:46:9-58:9 } fib + { test/Plugin/Debug/Spec.hs:45:9-57:9 } fib ) ) ) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden index f9cfeceb748..4c61eb0073f 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden @@ -137,45 +137,45 @@ ds (con { no-src-span } integer) (let - { test/Plugin/Debug/Spec.hs:39:9-39:87 } + { test/Plugin/Debug/Spec.hs:38:9-38:87 } (nonrec) (termbind - { test/Plugin/Debug/Spec.hs:39:9-39:87 } + { test/Plugin/Debug/Spec.hs:38:9-38:87 } (strict) (vardecl - { test/Plugin/Debug/Spec.hs:39:9-39:87 } + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds - (con { test/Plugin/Debug/Spec.hs:39:9-39:87 } integer) + (con { test/Plugin/Debug/Spec.hs:38:9-38:87 } integer) ) - { test/Plugin/Debug/Spec.hs:39:9-39:87 } ds + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds ) (lam { no-src-span } ds (con { no-src-span } integer) (let - { test/Plugin/Debug/Spec.hs:39:9-39:87 } + { test/Plugin/Debug/Spec.hs:38:9-38:87 } (nonrec) (termbind - { test/Plugin/Debug/Spec.hs:39:9-39:87 } + { test/Plugin/Debug/Spec.hs:38:9-38:87 } (strict) (vardecl - { test/Plugin/Debug/Spec.hs:39:9-39:87 } + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds - (con { test/Plugin/Debug/Spec.hs:39:9-39:87 } integer) + (con { test/Plugin/Debug/Spec.hs:38:9-38:87 } integer) ) - { test/Plugin/Debug/Spec.hs:39:9-39:87 } ds + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds ) [ - { test/Plugin/Debug/Spec.hs:39:9-39:87, test/Plugin/Debug/Spec.hs:39:44-39:86, test/Plugin/Debug/Spec.hs:39:54-39:79 } + { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } [ - { test/Plugin/Debug/Spec.hs:39:9-39:87, test/Plugin/Debug/Spec.hs:39:44-39:86, test/Plugin/Debug/Spec.hs:39:54-39:79 } - { test/Plugin/Debug/Spec.hs:39:9-39:87, test/Plugin/Debug/Spec.hs:39:44-39:86, test/Plugin/Debug/Spec.hs:39:54-39:79 } + { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } + { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } equalsInteger - { test/Plugin/Debug/Spec.hs:39:9-39:87, test/Plugin/Debug/Spec.hs:39:44-39:86, test/Plugin/Debug/Spec.hs:39:54-39:79, test/Plugin/Debug/Spec.hs:39:77-39:77 } + { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79, test/Plugin/Debug/Spec.hs:38:77-38:77 } ds ] - { test/Plugin/Debug/Spec.hs:39:9-39:87, test/Plugin/Debug/Spec.hs:39:44-39:86, test/Plugin/Debug/Spec.hs:39:54-39:79, test/Plugin/Debug/Spec.hs:39:79-39:79 } + { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79, test/Plugin/Debug/Spec.hs:38:79-38:79 } ds ] ) diff --git a/plutus-tx-plugin/test/Plugin/Debug/Spec.hs b/plutus-tx-plugin/test/Plugin/Debug/Spec.hs index df94a4efc27..987405909cb 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Debug/Spec.hs @@ -24,8 +24,7 @@ import Data.Proxy debug :: TestNested debug = - testNestedGhc - "Debug" + testNested "Debug" . pure $ testNestedGhc [ goldenPirBy config "letFun" letFun , goldenPirBy config "fib" fib ] diff --git a/plutus-tx-plugin/test/Plugin/Errors/Spec.hs b/plutus-tx-plugin/test/Plugin/Errors/Spec.hs index a9a6b5dcb79..11abfde85f4 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Errors/Spec.hs @@ -34,23 +34,23 @@ import GHC.Num.Integer {- HLINT ignore -} errors :: TestNested -errors = testNestedGhc "Errors" - [ goldenUPlc "machInt" machInt - -- FIXME: This fails differently in nix, possibly due to slightly different optimization settings - -- , goldenPlc "negativeInt" negativeInt - , goldenUPlc "caseInt" caseInt - , goldenUPlc "stringLiteral" stringLiteral - , goldenUPlc "recursiveNewtype" recursiveNewtype - , goldenUPlc "mutualRecursionUnfoldingsLocal" mutualRecursionUnfoldingsLocal - , goldenUPlc "literalCaseInt" literalCaseInt - , goldenUPlc "literalCaseBs" literalCaseBs - , goldenUPlc "literalAppendBs" literalAppendBs - , goldenUPlc "literalCaseOther" literalCaseOther - , goldenUPlc "rangeEnumFromTo" rangeEnumFromTo - , goldenUPlc "rangeEnumFromThenTo" rangeEnumFromThenTo - , goldenUPlc "rangeEnumFrom" rangeEnumFrom - , goldenUPlc "rangeEnumFromThen" rangeEnumFromThen - ] +errors = testNested "Errors" . pure $ testNestedGhc + [ goldenUPlc "machInt" machInt + -- FIXME: This fails differently in nix, possibly due to slightly different optimization settings + -- , goldenPlc "negativeInt" negativeInt + , goldenUPlc "caseInt" caseInt + , goldenUPlc "stringLiteral" stringLiteral + , goldenUPlc "recursiveNewtype" recursiveNewtype + , goldenUPlc "mutualRecursionUnfoldingsLocal" mutualRecursionUnfoldingsLocal + , goldenUPlc "literalCaseInt" literalCaseInt + , goldenUPlc "literalCaseBs" literalCaseBs + , goldenUPlc "literalAppendBs" literalAppendBs + , goldenUPlc "literalCaseOther" literalCaseOther + , goldenUPlc "rangeEnumFromTo" rangeEnumFromTo + , goldenUPlc "rangeEnumFromThenTo" rangeEnumFromThenTo + , goldenUPlc "rangeEnumFrom" rangeEnumFrom + , goldenUPlc "rangeEnumFromThen" rangeEnumFromThen + ] machInt :: CompiledCode Int machInt = plc (Proxy @"machInt") (1::Int) diff --git a/plutus-tx-plugin/test/Plugin/Functions/Spec.hs b/plutus-tx-plugin/test/Plugin/Functions/Spec.hs index 1a3738be2f2..a44c8172252 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Functions/Spec.hs @@ -30,9 +30,9 @@ import PlutusTx.Test import Data.Proxy functions :: TestNested -functions = testNestedGhc "Functions" [ - recursiveFunctions - , unfoldings +functions = testNested "Functions" . pure $ testNestedGhc + [ recursiveFunctions + , unfoldings ] recursiveFunctions :: TestNested diff --git a/plutus-tx-plugin/test/Plugin/Laziness/Spec.hs b/plutus-tx-plugin/test/Plugin/Laziness/Spec.hs index 2d1928c4d9a..32dc5868ae5 100644 --- a/plutus-tx-plugin/test/Plugin/Laziness/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Laziness/Spec.hs @@ -25,10 +25,10 @@ import PlutusTx.Test import Data.Proxy laziness :: TestNested -laziness = testNestedGhc "Laziness" [ - goldenPir "joinError" joinErrorPir - , goldenUEval "joinErrorEval" [ toUPlc joinErrorPir, toUPlc $ plc (Proxy @"T") True, toUPlc $ plc (Proxy @"F") False] - , goldenPir "lazyDepUnit" lazyDepUnit +laziness = testNested "Laziness" . pure $ testNestedGhc + [ goldenPir "joinError" joinErrorPir + , goldenUEval "joinErrorEval" [ toUPlc joinErrorPir, toUPlc $ plc (Proxy @"T") True, toUPlc $ plc (Proxy @"F") False] + , goldenPir "lazyDepUnit" lazyDepUnit ] joinErrorPir :: CompiledCode (Bool -> Bool -> ()) diff --git a/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs b/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs index fd4a09ab823..7d3862ff9af 100644 --- a/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs @@ -13,15 +13,13 @@ import Plugin.NoTrace.Lib qualified as Lib import Plugin.NoTrace.WithoutTraces qualified as WithoutTraces import Plugin.NoTrace.WithTraces qualified as WithTraces import Test.Tasty (testGroup) -import Test.Tasty.Extras (TestNested) +import Test.Tasty.Extras (TestNested, embed) import Test.Tasty.HUnit (assertBool, testCase, (@=?)) noTrace :: TestNested -noTrace = pure do - testGroup - "remove-trace" - [ testGroup - "Trace calls are preserved" +noTrace = embed $ do + testGroup "remove-trace" + [ testGroup "Trace calls are preserved" [ testCase "trace-argument" $ 1 @=? countTraces WithTraces.traceArgument , testCase "trace-show" $ diff --git a/plutus-tx-plugin/test/Plugin/Optimization/Spec.hs b/plutus-tx-plugin/test/Plugin/Optimization/Spec.hs index 63e85767659..0e936ca77e6 100644 --- a/plutus-tx-plugin/test/Plugin/Optimization/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Optimization/Spec.hs @@ -18,8 +18,8 @@ import PlutusTx.Test () import Data.Proxy optimization :: TestNested -optimization = testNestedGhc "Optimization" [ - goldenUPlc "alwaysSucceeds" alwaysSucceeds +optimization = testNested "Optimization" Prelude.. Prelude.pure Prelude.$ testNestedGhc + [ goldenUPlc "alwaysSucceeds" alwaysSucceeds , goldenUPlc "alwaysFails" alwaysFails ] diff --git a/plutus-tx-plugin/test/Plugin/Patterns/Spec.hs b/plutus-tx-plugin/test/Plugin/Patterns/Spec.hs index 9ce7498a4e1..77653cd21b4 100644 --- a/plutus-tx-plugin/test/Plugin/Patterns/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Patterns/Spec.hs @@ -56,7 +56,7 @@ psymRec = plc (Proxy @"psymRec") ( ) patterns :: TestNested -patterns = testNestedGhc "Patterns" [ - goldenPirReadable "psym1" psym1 - , goldenPirReadable "psymRec" psymRec +patterns = testNested "Patterns" Prelude.. Prelude.pure Prelude.$ testNestedGhc + [ goldenPirReadable "psym1" psym1 + , goldenPirReadable "psymRec" psymRec ] diff --git a/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs b/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs index 79e256f7aa2..457e08b47a9 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Primitives/Spec.hs @@ -25,8 +25,8 @@ import PlutusTx.Test import Data.Proxy primitives :: TestNested -primitives = testNestedGhc "Primitives" [ - goldenPir "string" string +primitives = testNested "Primitives" . pure $ testNestedGhc + [ goldenPir "string" string , goldenPir "int" int , goldenPir "int2" int2 , goldenPir "bool" bool diff --git a/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs b/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs index 6a1f874ff12..999acbebbe2 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs @@ -29,8 +29,8 @@ import Data.Proxy (Proxy (Proxy)) import Prelude profiling :: TestNested -profiling = testNestedGhc "Profiling" [ - goldenPir "fib" fibTest +profiling = testNested "Profiling" . pure $ testNestedGhc + [ goldenPir "fib" fibTest , goldenUEvalLogs "fib4" [toUPlc fibTest, toUPlc $ plc (Proxy @"4") (4::Integer)] , goldenUEvalLogs "fact4" [toUPlc factTest, toUPlc $ plc (Proxy @"4") (4::Integer)] , goldenPir "addInt" addIntTest diff --git a/plutus-tx-plugin/test/Plugin/Strict/Spec.hs b/plutus-tx-plugin/test/Plugin/Strict/Spec.hs index 94ce6cd1226..f948ef9d333 100644 --- a/plutus-tx-plugin/test/Plugin/Strict/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Strict/Spec.hs @@ -23,8 +23,8 @@ import PlutusTx.Test import Data.Proxy strict :: TestNested -strict = testNestedGhc "Strict" [ - goldenPirReadable "strictAdd" strictAdd +strict = testNested "Strict" . pure $ testNestedGhc + [ goldenPirReadable "strictAdd" strictAdd , goldenPirReadable "strictAppend" strictAppend , goldenPirReadable "strictAppend2" strictAppend2 , goldenPirReadable "strictAppendString" strictAppendString diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/Spec.hs b/plutus-tx-plugin/test/Plugin/Typeclasses/Spec.hs index c7ee38c7226..74fc2112fa5 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/Spec.hs @@ -27,17 +27,17 @@ import PlutusTx.Test import Data.Proxy typeclasses :: TestNested -typeclasses = testNestedGhc "Typeclasses" [ - goldenPir "sizedBasic" sizedBasic - , goldenPir "sizedPair" sizedPair - , goldenPir "multiFunction" multiFunction - , goldenPir "defaultMethods" defaultMethods - , goldenPir "partialApplication" partialApplication - , goldenPir "sequenceTest" sequenceTest - , goldenPir "compareTest" compareTest - , goldenPir "concatTest" concatTest - , goldenPir "sumTest" sumTest - , goldenPir "fmapDefaultTest" fmapDefaultTest +typeclasses = testNested "Typeclasses" . pure $ testNestedGhc + [ goldenPir "sizedBasic" sizedBasic + , goldenPir "sizedPair" sizedPair + , goldenPir "multiFunction" multiFunction + , goldenPir "defaultMethods" defaultMethods + , goldenPir "partialApplication" partialApplication + , goldenPir "sequenceTest" sequenceTest + , goldenPir "compareTest" compareTest + , goldenPir "concatTest" concatTest + , goldenPir "sumTest" sumTest + , goldenPir "fmapDefaultTest" fmapDefaultTest ] class Sized a where diff --git a/plutus-tx-plugin/test/Spec.hs b/plutus-tx-plugin/test/Spec.hs index 5847ced49e5..a389f2bf375 100644 --- a/plutus-tx-plugin/test/Spec.hs +++ b/plutus-tx-plugin/test/Spec.hs @@ -14,32 +14,31 @@ import Plugin.Spec qualified as Plugin import ShortCircuit.Spec qualified as ShortCircuit import StdLib.Spec qualified as Lib import Strictness.Spec qualified as Strictness -import Test.Tasty (defaultMain, testGroup) -import Test.Tasty.Extras (TestNested, runTestNestedIn) +import Test.Tasty (TestTree, defaultMain) +import Test.Tasty.Extras (embed, runTestNested) import TH.Spec qualified as TH import Unicode.Spec qualified as Unicode main :: IO () -main = defaultMain $ runTestNestedIn ["test"] tests +main = defaultMain tests -tests :: TestNested +tests :: TestTree tests = - testGroup "tests" - <$> sequence - [ Plugin.tests - , IntegerLiterals.NoStrict.NegativeLiterals.Spec.tests - , IntegerLiterals.NoStrict.NoNegativeLiterals.Spec.tests - , IntegerLiterals.Strict.NegativeLiterals.Spec.tests - , IntegerLiterals.Strict.NoNegativeLiterals.Spec.tests - , IsData.tests - , Lift.tests - , TH.tests - , Lib.tests - , Budget.tests - , AsData.Budget.tests - , Optimization.tests - , pure ShortCircuit.tests - , Strictness.tests - , Blueprint.Tests.goldenTests - , pure Unicode.tests - ] + runTestNested ["test"] + [ Plugin.tests + , IntegerLiterals.NoStrict.NegativeLiterals.Spec.tests + , IntegerLiterals.NoStrict.NoNegativeLiterals.Spec.tests + , IntegerLiterals.Strict.NegativeLiterals.Spec.tests + , IntegerLiterals.Strict.NoNegativeLiterals.Spec.tests + , IsData.tests + , Lift.tests + , TH.tests + , Lib.tests + , Budget.tests + , AsData.Budget.tests + , Optimization.tests + , embed ShortCircuit.tests + , Strictness.tests + , Blueprint.Tests.goldenTests + , embed Unicode.tests + ] diff --git a/plutus-tx-plugin/test/StdLib/Spec.hs b/plutus-tx-plugin/test/StdLib/Spec.hs index 502e1659162..8d45fee88f4 100644 --- a/plutus-tx-plugin/test/StdLib/Spec.hs +++ b/plutus-tx-plugin/test/StdLib/Spec.hs @@ -20,7 +20,7 @@ import Hedgehog (MonadGen, Property) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import PlutusCore.Test (TestNested, goldenUEval, testNestedGhc) +import PlutusCore.Test (TestNested, embed, goldenUEval, testNested, testNestedGhc) import PlutusTx.Test (goldenPir) import Test.Tasty (TestName) import Test.Tasty.Hedgehog (testPropertyNamed) @@ -45,15 +45,15 @@ roundPlc = plc (Proxy @"roundPlc") Ratio.round tests :: TestNested tests = - testNestedGhc "StdLib" + testNested "StdLib" . pure $ testNestedGhc [ goldenUEval "ratioInterop" [ getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (Ratio.fromGHC 3.75)) ] , testRatioProperty "round" Ratio.round round , testRatioProperty "truncate" Ratio.truncate truncate , testRatioProperty "abs" (fmap Ratio.toGHC Ratio.abs) abs - , pure $ testPropertyNamed "ord" "testOrd" testOrd - , pure $ testPropertyNamed "divMod" "testDivMod" testDivMod - , pure $ testPropertyNamed "quotRem" "testQuotRem" testQuotRem - , pure $ testPropertyNamed "Eq @Data" "eqData" eqData + , embed $ testPropertyNamed "ord" "testOrd" testOrd + , embed $ testPropertyNamed "divMod" "testDivMod" testDivMod + , embed $ testPropertyNamed "quotRem" "testQuotRem" testQuotRem + , embed $ testPropertyNamed "Eq @Data" "eqData" eqData , goldenPir "errorTrace" errorTrace ] @@ -67,7 +67,7 @@ tryHard :: (MonadIO m, NFData a) => a -> m (Maybe a) tryHard ~a = reoption <$> (liftIO $ try @SomeException $ evaluate $ force a) testRatioProperty :: (Show a, Eq a) => TestName -> (Ratio.Rational -> a) -> (Rational -> a) -> TestNested -testRatioProperty nm plutusFunc ghcFunc = pure $ testPropertyNamed nm (fromString nm) $ Hedgehog.property $ do +testRatioProperty nm plutusFunc ghcFunc = embed $ testPropertyNamed nm (fromString nm) $ Hedgehog.property $ do rat <- Hedgehog.forAll $ Gen.realFrac_ (Range.linearFrac (-10000) 100000) let ghcResult = ghcFunc rat plutusResult = plutusFunc $ Ratio.fromGHC rat diff --git a/plutus-tx-plugin/test/Strictness/Spec.hs b/plutus-tx-plugin/test/Strictness/Spec.hs index 29ad1e3ea98..6191122eaa0 100644 --- a/plutus-tx-plugin/test/Strictness/Spec.hs +++ b/plutus-tx-plugin/test/Strictness/Spec.hs @@ -15,8 +15,7 @@ import PlutusTx.TH (compile) tests :: TestNested tests = - testNestedGhc - "Strictness" + testNested "Strictness" . pure $ testNestedGhc [ goldenEvalCekCatch "lambda-default" [lambdaDefault `unsafeApplyCode` bot] , goldenPirReadable "lambda-default" lambdaDefault , goldenUPlcReadable "lambda-default" lambdaDefault diff --git a/plutus-tx-plugin/test/TH/Spec.hs b/plutus-tx-plugin/test/TH/Spec.hs index b6d78c1940b..5b0de5f5d14 100644 --- a/plutus-tx-plugin/test/TH/Spec.hs +++ b/plutus-tx-plugin/test/TH/Spec.hs @@ -36,18 +36,18 @@ someData :: (BuiltinData, BuiltinData, BuiltinData) someData = (toBuiltinData (One 1), toBuiltinData Two, toBuiltinData (Three ())) tests :: TestNested -tests = testNestedGhc "TH" - [ goldenPir "simple" simple - , goldenPir "power" powerPlc - , goldenPir "and" andPlc - , goldenEvalCek "all" [allPlc] - , goldenEvalCek "convertString" [convertString] - , goldenEvalCekLog "traceDirect" [traceDirect] - , goldenEvalCekLog "tracePrelude" [tracePrelude] - , goldenEvalCekLog "traceRepeatedly" [traceRepeatedly] - -- want to see the raw structure, so using Show - , nestedGoldenVsDoc "someData" "" (pretty $ Haskell.show someData) - ] +tests = testNested "TH" . pure $ testNestedGhc + [ goldenPir "simple" simple + , goldenPir "power" powerPlc + , goldenPir "and" andPlc + , goldenEvalCek "all" [allPlc] + , goldenEvalCek "convertString" [convertString] + , goldenEvalCekLog "traceDirect" [traceDirect] + , goldenEvalCekLog "tracePrelude" [tracePrelude] + , goldenEvalCekLog "traceRepeatedly" [traceRepeatedly] + -- want to see the raw structure, so using Show + , nestedGoldenVsDoc "someData" "" (pretty $ Haskell.show someData) + ] simple :: CompiledCode (Bool -> Integer) simple = $$(compile [|| \(x::Bool) -> if x then (1::Integer) else (2::Integer) ||]) diff --git a/plutus-tx-plugin/test/size/Main.hs b/plutus-tx-plugin/test/size/Main.hs index 98b5167d589..19ff5982f0d 100644 --- a/plutus-tx-plugin/test/size/Main.hs +++ b/plutus-tx-plugin/test/size/Main.hs @@ -11,64 +11,64 @@ import PlutusTx.Ratio qualified as PlutusRatio import PlutusTx.Test import PlutusTx.TH (compile) import Prelude -import Test.Tasty (TestTree, defaultMain, testGroup) -import Test.Tasty.Extras (TestNested, runTestNestedIn) - -runTestNested :: TestNested -> TestTree -runTestNested = runTestNestedIn ["test", "size"] +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.Extras (runTestNested, testNested) main :: IO () -main = defaultMain . testGroup "Size regression tests" $ [ - testGroup "Rational" [ - testGroup "Eq" [ - runTestNested $ goldenSize "equal" ratEq, - runTestNested $ goldenSize "not-equal" ratNeq - ], - testGroup "Ord" [ - runTestNested $ goldenSize "compare" ratCompare, - runTestNested $ goldenSize "less-than-equal" ratLe, - runTestNested $ goldenSize "greater-than-equal" ratGe, - runTestNested $ goldenSize "less-than" ratLt, - runTestNested $ goldenSize "greater-than" ratGt, - runTestNested $ goldenSize "max" ratMax, - runTestNested $ goldenSize "min" ratMin - ], - testGroup "Additive" [ - runTestNested $ goldenSize "plus" ratPlus, - runTestNested $ goldenSize "zero" ratZero, - runTestNested $ goldenSize "minus" ratMinus, - runTestNested $ goldenSize "negate-specialized" ratNegate - ], - testGroup "Multiplicative" [ - runTestNested $ goldenSize "times" ratTimes, - runTestNested $ goldenSize "one" ratOne, - runTestNested $ goldenSize "scale" ratScale - ], - testGroup "Serialization" [ - runTestNested $ goldenSize "toBuiltinData" ratToBuiltin, - runTestNested $ goldenSize "fromBuiltinData" ratFromBuiltin, - runTestNested $ goldenSize "unsafeFromBuiltinData" ratUnsafeFromBuiltin - ], - testGroup "Construction" [ - runTestNested $ goldenSize "unsafeRatio" ratMkUnsafe, - runTestNested $ goldenSize "ratio" ratMkSafe, - runTestNested $ goldenSize "fromInteger" ratFromInteger - ], - testGroup "Other" [ - runTestNested $ goldenSize "numerator" ratNumerator, - runTestNested $ goldenSize "denominator" ratDenominator, - runTestNested $ goldenSize "round" ratRound, - runTestNested $ goldenSize "truncate" ratTruncate, - runTestNested $ goldenSize "properFraction" ratProperFraction, - runTestNested $ goldenSize "recip" ratRecip, - runTestNested $ goldenSize "abs-specialized" ratAbs - ], - testGroup "Comparison" [ - fitsUnder "negate" ("specialized", ratNegate) ("general", genNegate), - fitsUnder "abs" ("specialized", ratAbs) ("general", genAbs), - fitsUnder "scale" ("type class method", ratScale) ("equivalent in other primitives", genScale) +main = defaultMain $ testGroup "Size regression tests" + [ runTestNested ["test", "size", "Golden"] + [ testNested "Rational" + [ testNested "Eq" + [ goldenSize "equal" ratEq + , goldenSize "not-equal" ratNeq + ] + , testNested "Ord" + [ goldenSize "compare" ratCompare + , goldenSize "less-than-equal" ratLe + , goldenSize "greater-than-equal" ratGe + , goldenSize "less-than" ratLt + , goldenSize "greater-than" ratGt + , goldenSize "max" ratMax + , goldenSize "min" ratMin + ] + , testNested "Additive" + [ goldenSize "plus" ratPlus + , goldenSize "zero" ratZero + , goldenSize "minus" ratMinus + , goldenSize "negate-specialized" ratNegate + ] + , testNested "Multiplicative" + [ goldenSize "times" ratTimes + , goldenSize "one" ratOne + , goldenSize "scale" ratScale + ] + , testNested "Serialization" + [ goldenSize "toBuiltinData" ratToBuiltin + , goldenSize "fromBuiltinData" ratFromBuiltin + , goldenSize "unsafeFromBuiltinData" ratUnsafeFromBuiltin + ] + , testNested "Construction" + [ goldenSize "unsafeRatio" ratMkUnsafe + , goldenSize "ratio" ratMkSafe + , goldenSize "fromInteger" ratFromInteger + ] + , testNested "Other" + [ goldenSize "numerator" ratNumerator + , goldenSize "denominator" ratDenominator + , goldenSize "round" ratRound + , goldenSize "truncate" ratTruncate + , goldenSize "properFraction" ratProperFraction + , goldenSize "recip" ratRecip + , goldenSize "abs-specialized" ratAbs + ] + ] + ] + , testGroup "Comparison" + [ fitsUnder "negate" ("specialized", ratNegate) ("general", genNegate) + , fitsUnder "abs" ("specialized", ratAbs) ("general", genAbs) + , fitsUnder "scale" ("type class method", ratScale) + ("equivalent in other primitives", genScale) ] - ] ] -- Compiled definitions diff --git a/plutus-tx-plugin/test/size/abs-specialized.size.golden b/plutus-tx-plugin/test/size/abs-specialized.size.golden deleted file mode 100644 index 978b4e8e518..00000000000 --- a/plutus-tx-plugin/test/size/abs-specialized.size.golden +++ /dev/null @@ -1 +0,0 @@ -26 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/compare.size.golden b/plutus-tx-plugin/test/size/compare.size.golden deleted file mode 100644 index 8783e305111..00000000000 --- a/plutus-tx-plugin/test/size/compare.size.golden +++ /dev/null @@ -1 +0,0 @@ -53 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/denominator.size.golden b/plutus-tx-plugin/test/size/denominator.size.golden deleted file mode 100644 index 62f9457511f..00000000000 --- a/plutus-tx-plugin/test/size/denominator.size.golden +++ /dev/null @@ -1 +0,0 @@ -6 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/equal.size.golden b/plutus-tx-plugin/test/size/equal.size.golden deleted file mode 100644 index dce6588ca14..00000000000 --- a/plutus-tx-plugin/test/size/equal.size.golden +++ /dev/null @@ -1 +0,0 @@ -36 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/fromBuiltinData.size.golden b/plutus-tx-plugin/test/size/fromBuiltinData.size.golden deleted file mode 100644 index 387c46fdec8..00000000000 --- a/plutus-tx-plugin/test/size/fromBuiltinData.size.golden +++ /dev/null @@ -1 +0,0 @@ -346 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/fromInteger.size.golden b/plutus-tx-plugin/test/size/fromInteger.size.golden deleted file mode 100644 index bf0d87ab1b2..00000000000 --- a/plutus-tx-plugin/test/size/fromInteger.size.golden +++ /dev/null @@ -1 +0,0 @@ -4 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/greater-than-equal.size.golden b/plutus-tx-plugin/test/size/greater-than-equal.size.golden deleted file mode 100644 index 8580e7b684b..00000000000 --- a/plutus-tx-plugin/test/size/greater-than-equal.size.golden +++ /dev/null @@ -1 +0,0 @@ -30 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/greater-than.size.golden b/plutus-tx-plugin/test/size/greater-than.size.golden deleted file mode 100644 index 8580e7b684b..00000000000 --- a/plutus-tx-plugin/test/size/greater-than.size.golden +++ /dev/null @@ -1 +0,0 @@ -30 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/less-than-equal.size.golden b/plutus-tx-plugin/test/size/less-than-equal.size.golden deleted file mode 100644 index 8580e7b684b..00000000000 --- a/plutus-tx-plugin/test/size/less-than-equal.size.golden +++ /dev/null @@ -1 +0,0 @@ -30 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/less-than.size.golden b/plutus-tx-plugin/test/size/less-than.size.golden deleted file mode 100644 index 8580e7b684b..00000000000 --- a/plutus-tx-plugin/test/size/less-than.size.golden +++ /dev/null @@ -1 +0,0 @@ -30 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/max.size.golden b/plutus-tx-plugin/test/size/max.size.golden deleted file mode 100644 index dc7b54ad014..00000000000 --- a/plutus-tx-plugin/test/size/max.size.golden +++ /dev/null @@ -1 +0,0 @@ -33 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/min.size.golden b/plutus-tx-plugin/test/size/min.size.golden deleted file mode 100644 index dc7b54ad014..00000000000 --- a/plutus-tx-plugin/test/size/min.size.golden +++ /dev/null @@ -1 +0,0 @@ -33 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/minus.size.golden b/plutus-tx-plugin/test/size/minus.size.golden deleted file mode 100644 index 9f728587959..00000000000 --- a/plutus-tx-plugin/test/size/minus.size.golden +++ /dev/null @@ -1 +0,0 @@ -88 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/negate-specialized.size.golden b/plutus-tx-plugin/test/size/negate-specialized.size.golden deleted file mode 100644 index 3cacc0b93c9..00000000000 --- a/plutus-tx-plugin/test/size/negate-specialized.size.golden +++ /dev/null @@ -1 +0,0 @@ -12 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/not-equal.size.golden b/plutus-tx-plugin/test/size/not-equal.size.golden deleted file mode 100644 index f70d7bba4ae..00000000000 --- a/plutus-tx-plugin/test/size/not-equal.size.golden +++ /dev/null @@ -1 +0,0 @@ -42 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/numerator.size.golden b/plutus-tx-plugin/test/size/numerator.size.golden deleted file mode 100644 index 62f9457511f..00000000000 --- a/plutus-tx-plugin/test/size/numerator.size.golden +++ /dev/null @@ -1 +0,0 @@ -6 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/one.size.golden b/plutus-tx-plugin/test/size/one.size.golden deleted file mode 100644 index e440e5c8425..00000000000 --- a/plutus-tx-plugin/test/size/one.size.golden +++ /dev/null @@ -1 +0,0 @@ -3 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/plus.size.golden b/plutus-tx-plugin/test/size/plus.size.golden deleted file mode 100644 index 9f728587959..00000000000 --- a/plutus-tx-plugin/test/size/plus.size.golden +++ /dev/null @@ -1 +0,0 @@ -88 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/properFraction.size.golden b/plutus-tx-plugin/test/size/properFraction.size.golden deleted file mode 100644 index 25bf17fc5aa..00000000000 --- a/plutus-tx-plugin/test/size/properFraction.size.golden +++ /dev/null @@ -1 +0,0 @@ -18 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/ratio.size.golden b/plutus-tx-plugin/test/size/ratio.size.golden deleted file mode 100644 index 4a8d924028a..00000000000 --- a/plutus-tx-plugin/test/size/ratio.size.golden +++ /dev/null @@ -1 +0,0 @@ -174 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/recip.size.golden b/plutus-tx-plugin/test/size/recip.size.golden deleted file mode 100644 index abc4eff6ac8..00000000000 --- a/plutus-tx-plugin/test/size/recip.size.golden +++ /dev/null @@ -1 +0,0 @@ -46 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/round.size.golden b/plutus-tx-plugin/test/size/round.size.golden deleted file mode 100644 index 80060720898..00000000000 --- a/plutus-tx-plugin/test/size/round.size.golden +++ /dev/null @@ -1 +0,0 @@ -272 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/scale.size.golden b/plutus-tx-plugin/test/size/scale.size.golden deleted file mode 100644 index 8c0474e3239..00000000000 --- a/plutus-tx-plugin/test/size/scale.size.golden +++ /dev/null @@ -1 +0,0 @@ -69 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/times.size.golden b/plutus-tx-plugin/test/size/times.size.golden deleted file mode 100644 index e3f1e9b791c..00000000000 --- a/plutus-tx-plugin/test/size/times.size.golden +++ /dev/null @@ -1 +0,0 @@ -80 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/toBuiltinData.size.golden b/plutus-tx-plugin/test/size/toBuiltinData.size.golden deleted file mode 100644 index cabf43b5ddf..00000000000 --- a/plutus-tx-plugin/test/size/toBuiltinData.size.golden +++ /dev/null @@ -1 +0,0 @@ -24 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/truncate.size.golden b/plutus-tx-plugin/test/size/truncate.size.golden deleted file mode 100644 index 9a037142aa3..00000000000 --- a/plutus-tx-plugin/test/size/truncate.size.golden +++ /dev/null @@ -1 +0,0 @@ -10 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/unsafeFromBuiltinData.size.golden b/plutus-tx-plugin/test/size/unsafeFromBuiltinData.size.golden deleted file mode 100644 index cb37cb5c1fb..00000000000 --- a/plutus-tx-plugin/test/size/unsafeFromBuiltinData.size.golden +++ /dev/null @@ -1 +0,0 @@ -186 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/unsafeRatio.size.golden b/plutus-tx-plugin/test/size/unsafeRatio.size.golden deleted file mode 100644 index 97e35041104..00000000000 --- a/plutus-tx-plugin/test/size/unsafeRatio.size.golden +++ /dev/null @@ -1 +0,0 @@ -110 \ No newline at end of file diff --git a/plutus-tx-plugin/test/size/zero.size.golden b/plutus-tx-plugin/test/size/zero.size.golden deleted file mode 100644 index e440e5c8425..00000000000 --- a/plutus-tx-plugin/test/size/zero.size.golden +++ /dev/null @@ -1 +0,0 @@ -3 \ No newline at end of file diff --git a/plutus-tx/plutus-tx.cabal b/plutus-tx/plutus-tx.cabal index 5f2977d26dc..f3c529220d9 100644 --- a/plutus-tx/plutus-tx.cabal +++ b/plutus-tx/plutus-tx.cabal @@ -209,6 +209,7 @@ test-suite plutus-tx-test , hedgehog , hedgehog-fn , lens + , mtl , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.27 , plutus-tx ^>=1.27 , pretty-show @@ -217,4 +218,3 @@ test-suite plutus-tx-test , tasty-hedgehog , tasty-hunit , text - , transformers diff --git a/plutus-tx/src/PlutusTx/Lift.hs b/plutus-tx/src/PlutusTx/Lift.hs index 01530ca9b4d..acff1543917 100644 --- a/plutus-tx/src/PlutusTx/Lift.hs +++ b/plutus-tx/src/PlutusTx/Lift.hs @@ -220,7 +220,7 @@ typeCheckAgainst -> m () typeCheckAgainst p (PLC.Program _ v plcTerm) = do -- See Note [Checking the type of a term with Typeable] - term <- PIR.embed <$> PLC.rename plcTerm + term <- PIR.embedTerm <$> PLC.rename plcTerm -- We need to run Def *before* applying to the term, otherwise we may refer to abstract -- types and we won't match up with the term. idFun <- liftQuote $ runDefT () $ do diff --git a/plutus-tx/test/Show/gadt.show.golden b/plutus-tx/test/Show/Golden/gadt.show.golden similarity index 100% rename from plutus-tx/test/Show/gadt.show.golden rename to plutus-tx/test/Show/Golden/gadt.show.golden diff --git a/plutus-tx/test/Show/infix-type-2.show.golden b/plutus-tx/test/Show/Golden/infix-type-2.show.golden similarity index 100% rename from plutus-tx/test/Show/infix-type-2.show.golden rename to plutus-tx/test/Show/Golden/infix-type-2.show.golden diff --git a/plutus-tx/test/Show/infix-type.show.golden b/plutus-tx/test/Show/Golden/infix-type.show.golden similarity index 100% rename from plutus-tx/test/Show/infix-type.show.golden rename to plutus-tx/test/Show/Golden/infix-type.show.golden diff --git a/plutus-tx/test/Show/poly.show.golden b/plutus-tx/test/Show/Golden/poly.show.golden similarity index 100% rename from plutus-tx/test/Show/poly.show.golden rename to plutus-tx/test/Show/Golden/poly.show.golden diff --git a/plutus-tx/test/Show/product-type-2.show.golden b/plutus-tx/test/Show/Golden/product-type-2.show.golden similarity index 100% rename from plutus-tx/test/Show/product-type-2.show.golden rename to plutus-tx/test/Show/Golden/product-type-2.show.golden diff --git a/plutus-tx/test/Show/product-type.show.golden b/plutus-tx/test/Show/Golden/product-type.show.golden similarity index 100% rename from plutus-tx/test/Show/product-type.show.golden rename to plutus-tx/test/Show/Golden/product-type.show.golden diff --git a/plutus-tx/test/Show/record-type.show.golden b/plutus-tx/test/Show/Golden/record-type.show.golden similarity index 100% rename from plutus-tx/test/Show/record-type.show.golden rename to plutus-tx/test/Show/Golden/record-type.show.golden diff --git a/plutus-tx/test/Show/sum-type-1.show.golden b/plutus-tx/test/Show/Golden/sum-type-1.show.golden similarity index 100% rename from plutus-tx/test/Show/sum-type-1.show.golden rename to plutus-tx/test/Show/Golden/sum-type-1.show.golden diff --git a/plutus-tx/test/Show/sum-type-2.show.golden b/plutus-tx/test/Show/Golden/sum-type-2.show.golden similarity index 100% rename from plutus-tx/test/Show/sum-type-2.show.golden rename to plutus-tx/test/Show/Golden/sum-type-2.show.golden diff --git a/plutus-tx/test/Show/Spec.hs b/plutus-tx/test/Show/Spec.hs index e0cd9d00b79..f79086075b7 100644 --- a/plutus-tx/test/Show/Spec.hs +++ b/plutus-tx/test/Show/Spec.hs @@ -9,7 +9,7 @@ import PlutusTx.Builtins import PlutusTx.Builtins.Internal qualified as BI import PlutusTx.Show -import Control.Monad.Trans.Reader as Reader +import Control.Monad.Reader as Reader import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Char8 qualified as Char8 import Data.Text qualified as Text @@ -41,7 +41,7 @@ goldenShow :: forall a. Show a => TestName -> a -> TestNested goldenShow name x = do path <- ask let fp = foldr () (name ++ ".show.golden") path - pure $ goldenVsText name fp . fromBuiltin $ show x + embed $ goldenVsText name fp . fromBuiltin $ show x data ProductD = ProductC Integer [Bool] deriveShow ''ProductD @@ -70,8 +70,7 @@ deriveShow ''GadtD propertyTests :: TestTree propertyTests = - testGroup - "PlutusTx.Show property-based tests" + testGroup "PlutusTx.Show property-based tests" [ testPropertyNamed "PlutusTx.Show @Integer" "PlutusTx.Show @Integer" @@ -82,10 +81,9 @@ propertyTests = showByteStringBase16 ] -goldenTests :: TestNested +goldenTests :: TestTree goldenTests = - testNested - "Show" + runTestNested ["test", "Show", "Golden"] [ goldenShow "product-type" (ProductC 3 [True, False]) , goldenShow "product-type-2" ((:-:) [-300] False) , goldenShow "sum-type-1" SumC1 diff --git a/plutus-tx/test/Spec.hs b/plutus-tx/test/Spec.hs index a3616397edd..00bd78c9f59 100644 --- a/plutus-tx/test/Spec.hs +++ b/plutus-tx/test/Spec.hs @@ -28,7 +28,6 @@ import Prelude hiding (Enum (..), Rational, negate, recip) import Rational.Laws (lawsTests) import Show.Spec qualified import Test.Tasty (TestTree, defaultMain, testGroup) -import Test.Tasty.Extras (runTestNestedIn) import Test.Tasty.Hedgehog (testPropertyNamed) import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) @@ -45,7 +44,7 @@ tests = testGroup "plutus-tx" [ , listTests , lawsTests , Show.Spec.propertyTests - , runTestNestedIn ["test"] Show.Spec.goldenTests + , Show.Spec.goldenTests , Blueprint.Definition.Spec.tests ] From 3ce6337d130db8a6bd0f68966c7f787966feb6e7 Mon Sep 17 00:00:00 2001 From: effectfully Date: Tue, 21 May 2024 14:33:09 +0200 Subject: [PATCH 2/2] Add comments --- .../plutus-core/test/TypeSynthesis/Spec.hs | 1 + plutus-core/testlib/Test/Tasty/Extras.hs | 20 +++++++++++++------ 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs b/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs index 874e2d29cae..b07512262cc 100644 --- a/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs +++ b/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs @@ -125,6 +125,7 @@ test_typecheckIllTyped = TypeErrorE (NameMismatch {}) -> True _ -> False ] + test_typecheckAllFun :: forall fun. (ToBuiltinMeaning DefaultUni fun, Show fun, Show (BuiltinSemanticsVariant fun)) => String diff --git a/plutus-core/testlib/Test/Tasty/Extras.hs b/plutus-core/testlib/Test/Tasty/Extras.hs index 59bee564d3c..86e183241ee 100644 --- a/plutus-core/testlib/Test/Tasty/Extras.hs +++ b/plutus-core/testlib/Test/Tasty/Extras.hs @@ -138,16 +138,15 @@ instance unit ~ () => Semigroup (TestNestedM unit) where instance unit ~ () => Monoid (TestNestedM unit) where mempty = pure () --- | Run a 'TestTree' of tests with a given name prefix. This doesn't actually run the tests: --- instead it runs a computation in the Reader monad. +-- | Run a 'TestNested' computation to produce a 'TestTree' (without actually executing the tests). runTestNestedM :: [String] -> TestNested -> TestTree runTestNestedM [] _ = error "Path cannot be empty" runTestNestedM path test = testGroup (last path) . toList $ runReaderT (unTestNestedM test) path -- | Descend into a folder. testNestedNamedM - :: FilePath -- ^ The folder. - -> String -- ^ The name of the test to render in CLI. + :: FilePath -- ^ The name of the folder. + -> String -- ^ The name of the test group to render in CLI. -> TestNested -> TestNested testNestedNamedM folderName testName @@ -156,7 +155,7 @@ testNestedNamedM folderName testName . mapReaderT (nestWith $ testGroup testName) . unTestNestedM --- | Descend into a folder. +-- | Descend into a folder for a 'TestNested' computation. testNestedM :: FilePath -> TestNested -> TestNested testNestedM folderName = testNestedNamedM folderName folderName @@ -164,15 +163,24 @@ testNestedM folderName = testNestedNamedM folderName folderName testNestedGhcM :: TestNested -> TestNested testNestedGhcM = testNestedM ghcVersion +-- | Run a list of 'TestNested' computation to produce a 'TestTree' (without actually executing the +-- tests). runTestNested :: [String] -> [TestNested] -> TestTree runTestNested path = runTestNestedM path . fold -testNestedNamed :: FilePath -> String -> [TestNested] -> TestNested +-- | Descend into a folder for a list of tests. +testNestedNamed + :: FilePath -- ^ The name of the folder. + -> String -- ^ The name of the test group to render in CLI. + -> [TestNested] + -> TestNested testNestedNamed folderName testName = testNestedNamedM folderName testName . fold +-- | Descend into a folder for a list of 'TestNested' computations. testNested :: FilePath -> [TestNested] -> TestNested testNested folderName = testNestedM folderName . fold +-- | Like 'testNested' but adds a subdirectory corresponding to the GHC version being used. testNestedGhc :: [TestNested] -> TestNested testNestedGhc = testNestedGhcM . fold