From 71aa8b197c20ea163c1528e8a1fafba7a17a0c38 Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis Date: Thu, 2 Oct 2025 13:36:09 +0200 Subject: [PATCH] A QoL improvement for `cabal test plutus-core --test-options=--accept` --- plutus-core/executables/traceToStacks/TestGetStacks.hs | 3 ++- plutus-core/flat/test/Big.hs | 3 ++- plutus-core/flat/test/Spec.hs | 7 ++----- plutus-core/index-envs/test/Spec.hs | 3 ++- plutus-core/plutus-core.cabal | 10 ++++++++-- plutus-core/satint/test/TestSatInt.hs | 3 ++- plutus-core/testlib/System/Environment/IgnoreAccept.hs | 10 ++++++++++ 7 files changed, 28 insertions(+), 11 deletions(-) create mode 100644 plutus-core/testlib/System/Environment/IgnoreAccept.hs diff --git a/plutus-core/executables/traceToStacks/TestGetStacks.hs b/plutus-core/executables/traceToStacks/TestGetStacks.hs index 5d18ab86a7e..1280e7ade41 100644 --- a/plutus-core/executables/traceToStacks/TestGetStacks.hs +++ b/plutus-core/executables/traceToStacks/TestGetStacks.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} import Common +import System.Environment.IgnoreAccept import Test.Tasty (defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) @@ -76,7 +77,7 @@ kInyzInxStackVals = [ ] main :: IO () -main = defaultMain $ testGroup "getStacks tests" [ +main = ignoreAcceptOption $ defaultMain $ testGroup "getStacks tests" [ testCase "x only" (getStacks xEvent @?= xStackVal), testCase "x calls y calling z" (getStacks zInyInxEvent @?= zInyInxStackVals), testCase "x calls y and z" (getStacks yzInxEvent @?= yzInxStackVals), diff --git a/plutus-core/flat/test/Big.hs b/plutus-core/flat/test/Big.hs index add042dc85f..313ed360e35 100644 --- a/plutus-core/flat/test/Big.hs +++ b/plutus-core/flat/test/Big.hs @@ -15,6 +15,7 @@ import PlutusCore.Flat (Decoded, Flat (..), flat, unflat, unflatWith) import PlutusCore.Flat.AsBin (AsBin, unbin) import PlutusCore.Flat.AsSize import PlutusCore.Flat.Decoder (Get, listTDecoder) +import System.Environment.IgnoreAccept import System.TimeIt (timeIt) -- Big is a type that has a small encoded representation but a very large in-memory footprint. @@ -42,7 +43,7 @@ instance Flat Big where decode = newBig <$> decode main :: IO () -main = tbig +main = ignoreAcceptOption tbig tbig = do let numOfBigs = 5 diff --git a/plutus-core/flat/test/Spec.hs b/plutus-core/flat/test/Spec.hs index 522e2e5a067..510d75d7aba 100644 --- a/plutus-core/flat/test/Spec.hs +++ b/plutus-core/flat/test/Spec.hs @@ -33,6 +33,7 @@ import PlutusCore.Flat.Encoder qualified as E import PlutusCore.Flat.Encoder.Prim qualified as E import PlutusCore.Flat.Encoder.Strict qualified as E import PlutusCore.Flat.Endian +import System.Environment.IgnoreAccept import System.Exit import Test.Data import Test.Data.Arbitrary () @@ -87,7 +88,7 @@ mainShow = do mapM_ (\_ -> generate (arbitrary :: Gen Int) >>= print) [1 .. 10] exitFailure -mainTest = defaultMain tests +mainTest = ignoreAcceptOption $ defaultMain tests tests :: TestTree tests = testGroup "Tests" [testPrimitives, testEncDec, testFlat] @@ -794,7 +795,3 @@ prop_common_unsigned n _ = let n2 :: h = fromIntegral n -- b1 :: BLOB UTF8 -- b1 = BLOB UTF8 (preAligned (List255 [97,98,99])) -- -- b1 = BLOB (preAligned (UTF8 (List255 [97,98,99]))) - - - - diff --git a/plutus-core/index-envs/test/Spec.hs b/plutus-core/index-envs/test/Spec.hs index 1988af0fd67..87e6bf5b131 100644 --- a/plutus-core/index-envs/test/Spec.hs +++ b/plutus-core/index-envs/test/Spec.hs @@ -3,7 +3,8 @@ module Main ) where import RAList.Spec qualified as RAList +import System.Environment.IgnoreAccept import Test.Tasty main :: IO () -main = defaultMain RAList.tests +main = ignoreAcceptOption $ defaultMain RAList.tests diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 412c942303c..bbd542ca22c 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -811,6 +811,7 @@ library plutus-core-testlib PlutusIR.Generators.QuickCheck.ShrinkTerms PlutusIR.Pass.Test PlutusIR.Test + System.Environment.IgnoreAccept Test.Tasty.Extras UntypedPlutusCore.Generators.Hedgehog.AST UntypedPlutusCore.Test.DeBruijn.Bad @@ -905,6 +906,7 @@ test-suite traceToStacks-test , base >=4.9 && <5 , bytestring , cassava + , plutus-core:plutus-core-testlib , tasty , tasty-hunit , text @@ -1080,6 +1082,7 @@ test-suite satint-test , base >=4.9 && <5 , HUnit , QuickCheck + , plutus-core:plutus-core-testlib , satint , test-framework , test-framework-hunit @@ -1136,9 +1139,10 @@ test-suite index-envs-test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base >=4.9 && <5 + , QuickCheck , index-envs , nonempty-vector - , QuickCheck + , plutus-core:plutus-core-testlib , quickcheck-instances , tasty , tasty-quickcheck @@ -1241,11 +1245,12 @@ test-suite flat-test build-depends: , base + , QuickCheck , bytestring , containers , deepseq , plutus-core:flat - , QuickCheck + , plutus-core:plutus-core-testlib , quickcheck-text , tasty , tasty-hunit @@ -1268,4 +1273,5 @@ test-suite flat-big-test , bytestring , list-t , plutus-core:flat + , plutus-core:plutus-core-testlib , timeit diff --git a/plutus-core/satint/test/TestSatInt.hs b/plutus-core/satint/test/TestSatInt.hs index 0d39684875a..353a7371de3 100644 --- a/plutus-core/satint/test/TestSatInt.hs +++ b/plutus-core/satint/test/TestSatInt.hs @@ -6,6 +6,7 @@ -- in safeint, since I want to upstream this in due course. module Main where +import System.Environment.IgnoreAccept import Control.Exception as E import Data.List import Data.Maybe @@ -17,7 +18,7 @@ import Test.HUnit as T import Test.QuickCheck main :: IO () -main = defaultMain tests +main = ignoreAcceptOption $ defaultMain tests isArithException :: a -> IO Bool isArithException n = E.catch (n `seq` return False) diff --git a/plutus-core/testlib/System/Environment/IgnoreAccept.hs b/plutus-core/testlib/System/Environment/IgnoreAccept.hs new file mode 100644 index 00000000000..f67ab2b0a90 --- /dev/null +++ b/plutus-core/testlib/System/Environment/IgnoreAccept.hs @@ -0,0 +1,10 @@ +module System.Environment.IgnoreAccept (ignoreAcceptOption) where + +import System.Environment +import Data.List + +-- | Ignores options like --accept and --accept=True from argv +ignoreAcceptOption :: IO a -> IO a +ignoreAcceptOption m = do + args <- getArgs + withArgs (filter (not . isPrefixOf "--accept") args) m