Skip to content

Commit

Permalink
Fixing up call signature generation
Browse files Browse the repository at this point in the history
  • Loading branch information
msooseth committed Nov 26, 2024
1 parent 65a8103 commit a6124bb
Show file tree
Hide file tree
Showing 5 changed files with 19 additions and 23 deletions.
2 changes: 1 addition & 1 deletion src/EVM/Dapp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -100,7 +100,7 @@ mkSig method
| "check" `isPrefixOf` testname = Just (Sig testname argtypes)
| otherwise = Nothing
where
testname = method.methodSignature
testname = method.name
argtypes = snd <$> method.inputs

findUnitTests :: Text -> ([SolcContract] -> [(Text, [Sig])])
Expand Down
4 changes: 2 additions & 2 deletions src/EVM/Solvers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -129,10 +129,10 @@ withSolvers solver count threads timeout cont = do
when (conf.dumpQueries) $ writeSMT2File smt2 fileCounter "abstracted"
if (isJust fuzzResult)
then do
when (conf.debug) $ putStrLn $ "Cex found via fuzzing:" <> (show fuzzResult)
when (conf.debug) $ putStrLn $ " Cex found via fuzzing:" <> (show fuzzResult)
writeChan r (Sat $ fromJust fuzzResult)
else if not conf.onlyCexFuzz then do
when (conf.debug) $ putStrLn "Fuzzing failed to find a Cex"
when (conf.debug) $ putStrLn " Fuzzing failed to find a Cex"
-- reset solver and send all lines of provided script
out <- sendScript inst (SMT2 ("(reset)" : cmds) mempty mempty ps)
case out of
Expand Down
6 changes: 3 additions & 3 deletions src/EVM/SymExec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -596,16 +596,16 @@ verify
verify solvers opts preState maybepost = do
conf <- readConfig
let call = mconcat ["prefix 0x", getCallPrefix preState.state.calldata]
when conf.debug $ liftIO $ putStrLn $ "Exploring call " <> call
when conf.debug $ liftIO $ putStrLn $ " Exploring call " <> call

exprInter <- interpret (Fetch.oracle solvers opts.rpcInfo) opts.maxIter opts.askSmtIters opts.loopHeuristic preState runExpr
when conf.dumpExprs $ liftIO $ T.writeFile "unsimplified.expr" (formatExpr exprInter)
liftIO $ do
when conf.debug $ putStrLn "Simplifying expression"
when conf.debug $ putStrLn " Simplifying expression"
let expr = if opts.simp then (Expr.simplify exprInter) else exprInter
when conf.dumpExprs $ T.writeFile "simplified.expr" (formatExpr expr)

when conf.debug $ putStrLn $ "Exploration finished, " <> show (Expr.numBranches expr) <> " branch(es) to check in call " <> call
when conf.debug $ putStrLn $ " Exploration finished, " <> show (Expr.numBranches expr) <> " branch(es) to check in call " <> call

let flattened = flattenExpr expr
when (any isPartial flattened) $ do
Expand Down
28 changes: 12 additions & 16 deletions src/EVM/UnitTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -114,15 +114,19 @@ makeVeriOpts opts =
-- | Top level CLI endpoint for hevm test
unitTest :: App m => UnitTestOptions RealWorld -> Contracts -> m Bool
unitTest opts (Contracts cs) = do
let unitTests = findUnitTests opts.match $ Map.elems cs
results <- concatMapM (runUnitTestContract opts cs) unitTests
let unitTestContrs = findUnitTests opts.match $ Map.elems cs
conf <- readConfig
when conf.debug $ liftIO $ do
putStrLn $ "Found " ++ show (length unitTestContrs) ++ " unit test contract(s) to test:"
let x = map (\(a,b) -> " --> " <> a <> " --- functions: " <> (Text.pack $ show b)) unitTestContrs
putStrLn $ unlines $ map Text.unpack x
results <- concatMapM (runUnitTestContract opts cs) unitTestContrs
pure $ and results

-- | Assuming a constructor is loaded, this stepper will run the constructor
-- to create the test contract, give it an initial balance, and run `setUp()'.
initializeUnitTest :: UnitTestOptions s -> SolcContract -> Stepper Concrete s ()
initializeUnitTest opts theContract = do

let addr = opts.testParams.address

Stepper.evm $ do
Expand Down Expand Up @@ -161,7 +165,7 @@ runUnitTestContract
opts@(UnitTestOptions {..}) contractMap (name, testSigs) = do

-- Print a header
liftIO $ putStrLn $ "\nChecking " ++ show (length testSigs) ++ " function(s) in contract " ++ unpack name
liftIO $ putStrLn $ "Checking " ++ show (length testSigs) ++ " function(s) in contract " ++ unpack name

-- Look for the wanted contract by name from the Solidity info
case Map.lookup name contractMap of
Expand Down Expand Up @@ -190,9 +194,10 @@ runUnitTestContract
-- | Define the thread spawner for symbolic tests
symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> m Bool
symRun opts@UnitTestOptions{..} vm (Sig testName types) = do
liftIO $ putStrLn $ "\x1b[96m[RUNNING]\x1b[0m " <> Text.unpack testName
let cd = symCalldata testName types [] (AbstractBuf "txdata")
shouldFail = "proveFail" `isPrefixOf` testName
let callSig = testName <> "(" <> (Text.intercalate "," (map abiTypeSolidity types)) <> ")"
liftIO $ putStrLn $ "\x1b[96m[RUNNING]\x1b[0m " <> Text.unpack callSig
let cd = symCalldata callSig types [] (AbstractBuf "txdata")
shouldFail = "proveFail" `isPrefixOf` callSig
testContract store = fromMaybe (internalError "test contract not found in state") (Map.lookup vm.state.contract store)

-- define postcondition depending on `shouldFail`
Expand Down Expand Up @@ -286,15 +291,6 @@ symFailure UnitTestOptions {..} testName cd types failures' =
dappContext TraceContext { contracts, labels } =
DappContext { info = dapp, contracts, labels }

execSymTest :: UnitTestOptions RealWorld -> ABIMethod -> (Expr Buf, [Prop]) -> Stepper Symbolic RealWorld (Expr End)
execSymTest UnitTestOptions{ .. } method cd = do
-- Set up the call to the test method
Stepper.evm $ do
makeTxCall testParams cd
pushTrace (EntryTrace method)
-- Try running the test method
runExpr

indentLines :: Int -> Text -> Text
indentLines n s =
let p = Text.replicate n " "
Expand Down
2 changes: 1 addition & 1 deletion test/test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1581,7 +1581,7 @@ tests = testGroup "hevm"
}
|]
let opts = defaultVeriOpts
let sig = Nothing
let sig = Just $ Sig "prove_tuple_pass((uint256,uint256))" [AbiTupleType (V.fromList [AbiUIntType 256, AbiUIntType 256])]
(_, [Qed _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] opts
putStrLnM "Qed, memory tuple is good"
, test "symbolic-loops-not-reached" $ do
Expand Down

0 comments on commit a6124bb

Please sign in to comment.