@@ -14,7 +14,7 @@ import EVM.FeeSchedule (feeSchedule)
14
14
import EVM.Fetch qualified as Fetch
15
15
import EVM.Format
16
16
import EVM.Solidity
17
- import EVM.SymExec (defaultVeriOpts , symCalldata , verify , isQed , extractCex , prettyCalldata , panicMsg , VeriOpts (.. ), flattenExpr , isUnknown , isError , groupIssues )
17
+ import EVM.SymExec (defaultVeriOpts , symCalldata , verify , isCex , extractCex , prettyCalldata , panicMsg , VeriOpts (.. ), flattenExpr , isUnknown , isError , groupIssues , groupPartials , ProofResult ( .. ) )
18
18
import EVM.Types
19
19
import EVM.Transaction (initTx )
20
20
import EVM.Stepper (Stepper )
@@ -113,7 +113,8 @@ makeVeriOpts opts =
113
113
}
114
114
115
115
-- | Top level CLI endpoint for hevm test
116
- unitTest :: App m => UnitTestOptions RealWorld -> Contracts -> m Bool
116
+ -- | Returns tuple of (No Cex, No warnings)
117
+ unitTest :: App m => UnitTestOptions RealWorld -> Contracts -> m (Bool , Bool )
117
118
unitTest opts (Contracts cs) = do
118
119
let unitTestContrs = findUnitTests opts. match $ Map. elems cs
119
120
conf <- readConfig
@@ -122,7 +123,9 @@ unitTest opts (Contracts cs) = do
122
123
let x = map (\ (a,b) -> " --> " <> a <> " --- functions: " <> (Text. pack $ show b)) unitTestContrs
123
124
putStrLn $ unlines $ map Text. unpack x
124
125
results <- concatMapM (runUnitTestContract opts cs) unitTestContrs
125
- pure $ and results
126
+ when conf. debug $ liftIO $ putStrLn $ " unitTest individual results: " <> show results
127
+ let (firsts, seconds) = unzip results
128
+ pure (and firsts, and seconds)
126
129
127
130
-- | Assuming a constructor is loaded, this stepper will run the constructor
128
131
-- to create the test contract, give it an initial balance, and run `setUp()'.
@@ -155,24 +158,20 @@ initializeUnitTest opts theContract = do
155
158
Left e -> pushTrace (ErrorTrace e)
156
159
_ -> popTrace
157
160
161
+ -- Returns tuple of (No Cex, No warnings)
158
162
runUnitTestContract
159
163
:: App m
160
164
=> UnitTestOptions RealWorld
161
165
-> Map Text SolcContract
162
166
-> (Text , [Sig ])
163
- -> m [Bool ]
167
+ -> m [( Bool , Bool ) ]
164
168
runUnitTestContract
165
169
opts@ (UnitTestOptions {.. }) contractMap (name, testSigs) = do
166
-
167
- -- Print a header
168
170
liftIO $ putStrLn $ " Checking " ++ show (length testSigs) ++ " function(s) in contract " ++ unpack name
169
171
170
172
-- Look for the wanted contract by name from the Solidity info
171
173
case Map. lookup name contractMap of
172
- Nothing ->
173
- -- Fail if there's no such contract
174
- internalError $ " Contract " ++ unpack name ++ " not found"
175
-
174
+ Nothing -> internalError $ " Contract " ++ unpack name ++ " not found"
176
175
Just theContract -> do
177
176
-- Construct the initial VM and begin the contract's constructor
178
177
vm0 :: VM Concrete RealWorld <- liftIO $ stToIO $ initialUnitTestVm opts theContract
@@ -184,15 +183,16 @@ runUnitTestContract
184
183
writeTraceDapp dapp vm1
185
184
case vm1. result of
186
185
Just (VMFailure _) -> liftIO $ do
187
- Text. putStrLn " \x1b [31m[BAIL]\x1b [0m setUp() "
188
- tick $ failOutput vm1 opts " setUp()"
189
- pure [False ]
186
+ Text. putStrLn " \x1b [31m[BAIL]\x1b [0m setUp() "
187
+ tick $ indentLines 3 $ failOutput vm1 opts " setUp()"
188
+ pure [( True , False ) ]
190
189
Just (VMSuccess _) -> do
191
190
forM testSigs $ \ s -> symRun opts vm1 s
192
191
_ -> internalError " setUp() did not end with a result"
193
192
194
- -- | Define the thread spawner for symbolic tests
195
- symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m Bool
193
+ -- Define the thread spawner for symbolic tests
194
+ -- Returns tuple of (No Cex, No warnings)
195
+ symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m (Bool , Bool )
196
196
symRun opts@ UnitTestOptions {.. } vm (Sig testName types) = do
197
197
let callSig = testName <> " (" <> (Text. intercalate " ," (map abiTypeSolidity types)) <> " )"
198
198
liftIO $ putStrLn $ " \x1b [96m[RUNNING]\x1b [0m " <> Text. unpack callSig
@@ -227,42 +227,47 @@ symRun opts@UnitTestOptions{..} vm (Sig testName types) = do
227
227
writeTraceDapp dapp vm'
228
228
229
229
-- check postconditions against vm
230
- (e, results) <- verify solvers (makeVeriOpts opts) (symbolify vm') (Just postcondition)
231
- let allReverts = not . (any Expr. isSuccess) . flattenExpr $ e
232
-
230
+ (end, results) <- verify solvers (makeVeriOpts opts) (symbolify vm') (Just postcondition)
231
+ let ends = flattenExpr end
233
232
conf <- readConfig
234
- when conf. debug $ liftIO $ forM_ (filter Expr. isFailure (flattenExpr e) ) $ \ case
233
+ when conf. debug $ liftIO $ forM_ (filter Expr. isFailure ends ) $ \ case
235
234
(Failure _ _ a) -> putStrLn $ " -> debug of func: " <> Text. unpack testName <> " Failure at the end of expr: " <> show a;
236
235
_ -> internalError " cannot be, filtered for failure"
237
- when (any isUnknown results || any isError results) $ liftIO $ do
238
- putStrLn $ " \x1b [33mWARNING\x1b [0m: hevm was only able to partially explore the test " <> Text. unpack testName <> " due to: " ;
239
- forM_ (groupIssues (filter isError results)) $ \ (num, str) -> putStrLn $ " " <> show num <> " x -> " <> str
240
- forM_ (groupIssues (filter isUnknown results)) $ \ (num, str) -> putStrLn $ " " <> show num <> " x -> " <> str
241
236
242
237
-- display results
243
- if all isQed results
244
- then if allReverts && (not shouldFail)
245
- then do
246
- liftIO $ putStr $ " \x1b [31m[FAIL]\x1b [0m " <> Text. unpack testName <> " \n " <> Text. unpack allBranchRev
247
- pure False
248
- else do
249
- liftIO $ putStr $ " \x1b [32m[PASS]\x1b [0m " <> Text. unpack testName <> " \n "
250
- pure True
251
- else do
252
- -- not all is Qed
253
- let x = mapMaybe extractCex results
254
- let y = symFailure opts testName (fst cd) types x
255
- liftIO $ putStr $ " \x1b [31m[FAIL]\x1b [0m " <> Text. unpack testName <> " \n " <> Text. unpack y
256
- pure False
257
-
258
- allBranchRev :: Text
259
- allBranchRev = intercalate " \n "
260
- [ Text. concat $ indentLines 3 <$>
261
- [ " Reason:"
262
- , " No reachable assertion violations, but all branches reverted"
263
- , " Prefix this testname with `proveFail` if this is expected"
264
- ]
265
- ]
238
+ let t = " the test " <> Text. unpack testName
239
+ let warnings = any Expr. isPartial ends || any isUnknown results || any isError results
240
+ let allReverts = not . (any Expr. isSuccess) $ ends
241
+ let unexpectedAllRevert = allReverts && not shouldFail
242
+ when conf. debug $ liftIO $ putStrLn $ " symRun -- (cex,warnings,unexpectedAllRevert): " <> show (any isCex results, warnings, unexpectedAllRevert)
243
+ liftIO $ case (any isCex results, warnings, unexpectedAllRevert) of
244
+ (False , False , False ) -> do
245
+ -- happy case
246
+ putStr $ " \x1b [32m[PASS]\x1b [0m " <> Text. unpack testName <> " \n "
247
+ (True , _, _) -> do
248
+ -- there are counterexamples (and maybe other things, but Cex is most important)
249
+ let x = mapMaybe extractCex results
250
+ y = symFailure opts testName (fst cd) types x
251
+ putStr $ " \x1b [31m[FAIL]\x1b [0m " <> Text. unpack testName <> " \n " <> Text. unpack y
252
+ (_, True , _) -> do
253
+ -- There are errors/unknowns/partials, we fail them
254
+ putStr $ " \x1b [31m[FAIL]\x1b [0m " <> Text. unpack testName <> " \n "
255
+ (_, _, True ) -> do
256
+ -- No cexes/errors/unknowns/partials, but all branches reverted
257
+ putStr $ " \x1b [31m[FAIL]\x1b [0m " <> Text. unpack testName <> " \n "
258
+ <> " No reachable assertion violations, but all branches reverted\n "
259
+ liftIO $ printWarnings ends results t
260
+ pure (not (any isCex results), not (warnings || unexpectedAllRevert))
261
+
262
+ printWarnings :: [Expr 'End] -> [ProofResult a b c String ] -> String -> IO ()
263
+ printWarnings e results testName = do
264
+ when (any isUnknown results || any isError results || any Expr. isPartial e) $ do
265
+ putStrLn $ " \x1b [33m[WARNING]\x1b [0m hevm was only able to partially explore " <> testName <> " due to: " ;
266
+ forM_ (groupIssues (filter isError results)) $ \ (num, str) -> putStrLn $ " " <> show num <> " x -> " <> str
267
+ forM_ (groupIssues (filter isUnknown results)) $ \ (num, str) -> putStrLn $ " " <> show num <> " x -> " <> str
268
+ forM_ (groupPartials e) $ \ (num, str) -> putStrLn $ " " <> show num <> " x -> " <> str
269
+ putStrLn " "
270
+
266
271
symFailure :: UnitTestOptions RealWorld -> Text -> Expr Buf -> [AbiType ] -> [(Expr End , SMTCex )] -> Text
267
272
symFailure UnitTestOptions {.. } testName cd types failures' =
268
273
mconcat
@@ -278,9 +283,9 @@ symFailure UnitTestOptions {..} testName cd types failures' =
278
283
in Text. pack $ prettyvmresult res
279
284
mkMsg (leaf, cex) = intercalate " \n " $
280
285
[" Counterexample:"
281
- ," result: " <> showRes leaf
282
286
," calldata: " <> let ? context = dappContext (traceContext leaf)
283
287
in prettyCalldata cex cd testName types
288
+ ," result: " <> showRes leaf
284
289
] <> verbText leaf
285
290
verbText leaf = case verbose of
286
291
Just _ -> [Text. unlines [ indentLines 2 (showTraceTree' dapp leaf)]]
@@ -323,7 +328,6 @@ failOutput vm UnitTestOptions { .. } testName =
323
328
Just _ -> indentLines 2 (showTraceTree dapp vm)
324
329
_ -> " "
325
330
, indentLines 2 (formatTestLogs dapp. eventMap vm. logs)
326
- , " \n "
327
331
]
328
332
329
333
formatTestLogs :: (? context :: DappContext ) => Map W256 Event -> [Expr Log ] -> Text
0 commit comments