Merge pull request #103 from arcz/ethereum-tests-tasty

Move Ethereum tests to Tasty

.github/workflows/build.yml

@@ -28,3 +28,5 @@ jobs:
         run: nix-build
       - name: run rpc tests
         run: nix-shell --pure --command "cabal run rpc-tests"
+      - name: run ethereum tests
+        run: nix-shell --command "cabal run ethereum-tests"

flake.nix

@@ -12,9 +12,13 @@
       url = "github:ethereum/solidity/1c8745c54a239d20b6fb0f79a8bd2628d779b27e";
       flake = false;
     };
+    ethereum-tests = {
+      url = "github:ethereum/tests/v11.2";
+      flake = false;
+    };
   };
 
-  outputs = { self, nixpkgs, flake-utils, solidity, ... }:
+  outputs = { self, nixpkgs, flake-utils, solidity, ethereum-tests, ... }:
     flake-utils.lib.eachDefaultSystem (system:
       let
         pkgs = nixpkgs.legacyPackages.${system};
@@ -49,6 +53,7 @@
             haskell.lib.dontHaddock
           ]).overrideAttrs(final: prev: {
             HEVM_SOLIDITY_REPO = solidity;
+            HEVM_ETHEREUM_TESTS_REPO = ethereum-tests;
           });
         hevmWrapped = with pkgs; symlinkJoin {
           name = "hevm";
@@ -92,6 +97,7 @@
             # NOTE: hacks for bugged cabal new-repl
             LD_LIBRARY_PATH = libraryPath;
             HEVM_SOLIDITY_REPO = solidity;
+            HEVM_ETHEREUM_TESTS_REPO = ethereum-tests;
             shellHook = lib.optionalString stdenv.isDarwin ''
               export DYLD_LIBRARY_PATH="${libraryPath}";
             '';

hevm-cli/hevm-cli.hs

@@ -1,9 +1,7 @@
 -- Main file of the hevm CLI program
 
-{-# Language CPP #-}
 {-# Language DataKinds #-}
 {-# Language DeriveAnyClass #-}
-{-# Language GADTs #-}
 
 module Main where
 
@@ -14,13 +12,8 @@ import qualified EVM.FeeSchedule as FeeSchedule
 import qualified EVM.Fetch
 import qualified EVM.Stepper
 
-
-import qualified EVM.VMTest as VMTest
-
-
 import EVM.SymExec
 import EVM.Debug
-import EVM.ABI
 import qualified EVM.Expr as Expr
 import EVM.SMT
 import qualified EVM.TTY as TTY
@@ -31,49 +24,37 @@ import EVM.UnitTest (UnitTestOptions, coverageReport, coverageForUnitTestContrac
 import EVM.Dapp (findUnitTests, dappInfo, DappInfo, emptyDapp)
 import GHC.Natural
 import EVM.Format (showTraceTree, formatExpr)
-import qualified EVM.Patricia as Patricia
-import Data.Map (Map)
 import Data.Word (Word64)
 
 import qualified EVM.Facts     as Facts
 import qualified EVM.Facts.Git as Git
 import qualified EVM.UnitTest
 
-import GHC.Stack
 import GHC.Conc
-import Control.Concurrent.Async   (async, waitCatch)
 import Control.Lens hiding (pre, passing)
 import Control.Monad              (void, when, forM_, unless)
 import Control.Monad.State.Strict (execStateT, liftIO)
 import Data.ByteString            (ByteString)
 import Data.List                  (intercalate, isSuffixOf)
 import Data.Text                  (unpack, pack)
-import Data.Text.Encoding         (encodeUtf8)
 import Data.Maybe                 (fromMaybe, fromJust, mapMaybe)
 import Data.Version               (showVersion)
 import Data.DoubleWord            (Word256)
-import System.IO                  (hFlush, stdout, stderr)
+import System.IO                  (stderr)
 import System.Directory           (withCurrentDirectory, listDirectory)
 import System.Exit                (exitFailure, exitWith, ExitCode(..))
-import System.Process             (callProcess)
-import qualified Data.Aeson        as JSON
-import qualified Data.Aeson.Types  as JSON
-import Data.Aeson (FromJSON (..), (.:))
-import Data.Aeson.Lens hiding (values)
-import qualified Data.Vector as V
-import qualified Data.ByteString.Lazy  as Lazy
 
 import qualified Data.ByteString        as ByteString
 import qualified Data.ByteString.Char8  as Char8
 import qualified Data.ByteString.Lazy   as LazyByteString
 import qualified Data.Map               as Map
 import qualified Data.Text              as T
 import qualified Data.Text.IO           as T
-import qualified System.Timeout         as Timeout
 
 import qualified Paths_hevm      as Paths
 
 import Options.Generic as Options
+import qualified EVM.Transaction
 
 -- This record defines the program's command-line options
 -- automatically via the `optparse-generic` package.
@@ -186,25 +167,6 @@ data Command w
       , maxIterations :: w ::: Maybe Integer            <?> "Number of times we may revisit a particular branching point"
       , askSmtIterations :: w ::: Maybe Integer         <?> "Number of times we may revisit a particular branching point before we consult the smt solver to check reachability (default: 5)"
       }
-  | BcTest -- Run an Ethereum Blockchain/GeneralState test
-      { file      :: w ::: String    <?> "Path to .json test file"
-      , test      :: w ::: [String]  <?> "Test case filter - only run specified test method(s)"
-      , debug     :: w ::: Bool      <?> "Run interactively"
-      , jsontrace :: w ::: Bool      <?> "Print json trace output at every step"
-      , diff      :: w ::: Bool      <?> "Print expected vs. actual state on failure"
-      , timeout   :: w ::: Maybe Int <?> "Execution timeout (default: 10 sec.)"
-      }
-  | Compliance -- Run Ethereum Blockchain compliance report
-      { tests   :: w ::: String       <?> "Path to Ethereum Tests directory"
-      , group   :: w ::: Maybe String <?> "Report group to run: VM or Blockchain (default: Blockchain)"
-      , match   :: w ::: Maybe String <?> "Test case filter - only run methods matching regex"
-      , skip    :: w ::: Maybe String <?> "Test case filter - skip tests containing string"
-      , html    :: w ::: Bool         <?> "Output html report"
-      , timeout :: w ::: Maybe Int    <?> "Execution timeout (default: 10 sec.)"
-      }
-  | MerkleTest -- Insert a set of key values and check against the given root
-      { file :: w ::: String <?> "Path to .json test file"
-      }
   | Version
 
   deriving (Options.Generic)
@@ -300,8 +262,6 @@ main = do
     Equivalence {} -> equivalence cmd
     Exec {} ->
       launchExec cmd
-    BcTest {} ->
-      launchTest cmd
     DappTest {} ->
       withCurrentDirectory root $ do
         cores <- num <$> getNumProcessors
@@ -315,25 +275,6 @@ main = do
             (False, Debug) -> liftIO $ TTY.main testOpts root testFile
             (False, JsonTrace) -> error "json traces not implemented for dappTest"
             (True, _) -> liftIO $ dappCoverage testOpts (optsMode cmd) testFile
-    Compliance {} ->
-      case (group cmd) of
-        Just "Blockchain" -> launchScript "/run-blockchain-tests" cmd
-        Just "VM" -> launchScript "/run-consensus-tests" cmd
-        _ -> launchScript "/run-blockchain-tests" cmd
-    MerkleTest {} -> merkleTest cmd
-
-launchScript :: String -> Command Options.Unwrapped -> IO ()
-launchScript script cmd =
-  withCurrentDirectory (tests cmd) $ do
-    dataDir <- Paths.getDataDir
-    callProcess "bash"
-      [ dataDir ++ script
-      , "."
-      , show (html cmd)
-      , fromMaybe "" (match cmd)
-      , fromMaybe "" (skip cmd)
-      , show $ fromMaybe 10 (timeout cmd)
-      ]
 
 findJsonFile :: Maybe String -> IO String
 findJsonFile (Just s) = pure s
@@ -378,19 +319,6 @@ equivalence cmd = do
         putStrLn $ "Not equivalent. Counterexample(s):" <> show res
         exitFailure
 
-checkForVMErrors :: [EVM.VM] -> [String]
-checkForVMErrors [] = []
-checkForVMErrors (vm:vms) =
-  case view EVM.result vm of
-    Just (EVM.VMFailure (EVM.UnexpectedSymbolicArg pc msg _)) ->
-      ("Unexpected symbolic argument at opcode: "
-      <> show pc
-      <> ". "
-      <> msg
-      ) : checkForVMErrors vms
-    _ ->
-      checkForVMErrors vms
-
 getSrcInfo :: Command Options.Unwrapped -> IO DappInfo
 getSrcInfo cmd =
   let root = fromMaybe "." (dappRoot cmd)
@@ -575,65 +503,6 @@ launchExec cmd = do
      where block' = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd)
            rpcinfo = (,) block' <$> rpc cmd
 
-data Testcase = Testcase {
-  _entries :: [(Text, Maybe Text)],
-  _root :: Text
-} deriving Show
-
-parseTups :: JSON.Value -> JSON.Parser [(Text, Maybe Text)]
-parseTups (JSON.Array arr) = do
-  tupList <- mapM parseJSON (V.toList arr)
-  mapM (\[k, v] -> do
-                  rhs <- parseJSON v
-                  lhs <- parseJSON k
-                  return (lhs, rhs))
-         tupList
-parseTups invalid = JSON.typeMismatch "Malformed array" invalid
-
-
-parseTrieTest :: JSON.Object -> JSON.Parser Testcase
-parseTrieTest p = do
-  kvlist <- p .: "in"
-  entries <- parseTups kvlist
-  root <- p .: "root"
-  return $ Testcase entries root
-
-instance FromJSON Testcase where
-  parseJSON (JSON.Object p) = parseTrieTest p
-  parseJSON invalid = JSON.typeMismatch "Merkle test case" invalid
-
-parseTrieTests :: Lazy.ByteString -> Either String (Map String Testcase)
-parseTrieTests = JSON.eitherDecode'
-
-merkleTest :: Command Options.Unwrapped -> IO ()
-merkleTest cmd = do
-  parsed <- parseTrieTests <$> LazyByteString.readFile (file cmd)
-  case parsed of
-    Left err -> print err
-    Right testcases -> mapM_ runMerkleTest testcases
-
-runMerkleTest :: Testcase -> IO ()
-runMerkleTest (Testcase entries root) =
-  case Patricia.calcRoot entries' of
-    Nothing ->
-      error "Test case failed"
-    Just n ->
-      case n == strip0x (hexText root) of
-        True ->
-          putStrLn "Test case success"
-        False ->
-          error ("Test case failure; expected " <> show root
-                 <> " but got " <> show (ByteStringS n))
-  where entries' = fmap (\(k, v) ->
-                           (tohexOrText k,
-                            tohexOrText (fromMaybe mempty v)))
-                   entries
-
-tohexOrText :: Text -> ByteString
-tohexOrText s = case "0x" `Char8.isPrefixOf` encodeUtf8 s of
-                  True -> hexText s
-                  False -> encodeUtf8 s
-
 -- | Creates a (concrete) VM from command line options
 vmFromCommand :: Command Options.Unwrapped -> IO EVM.VM
 vmFromCommand cmd = do
@@ -681,7 +550,7 @@ vmFromCommand cmd = do
         Just t -> t
         Nothing -> error "unexpected symbolic timestamp when executing vm test"
 
-  return $ VMTest.initTx $ withCache (vm0 baseFee miner ts' blockNum prevRan contract)
+  return $ EVM.Transaction.initTx $ withCache (vm0 baseFee miner ts' blockNum prevRan contract)
     where
         block'   = maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (block cmd)
         value'   = word value 0
@@ -778,7 +647,7 @@ symvmFromCommand cmd calldata' = do
     (_, _, Nothing) ->
       error "must provide at least (rpc + address) or code"
 
-  return $ (VMTest.initTx $ withCache $ vm0 baseFee miner ts blockNum prevRan calldata' callvalue' caller' contract')
+  return $ (EVM.Transaction.initTx $ withCache $ vm0 baseFee miner ts blockNum prevRan calldata' callvalue' caller' contract')
     & set (EVM.env . EVM.storage) store
 
   where
@@ -819,65 +688,3 @@ symvmFromCommand cmd calldata' = do
     word f def = fromMaybe def (f cmd)
     addr f def = fromMaybe def (f cmd)
     word64 f def = fromMaybe def (f cmd)
-
-launchTest :: HasCallStack => Command Options.Unwrapped ->  IO ()
-launchTest cmd = do
-  parsed <- VMTest.parseBCSuite <$> LazyByteString.readFile (file cmd)
-  case parsed of
-     Left "No cases to check." -> putStrLn "no-cases ok"
-     Left err -> print err
-     Right allTests ->
-       let testFilter =
-             if null (test cmd)
-             then id
-             else filter (\(x, _) -> elem x (test cmd))
-       in
-         mapM_ (runVMTest (diff cmd) (optsMode cmd) (timeout cmd)) $
-           testFilter (Map.toList allTests)
-
-runVMTest :: HasCallStack => Bool -> Mode -> Maybe Int -> (String, VMTest.Case) -> IO Bool
-runVMTest diffmode mode timelimit (name, x) =
- do
-  let vm0 = VMTest.vmForCase x
-  putStr (name ++ " ")
-  hFlush stdout
-  result <- do
-    action <- async $
-      case mode of
-        Run ->
-          Timeout.timeout (1000000 * (fromMaybe 10 timelimit)) $
-            execStateT (EVM.Stepper.interpret (EVM.Fetch.zero 0 (Just 0)) . void $ EVM.Stepper.execFully) vm0
-        Debug ->
-          withSolvers Z3 0 Nothing $ \solvers -> Just <$> TTY.runFromVM solvers Nothing Nothing emptyDapp vm0
-        JsonTrace ->
-          error "JsonTrace: implement me"
-          -- Just <$> execStateT (EVM.UnitTest.interpretWithCoverage EVM.Fetch.zero EVM.Stepper.runFully) vm0
-    waitCatch action
-  case result of
-    Right (Just vm1) -> do
-      ok <- VMTest.checkExpectation diffmode x vm1
-      putStrLn (if ok then "ok" else "")
-      return ok
-    Right Nothing -> do
-      putStrLn "timeout"
-      return False
-    Left e -> do
-      putStrLn $ "error: " ++ if diffmode
-        then show e
-        else (head . lines . show) e
-      return False
-
-parseAbi :: (AsValue s) => s -> (Text, [AbiType])
-parseAbi abijson =
-  (signature abijson, snd
-    <$> parseMethodInput
-    <$> V.toList
-      (fromMaybe (error "Malformed function abi") (abijson ^? key "inputs" . _Array)))
-
-abiencode :: (AsValue s) => Maybe s -> [String] -> ByteString
-abiencode Nothing _ = error "missing required argument: abi"
-abiencode (Just abijson) args =
-  let (sig', declarations) = parseAbi abijson
-  in if length declarations == length args
-     then abiMethod sig' $ AbiTuple . V.fromList $ zipWith makeAbiValue declarations args
-     else error $ "wrong number of arguments:" <> show (length args) <> ": " <> show args