Allowing backwards compatibility with ds-test

cli/cli.hs

@@ -78,6 +78,7 @@ data Command w
   -- symbolic execution opts
       , root          :: w ::: Maybe String       <?> "Path to  project root directory (default: . )"
       , projectType   :: w ::: Maybe ProjectType  <?> "Is this a CombinedJSON or Foundry project (default: Foundry)"
+      , dsTest        :: w ::: Bool               <?> "Check the fail bit set by ds-test"
       , initialStorage :: w ::: Maybe (InitialStorage) <?> "Starting state for storage: Empty, Abstract (default Abstract)"
       , sig           :: w ::: Maybe Text         <?> "Signature of types to decode / encode"
       , arg           :: w ::: [String]           <?> "Values to encode"
@@ -148,10 +149,12 @@ data Command w
       , block       :: w ::: Maybe W256        <?> "Block state is be fetched from"
       , root        :: w ::: Maybe String      <?> "Path to  project root directory (default: . )"
       , projectType :: w ::: Maybe ProjectType <?> "Is this a CombinedJSON or Foundry project (default: Foundry)"
+      , dsTest      :: w ::: Bool              <?> "Check the fail bit set by ds-test"
       }
   | Test -- Run Foundry unit tests
       { root        :: w ::: Maybe String               <?> "Path to  project root directory (default: . )"
       , projectType   :: w ::: Maybe ProjectType        <?> "Is this a CombinedJSON or Foundry project (default: Foundry)"
+      , dsTest        :: w ::: Bool                     <?> "Check the fail bit set by ds-test"
       , rpc           :: w ::: Maybe URL                <?> "Fetch state from a remote node"
       , number        :: w ::: Maybe W256               <?> "Block: number"
       , verbose       :: w ::: Maybe Int                <?> "Append call trace: {1} failures {2} all"
@@ -304,7 +307,7 @@ getSrcInfo cmd = do
       buildOutput <- runEnv Env {config = conf} $ readBuildOutput root (getProjectType cmd)
       case buildOutput of
         Left _ -> pure emptyDapp
-        Right o -> pure $ dappInfo root o
+        Right o -> pure $ dappInfo False root o
     else pure emptyDapp
 
 getProjectType :: Command Options.Unwrapped -> ProjectType
@@ -674,6 +677,7 @@ unitTestOptions cmd solvers buildOutput = do
     , testParams = params
     , dapp = srcInfo
     , ffiAllowed = cmd.ffi
+    , checkFailBit = cmd.dsTest
     }
 parseInitialStorage :: InitialStorage -> BaseState
 parseInitialStorage Empty = EmptyBase

src/EVM/UnitTest.hs

@@ -56,6 +56,7 @@ data UnitTestOptions s = UnitTestOptions
   , dapp        :: DappInfo
   , testParams  :: TestVMParams
   , ffiAllowed  :: Bool
+  , checkFailBit:: Bool
   }
 
 data TestVMParams = TestVMParams
@@ -199,12 +200,16 @@ symRun opts@UnitTestOptions{..} vm (Sig testName types) = do
         shouldFail = "proveFail" `isPrefixOf` callSig
 
     -- define postcondition depending on `shouldFail`
-    let postcondition = curry $ case shouldFail of
+    let testContract store = fromMaybe (internalError "test contract not found in state") (Map.lookup vm.state.contract store)
+        failed store = case Map.lookup cheatCode store of
+          Just cheatContract -> Expr.readStorage' (Lit 0x6661696c65640000000000000000000000000000000000000000000000000000) cheatContract.storage .== Lit 1
+          Nothing -> And (Expr.readStorage' (Lit 0) (testContract store).storage) (Lit 2) .== Lit 2
+        postcondition = curry $ case shouldFail of
           True -> \(_, post) -> case post of
-            Success {} -> PBool False
+            Success _ _ _ store -> if opts.checkFailBit then failed store else PBool False
             _ -> PBool True
           False -> \(_, post) -> case post of
-            Success _ _ _ _ -> PBool True
+            Success _ _ _ store -> if opts.checkFailBit then PNeg (failed store) else PBool True
             Failure _ _ (Revert msg) -> case msg of
               ConcreteBuf b ->
                 if (BS.isPrefixOf (selector "Error(string)") b) || b == panicMsg 0x01 then PBool False

test/EVM/Test/Utils.hs

@@ -59,6 +59,7 @@ testOpts solvers root buildOutput match maxIter allowFFI rpcinfo = do
     , testParams = params
     , dapp = srcInfo
     , ffiAllowed = allowFFI
+    , checkFailBit = False
     }
 
 processFailedException :: String -> String -> [String] -> Int -> IO a