A QoL improvement for cabal test plutus-core --test-options=--accept

Author: bezirg

plutus-core/executables/traceToStacks/TestGetStacks.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Common
+import System.Environment.DropAccept
 import Test.Tasty (defaultMain, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
 
@@ -76,7 +77,7 @@ kInyzInxStackVals = [
     ]
 
 main :: IO ()
-main = defaultMain $ testGroup "getStacks tests" [
+main = dropAcceptOption $ 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),

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.DropAccept
 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 = dropAcceptOption $ tbig
 
 tbig = do
     let numOfBigs = 5

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.DropAccept
 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 = dropAcceptOption $ 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])))
-
-
-
-

plutus-core/index-envs/test/Spec.hs

@@ -2,8 +2,10 @@ module Main
     ( main
     ) where
 
+import Data.List
 import RAList.Spec qualified as RAList
+import System.Environment.DropAccept
 import Test.Tasty
 
 main :: IO ()
-main = defaultMain RAList.tests
+main = dropAcceptOption $ defaultMain RAList.tests

plutus-core/plutus-core.cabal

@@ -811,6 +811,7 @@ library plutus-core-testlib
     PlutusIR.Generators.QuickCheck.ShrinkTerms
     PlutusIR.Pass.Test
     PlutusIR.Test
+    System.Environment.DropAccept
     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

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.DropAccept
 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 = dropAcceptOption $ defaultMain tests
 
 isArithException :: a -> IO Bool
 isArithException n = E.catch (n `seq` return False)

plutus-core/testlib/System/Environment/DropAccept.hs

@@ -0,0 +1,9 @@
+module System.Environment.DropAccept (dropAcceptOption) where
+
+import System.Environment
+import Data.List
+
+-- Drops options like --accept and --accept=True from argv
+dropAcceptOption m = do
+  args <- getArgs
+  withArgs (filter (not . isPrefixOf "--accept") args) m