Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

test for the preprocessor

  • Loading branch information...
commit 2b658ac4ae5b75fddbfbde82592e38a7b1fa6ae4 1 parent 6688856
Alexander Bernauer authored
View
1  bitcoin-script-engine.cabal
@@ -45,4 +45,5 @@ executable Test
other-modules:
Language.Bitcoin.Test.Interpreter
Language.Bitcoin.Test.Parser
+ Language.Bitcoin.Test.Preprocessor
Language.Bitcoin.Test.Utils
View
9 src/Language/Bitcoin/Preprocessor.hs
@@ -7,7 +7,7 @@ module Language.Bitcoin.Preprocessor
-- import {{{1
import Data.Int (Int32)
import Language.Bitcoin.Types
-import Language.Bitcoin.Utils (i2b)
+import Language.Bitcoin.Utils (bs, pad)
import qualified Data.ByteString.Lazy as B
import qualified Data.List as List
@@ -31,11 +31,11 @@ processKey getter number (program, keyring) =
getOrCreate :: Keyring -> Int32 -> (Keyring, Keypair)
getOrCreate keyring number =
- let publicKey = i2b $ fromIntegral number in
+ let publicKey = pad 64 $ bs $ fromIntegral number in
case List.find ((==publicKey) . keyPublic) keyring of
Nothing ->
let
- privateKey = i2b $ fromIntegral $ -1 * number
+ privateKey = pad 64 $ bs $ fromIntegral $ -1 * number
keypair = Keypair publicKey privateKey
in
(keypair : keyring, keypair)
@@ -46,7 +46,8 @@ push :: B.ByteString -> Opcode
push data_ = OP_PUSHDATA (pushType (B.length data_)) data_
where
pushType size
- | size <= 75 = Direct
+ | size == 0 = error "internal error"
+ | size <= 0x75 = Direct
| size <= 0xff = OneByte
| size <= 0xffff = TwoBytes
| otherwise = FourBytes
View
2  src/Language/Bitcoin/Types.hs
@@ -14,7 +14,7 @@ type Stack = [B.ByteString]
data Keypair = Keypair {
keyPublic :: B.ByteString
, keyPrivate :: B.ByteString
- } deriving (Show)
+ } deriving (Show, Eq)
type Keyring = [Keypair]
View
2  test/Language/Bitcoin/Test/Interpreter.hs
@@ -42,4 +42,4 @@ testSimpleOps = map runTest simpleOps
case run_interpreter' (Machine script [] stack []) of
Result Success (Machine _ _ stack' _) -> expected @=? stack'
Result (Failure _) (Machine _ _ stack' _) -> expected @=? stack'
- result -> assertString $ show result
+ result -> assertFailure $ show result
View
5 test/Language/Bitcoin/Test/Parser.hs
@@ -11,7 +11,6 @@ import Test.HUnit
import qualified Data.ByteString.Lazy as B
import qualified Data.List as List
-import Debug.Trace (trace)
tests = TestLabel "Parser" $ TestList $ good ++ bad
goodCases = [
@@ -43,7 +42,7 @@ good = map runTest goodCases
where
runTest (code, expected) = TestCase $
case run_parser "<<test>>" code of
- Left e -> assertString e
+ Left e -> assertFailure e
Right script -> expected @=? script
@@ -53,7 +52,7 @@ bad = map runTest badCases
runTest code = TestCase $
case run_parser "<<test>>" code of
Left err -> putStrLn $ infoString code err
- Right _ -> assertString "Parser should have failed"
+ Right _ -> assertFailure "Parser should have failed"
infoString :: String -> String -> String
infoString code err =
View
58 test/Language/Bitcoin/Test/Preprocessor.hs
@@ -0,0 +1,58 @@
+module Language.Bitcoin.Test.Preprocessor
+(
+ tests
+) where
+
+import Language.Bitcoin.Parser (run_parser)
+import Language.Bitcoin.Preprocessor (run_preprocessor)
+import Language.Bitcoin.Utils (pad, bs)
+import Language.Bitcoin.Types
+import Test.HUnit
+
+key number = pad 64 $ bs number
+sig number = pad 64 $ bs $ -1 * number
+
+testCases = [
+ (
+ "OP_FALSE;", ([OP_FALSE], [])
+ ),(
+ "KEY 01;", (
+ [OP_PUSHDATA Direct (key 1)],
+ [Keypair (key 1) (sig 1)]
+ )
+ ),(
+ "KEY 01;KEY 01;", (
+ [OP_PUSHDATA Direct (key 1), OP_PUSHDATA Direct (key 1)],
+ [Keypair (key 1) (sig 1)]
+ )
+ ),(
+ "KEY 01;SIG 01;", (
+ [OP_PUSHDATA Direct (key 1), OP_PUSHDATA Direct (sig 1)],
+ [Keypair (key 1) (sig 1)]
+ )
+ ),(
+ "KEY 01;KEY 02;", (
+ [OP_PUSHDATA Direct (key 1), OP_PUSHDATA Direct (key 2)],
+ [Keypair (key 1) (sig 1), Keypair (key 2) (sig 2)]
+ )
+ ),(
+ "DATA 1234;", (
+ [OP_PUSHDATA Direct (bs 0x1234)],
+ []
+ )
+ ),(
+ "DATA 11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111;", (
+ [OP_PUSHDATA OneByte (bs 0x11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)],
+ []
+ )
+ )
+ ]
+
+tests = TestLabel "Preprocessor" $ TestList $ map runTest testCases
+
+runTest :: (Code, (Program, Keyring)) -> Test
+runTest (input, expected) = TestCase $
+ case run_parser "<<test>>" input of
+ Left e -> assertFailure e
+ Right script ->
+ expected @=? run_preprocessor script
View
3  test/Language/Bitcoin/Test/Utils.hs
@@ -15,6 +15,8 @@ b2iTestCases = [
, ([0x12, 0x34, 0x56, 0x78], 0x12345678)
, ([0x70, 0x00, 0x00, 0x01], -1)
, ([0x82, 0x34, 0x56, 0x78], -0x12345678)
+ , ([0], 0)
+ , ([0x70, 0x00, 0x00, 0x00], 0)
]
i2bTestCases = [
@@ -24,6 +26,7 @@ i2bTestCases = [
, (0x12345678, [0x12, 0x34, 0x56, 0x78])
, (-1, [0x70, 0x00, 0x00, 0x01])
, (-0x12345678, [0x82, 0x34, 0x56, 0x78])
+ , (0, [0x00, 0x00, 0x00, 0x00])
]
tests = TestLabel "Utils" $ TestList $
View
7 test/Test.hs
@@ -2,11 +2,12 @@ import Test.HUnit (Test(TestList), runTestText, putTextToHandle, Counts(errors,
import System.IO (stderr)
import System.Exit (exitWith, ExitCode(ExitFailure))
-import qualified Language.Bitcoin.Test.Interpreter as A
+import qualified Language.Bitcoin.Test.Interpreter as D
import qualified Language.Bitcoin.Test.Parser as B
-import qualified Language.Bitcoin.Test.Utils as C
+import qualified Language.Bitcoin.Test.Preprocessor as C
+import qualified Language.Bitcoin.Test.Utils as A
-tests = TestList [A.tests, B.tests, C.tests]
+tests = TestList [A.tests, B.tests, C.tests, D.tests]
main = do
(count, _ ) <- runTestText (putTextToHandle stderr False) tests
Please sign in to comment.
Something went wrong with that request. Please try again.