Proto_alpha/test: split tests.
This commit is contained in:
parent
1cc7dd46fe
commit
c6bf7d78b6
@ -8,9 +8,4 @@
|
|||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
let name = "Isolate Helpers"
|
let name = "Isolate Helpers"
|
||||||
module Logger = Logging.Make(struct let name = name end)
|
include Logging.Make(struct let name = name end)
|
||||||
let section = Lwt_log.Section.make name
|
|
||||||
let () =
|
|
||||||
Lwt_log.Section.set_level section Lwt_log.Debug
|
|
||||||
|
|
||||||
include Logger
|
|
||||||
|
@ -8,5 +8,5 @@
|
|||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
val name : string
|
val name : string
|
||||||
module Logger : Logging.LOG
|
|
||||||
include Logging.LOG
|
include Logging.LOG
|
||||||
|
|
||||||
|
@ -8,16 +8,15 @@
|
|||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
open Proto_alpha
|
open Proto_alpha
|
||||||
open Helpers_logger.Logger
|
open Error_monad
|
||||||
|
open Helpers_logger
|
||||||
|
open Isolate_helpers
|
||||||
|
|
||||||
exception No_error
|
exception No_error
|
||||||
|
|
||||||
open Isolate_helpers
|
let test_dsl () : unit proto_tzresult Lwt.t =
|
||||||
|
|
||||||
let run (starting_block : Block.result): unit proto_tzresult Lwt.t =
|
|
||||||
|
|
||||||
let open Proto_alpha.Environment.Error_monad in
|
|
||||||
|
|
||||||
|
Init.main () >>=? fun starting_block ->
|
||||||
let init_tc = starting_block.tezos_context in
|
let init_tc = starting_block.tezos_context in
|
||||||
|
|
||||||
Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) ->
|
Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) ->
|
||||||
@ -150,16 +149,8 @@ let run (starting_block : Block.result): unit proto_tzresult Lwt.t =
|
|||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let main () =
|
let tests =
|
||||||
let open Proto_alpha.Error_monad in
|
List.map
|
||||||
Init.main () >>=? fun starting_block ->
|
(fun (n, f) -> (n, (fun (_ : string) -> f () >>= Assert.wrap)))
|
||||||
run starting_block
|
[ "dsl", test_dsl
|
||||||
|
]
|
||||||
|
|
||||||
let tests = [
|
|
||||||
"main", (fun _ -> main ()) ;
|
|
||||||
]
|
|
||||||
|
|
||||||
let main () =
|
|
||||||
let module Test = Test.Make(Error_monad) in
|
|
||||||
Test.run "dsl." tests
|
|
||||||
|
@ -8,19 +8,16 @@
|
|||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
open Proto_alpha
|
open Proto_alpha
|
||||||
|
open Tezos_context
|
||||||
|
open Error_monad
|
||||||
|
|
||||||
let name = "Isolate Endorsement"
|
let name = "Isolate Endorsement"
|
||||||
module Logger = Logging.Make(struct let name = name end)
|
module Logger = Logging.Make(struct let name = name end)
|
||||||
let section = Lwt_log.Section.make name
|
|
||||||
let () =
|
|
||||||
Lwt_log.Section.set_level section Lwt_log(*.Debug*).Warning
|
|
||||||
|
|
||||||
|
|
||||||
exception No_error
|
exception No_error
|
||||||
|
|
||||||
open Isolate_helpers
|
open Isolate_helpers
|
||||||
open Shorthands
|
open Shorthands
|
||||||
open Error_monad
|
|
||||||
|
|
||||||
let (>>?=) = Assert.(>>?=)
|
let (>>?=) = Assert.(>>?=)
|
||||||
|
|
||||||
@ -46,7 +43,8 @@ let test_wrong_delegate endorse_a starting_block =
|
|||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let test_endorsement_payment root =
|
let test_endorsement_payment () =
|
||||||
|
Init.main () >>=? fun root ->
|
||||||
let bootstrap_accounts = Account.bootstrap_accounts in
|
let bootstrap_accounts = Account.bootstrap_accounts in
|
||||||
let open Proto_alpha.Tezos_context in
|
let open Proto_alpha.Tezos_context in
|
||||||
get_tc_full root >>=? fun tc ->
|
get_tc_full root >>=? fun tc ->
|
||||||
@ -96,8 +94,8 @@ let test_endorsement_payment root =
|
|||||||
iter_s aux @@ List.product slots prios
|
iter_s aux @@ List.product slots prios
|
||||||
|
|
||||||
|
|
||||||
let test_multiple_endorsement (pred: Block.result) =
|
let test_multiple_endorsement () =
|
||||||
let open Proto_alpha.Tezos_context in
|
Init.main () >>=? fun pred ->
|
||||||
let tc = pred.tezos_context in
|
let tc = pred.tezos_context in
|
||||||
let level = Level.current tc in
|
let level = Level.current tc in
|
||||||
Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) ->
|
Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) ->
|
||||||
@ -110,7 +108,8 @@ let test_multiple_endorsement (pred: Block.result) =
|
|||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let test_wrong_endorsement starting_block =
|
let test_wrong_endorsement () =
|
||||||
|
Init.main () >>=? fun starting_block ->
|
||||||
let account = Account.new_account () in
|
let account = Account.new_account () in
|
||||||
let endorse slot (res: Block.result) =
|
let endorse slot (res: Block.result) =
|
||||||
Block.endorsement
|
Block.endorsement
|
||||||
@ -121,7 +120,8 @@ let test_wrong_endorsement starting_block =
|
|||||||
test_wrong_slot endorse starting_block
|
test_wrong_slot endorse starting_block
|
||||||
|
|
||||||
|
|
||||||
let test_fitness (res: Block.result) =
|
let test_fitness () =
|
||||||
|
Init.main () >>=? fun res ->
|
||||||
Block.of_res ~priority: 0 ~res () >>=? fun block_0 ->
|
Block.of_res ~priority: 0 ~res () >>=? fun block_0 ->
|
||||||
let fitness_0 = block_0.validation.fitness in
|
let fitness_0 = block_0.validation.fitness in
|
||||||
Block.of_res ~priority: 1 ~res () >>=? fun block_1 ->
|
Block.of_res ~priority: 1 ~res () >>=? fun block_1 ->
|
||||||
@ -130,23 +130,11 @@ let test_fitness (res: Block.result) =
|
|||||||
Assert.equal_int ~msg: "Fitness test" diff 0 ;
|
Assert.equal_int ~msg: "Fitness test" diff 0 ;
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
let tests =
|
||||||
let (>>=??) = Assert.(>>=??)
|
List.map
|
||||||
|
(fun (n, f) -> (n, (fun (_ : string) -> f () >>= Assert.wrap)))
|
||||||
let main (): unit proto_tzresult Lwt.t =
|
[ "endorsement.payment", test_endorsement_payment ;
|
||||||
let open Error_monad in
|
"endorsement.wrong", test_wrong_endorsement ;
|
||||||
|
"endorsement.multiple", test_multiple_endorsement ;
|
||||||
Init.main () >>=? fun starting_block ->
|
"endorsement.fitness", test_fitness ;
|
||||||
test_endorsement_payment starting_block >>=? fun () ->
|
]
|
||||||
test_wrong_endorsement starting_block >>=? fun () ->
|
|
||||||
test_multiple_endorsement starting_block >>=? fun () ->
|
|
||||||
test_fitness starting_block >>=? fun () ->
|
|
||||||
return ()
|
|
||||||
|
|
||||||
let tests = [
|
|
||||||
"main", (fun _ -> main ()) ;
|
|
||||||
]
|
|
||||||
|
|
||||||
let main () =
|
|
||||||
let module Test = Test.Make(Error_monad) in
|
|
||||||
Test.run "endorsement." tests
|
|
||||||
|
@ -8,9 +8,10 @@
|
|||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Test_isolate_dsl.main ();
|
let module Test = Test.Make(Error_monad) in
|
||||||
Test_isolate_transaction.main ();
|
Test.run "proto_alpha."
|
||||||
Test_isolate_endorsement.main ();
|
( Test_isolate_dsl.tests @
|
||||||
Test_isolate_origination.main ();
|
Test_isolate_transaction.tests @
|
||||||
Test_isolate_michelson.main ()
|
Test_isolate_endorsement.tests @
|
||||||
|
Test_isolate_origination.tests @
|
||||||
|
Test_isolate_michelson.tests )
|
||||||
|
@ -12,9 +12,6 @@ open Tezos_context
|
|||||||
|
|
||||||
let name = "Isolate Michelson"
|
let name = "Isolate Michelson"
|
||||||
module Logger = Logging.Make(struct let name = name end)
|
module Logger = Logging.Make(struct let name = name end)
|
||||||
let section = Lwt_log.Section.make name
|
|
||||||
let () =
|
|
||||||
Lwt_log.Section.set_level section Lwt_log.Debug(*.Warning*)
|
|
||||||
|
|
||||||
let (//) = Filename.concat
|
let (//) = Filename.concat
|
||||||
let contract_path =
|
let contract_path =
|
||||||
@ -50,24 +47,26 @@ let program param ret st code =
|
|||||||
|
|
||||||
let quote s = "\"" ^ s ^ "\""
|
let quote s = "\"" ^ s ^ "\""
|
||||||
|
|
||||||
let test parse_execute =
|
let parse_execute sb ?tc code_str param_str storage_str =
|
||||||
let test ?tc (file_name: string) (storage: string) (input: string) =
|
let param = parse_param param_str in
|
||||||
|
let script = parse_script code_str storage_str in
|
||||||
|
Script.execute_code_pred ?tc sb script param >>=?? fun (ret, st, _, tc, nonce) ->
|
||||||
|
let contracts = Contract.originated_contracts nonce in
|
||||||
|
return (ret, st, tc, contracts)
|
||||||
|
|
||||||
|
let test ctxt ?tc (file_name: string) (storage: string) (input: string) =
|
||||||
let full_path = contract_path // file_name ^ ".tz" in
|
let full_path = contract_path // file_name ^ ".tz" in
|
||||||
let file = Helpers_misc.read_file full_path in
|
let file = Helpers_misc.read_file full_path in
|
||||||
let spaced_file = Str.global_replace (Str.regexp_string "\n") "\n " file in
|
let spaced_file = Str.global_replace (Str.regexp_string "\n") "\n " file in
|
||||||
let program = "{" ^ spaced_file ^ "}" in
|
let program = "{" ^ spaced_file ^ "}" in
|
||||||
parse_execute ?tc program input storage
|
parse_execute ctxt ?tc program input storage
|
||||||
in
|
|
||||||
test
|
|
||||||
|
|
||||||
|
let test_fails ctxt ?location f s i =
|
||||||
let test_fails ?location parse_execute f s i =
|
test ctxt f s i >>= fun x ->
|
||||||
test parse_execute f s i >>= fun x ->
|
|
||||||
let msg = Option.unopt ~default:"Not failing" location in
|
let msg = Option.unopt ~default:"Not failing" location in
|
||||||
Assert.generic_economic_error ~msg x ;
|
Assert.generic_economic_error ~msg x ;
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let string_of_canon output_prim =
|
let string_of_canon output_prim =
|
||||||
let output_can = Proto_alpha.Michelson_v1_primitives.strings_of_prims output_prim in
|
let output_can = Proto_alpha.Michelson_v1_primitives.strings_of_prims output_prim in
|
||||||
let location_maker _ =
|
let location_maker _ =
|
||||||
@ -79,9 +78,8 @@ let string_of_canon output_prim =
|
|||||||
let output = Format.flush_str_formatter () in
|
let output = Format.flush_str_formatter () in
|
||||||
output
|
output
|
||||||
|
|
||||||
|
let test_print ctxt fn s i =
|
||||||
let test_print parse_execute fn s i =
|
test ctxt fn s i >>=? fun (sp, op, _, _) ->
|
||||||
test parse_execute fn s i >>=? fun (sp, op, _) ->
|
|
||||||
let ss = string_of_canon sp in
|
let ss = string_of_canon sp in
|
||||||
let os = string_of_canon op in
|
let os = string_of_canon op in
|
||||||
debug "Storage : %s" ss ;
|
debug "Storage : %s" ss ;
|
||||||
@ -89,36 +87,37 @@ let test_print parse_execute fn s i =
|
|||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let test_output parse_execute ?location (file_name: string) (storage: string) (input: string) (expected_output: string) =
|
let test_output ctxt ?location (file_name: string) (storage: string) (input: string) (expected_output: string) =
|
||||||
test parse_execute file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts) ->
|
test ctxt file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts) ->
|
||||||
let output = string_of_canon output_prim in
|
let output = string_of_canon output_prim in
|
||||||
let msg = Option.unopt ~default:"strings aren't equal" location in
|
let msg = Option.unopt ~default:"strings aren't equal" location in
|
||||||
Assert.equal_string ~msg expected_output output ;
|
Assert.equal_string ~msg expected_output output ;
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let test_tc ?tc parse_execute (file_name: string) (storage: string) (input: string) =
|
let test_tc ctxt ?tc (file_name: string) (storage: string) (input: string) =
|
||||||
test parse_execute ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts) ->
|
test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts) ->
|
||||||
return (tc)
|
return (tc)
|
||||||
|
|
||||||
|
|
||||||
let test_contract ?tc parse_execute (file_name: string) (storage: string) (input: string) =
|
let test_contract ctxt ?tc (file_name: string) (storage: string) (input: string) =
|
||||||
test parse_execute ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts) ->
|
test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts) ->
|
||||||
return (contracts, tc)
|
return (contracts, tc)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let test_storage parse_execute ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) =
|
let test_storage ctxt ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) =
|
||||||
test parse_execute file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts) ->
|
test ctxt file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts) ->
|
||||||
let storage = string_of_canon storage_prim in
|
let storage = string_of_canon storage_prim in
|
||||||
let msg = Option.unopt ~default:"strings aren't equal" location in
|
let msg = Option.unopt ~default:"strings aren't equal" location in
|
||||||
Assert.equal_string ~msg expected_storage storage ;
|
Assert.equal_string ~msg expected_storage storage ;
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let test_example parse_execute sb =
|
let test_example () =
|
||||||
|
Init.main () >>=?? fun sb ->
|
||||||
let test_output ?location a b c d =
|
let test_output ?location a b c d =
|
||||||
test_output ?location parse_execute a b c d >>= function
|
test_output sb ?location a b c d >>= function
|
||||||
| Ok(x) -> return x
|
| Ok(x) -> return x
|
||||||
| Error(errs) -> (
|
| Error(errs) -> (
|
||||||
match location with
|
match location with
|
||||||
@ -126,11 +125,11 @@ let test_example parse_execute sb =
|
|||||||
| Some(loc) -> debug "loc : %s" loc
|
| Some(loc) -> debug "loc : %s" loc
|
||||||
) ; Lwt.return (Error(errs))
|
) ; Lwt.return (Error(errs))
|
||||||
in
|
in
|
||||||
let test_fails ?location = test_fails ?location parse_execute in
|
let test_fails ?location = test_fails ?location sb in
|
||||||
let test_tc ?tc = test_tc ?tc parse_execute in
|
let test_tc ?tc = test_tc ?tc sb in
|
||||||
let test_contract ?tc = test_contract ?tc parse_execute in
|
let test_contract ?tc = test_contract ?tc sb in
|
||||||
(* let test_print ?location = test_print ?location parse_execute in*)
|
(* let test_print ?location = test_print ?location sb in*)
|
||||||
let test_storage ?location = test_storage ?location parse_execute in
|
let test_storage ?location = test_storage ?location sb in
|
||||||
|
|
||||||
(* FORMAT: assert_output contract_file storage input expected_result *)
|
(* FORMAT: assert_output contract_file storage input expected_result *)
|
||||||
test_output ~location: __LOC__ "ret_int" "Unit" "Unit" "300" >>=? fun _ ->
|
test_output ~location: __LOC__ "ret_int" "Unit" "Unit" "300" >>=? fun _ ->
|
||||||
@ -451,7 +450,8 @@ let test_example parse_execute sb =
|
|||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let test_program parse_execute =
|
let test_program () =
|
||||||
|
Init.main () >>=?? fun sb ->
|
||||||
let id_code = "code
|
let id_code = "code
|
||||||
{ DUP ;
|
{ DUP ;
|
||||||
PAIR ;
|
PAIR ;
|
||||||
@ -470,35 +470,16 @@ let test_program parse_execute =
|
|||||||
PAIR }" in
|
PAIR }" in
|
||||||
let push_300 =
|
let push_300 =
|
||||||
program "unit" "nat" "unit" push_300_code in
|
program "unit" "nat" "unit" push_300_code in
|
||||||
parse_execute id_int_program "2" "3" >>=? fun _ ->
|
parse_execute sb id_int_program "2" "3" >>=? fun _ ->
|
||||||
parse_execute id_ill_param_program "2" "3" >>= fun x ->
|
parse_execute sb id_ill_param_program "2" "3" >>= fun x ->
|
||||||
Assert.ill_typed_data_error ~msg: "Good data type" x ;
|
Assert.ill_typed_data_error ~msg: "Good data type" x ;
|
||||||
parse_execute id_ill_return_program "2" "3" >>= fun x ->
|
parse_execute sb id_ill_return_program "2" "3" >>= fun x ->
|
||||||
Assert.ill_typed_return_error ~msg: "Good return type" x ;
|
Assert.ill_typed_return_error ~msg: "Good return type" x ;
|
||||||
parse_execute push_300 "Unit" "Unit" >>=? fun _ ->
|
parse_execute sb push_300 "Unit" "Unit" >>=? fun _ ->
|
||||||
parse_execute id_pbool_program "(Pair True True)" "Unit" >>=? fun _ ->
|
parse_execute sb id_pbool_program "(Pair True True)" "Unit" >>=? fun _ ->
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
let main (): unit tzresult Lwt.t =
|
|
||||||
Init.main () >>=?? fun sb ->
|
|
||||||
let execute_code ?tc = Script.execute_code_pred ?tc sb in
|
|
||||||
let parse_execute ?tc code_str param_str storage_str =
|
|
||||||
let param = parse_param param_str in
|
|
||||||
let script = parse_script code_str storage_str in
|
|
||||||
execute_code ?tc script param >>=?? fun (ret, st, _, tc, nonce) ->
|
|
||||||
let contracts = Contract.originated_contracts nonce in
|
|
||||||
return (ret, st, tc, contracts)
|
|
||||||
in
|
|
||||||
test_program parse_execute >>=? fun _x ->
|
|
||||||
test_example parse_execute sb >>=? fun _x ->
|
|
||||||
return ()
|
|
||||||
|
|
||||||
|
|
||||||
let tests = [
|
let tests = [
|
||||||
"main", (fun _ -> main ()) ;
|
"michelson.example", (fun _ -> test_example ()) ;
|
||||||
|
"michelson.program", (fun _ -> test_program ()) ;
|
||||||
]
|
]
|
||||||
|
|
||||||
let main () =
|
|
||||||
let module Test = Test.Make(Tezos_error_monad.Error_monad) in
|
|
||||||
Test.run "michelson." tests
|
|
||||||
|
@ -7,71 +7,20 @@
|
|||||||
(* *)
|
(* *)
|
||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
|
open Proto_alpha
|
||||||
|
open Error_monad
|
||||||
|
|
||||||
let name = "Isolate Origination"
|
let name = "Isolate Origination"
|
||||||
module Logger = Logging.Make(struct let name = name end)
|
module Logger = Logging.Make(struct let name = name end)
|
||||||
let section = Lwt_log.Section.make name
|
|
||||||
let () =
|
|
||||||
Lwt_log.Section.set_level section Lwt_log.Debug
|
|
||||||
|
|
||||||
|
|
||||||
exception No_error
|
exception No_error
|
||||||
|
|
||||||
open Isolate_helpers
|
open Isolate_helpers
|
||||||
|
open Helpers_block
|
||||||
let (>>?=) = Assert.(>>?=)
|
let (>>?=) = Assert.(>>?=)
|
||||||
let (>>=??) = Assert.(>>=??)
|
let (>>=??) = Assert.(>>=??)
|
||||||
|
|
||||||
let test_simple_origination originate =
|
let originate root ?(tc=root.tezos_context) ?baker ?spendable ?fee ?delegatable src amount =
|
||||||
let open Proto_alpha.Error_monad in
|
|
||||||
let src = List.hd Account.bootstrap_accounts in
|
|
||||||
|
|
||||||
(* 0 balance should fail *)
|
|
||||||
originate src 0 >>= Assert.wrap >>= fun result ->
|
|
||||||
Assert.initial_amount_too_low ~msg: __LOC__ result ;
|
|
||||||
|
|
||||||
(* .5 Balance should fail *)
|
|
||||||
originate src 50 >>= Assert.wrap >>= fun result ->
|
|
||||||
Assert.initial_amount_too_low ~msg: __LOC__ result ;
|
|
||||||
|
|
||||||
(* 2. Balance should work *)
|
|
||||||
originate src 200 >>= Assert.ok >>= fun _ ->
|
|
||||||
return ()
|
|
||||||
|
|
||||||
|
|
||||||
let test_delegation
|
|
||||||
(originate: ?tc: Proto_alpha.Tezos_context.t -> ?delegatable: bool -> 'a)
|
|
||||||
(delegate: ?tc: Proto_alpha.Tezos_context.t -> 'b)
|
|
||||||
=
|
|
||||||
|
|
||||||
let open Proto_alpha.Error_monad in
|
|
||||||
let account_a = List.nth Account.bootstrap_accounts 0 in
|
|
||||||
let account_b = List.nth Account.bootstrap_accounts 1 in
|
|
||||||
|
|
||||||
(* Delegatable should change delegate *)
|
|
||||||
originate
|
|
||||||
~delegatable: true account_a 200
|
|
||||||
>>=? fun ((contracts, _errs), tc) ->
|
|
||||||
let contract = List.hd contracts in
|
|
||||||
let account_ac = {account_a with contract} in
|
|
||||||
delegate ~tc account_ac account_b.hpub >>= Assert.ok ~msg: __LOC__ >>= fun _ ->
|
|
||||||
|
|
||||||
(* Not-Delegatable should not change delegate *)
|
|
||||||
originate
|
|
||||||
~delegatable: false account_a 200
|
|
||||||
>>=? fun ((contracts, _errs), tc) ->
|
|
||||||
let contract = List.hd contracts in
|
|
||||||
let account_a = {account_a with contract} in
|
|
||||||
delegate ~tc account_a account_b.hpub >>= Assert.wrap >>= fun res ->
|
|
||||||
Assert.non_delegatable ~msg: __LOC__ res ;
|
|
||||||
|
|
||||||
return ()
|
|
||||||
|
|
||||||
|
|
||||||
let main (): unit Error_monad.tzresult Lwt.t =
|
|
||||||
|
|
||||||
Init.main () >>=?? fun root ->
|
|
||||||
|
|
||||||
let originate ?(tc=root.tezos_context) ?baker ?spendable ?fee ?delegatable src amount =
|
|
||||||
let delegatable = Option.unopt ~default:true delegatable in
|
let delegatable = Option.unopt ~default:true delegatable in
|
||||||
let spendable = Option.unopt ~default:true spendable in
|
let spendable = Option.unopt ~default:true spendable in
|
||||||
let fee = Option.unopt ~default:10 fee in
|
let fee = Option.unopt ~default:10 fee in
|
||||||
@ -80,28 +29,60 @@ let main (): unit Error_monad.tzresult Lwt.t =
|
|||||||
~tc
|
~tc
|
||||||
~pred: root
|
~pred: root
|
||||||
(src, amount, spendable, delegatable, fee)
|
(src, amount, spendable, delegatable, fee)
|
||||||
in
|
|
||||||
let delegate ?(tc=root.tezos_context) ?baker ?fee src delegate =
|
let test_simple_origination () =
|
||||||
|
|
||||||
|
Init.main () >>=? fun root ->
|
||||||
|
let src = List.hd Account.bootstrap_accounts in
|
||||||
|
|
||||||
|
(* 0 balance should fail *)
|
||||||
|
originate root src 0 >>= Assert.wrap >>= fun result ->
|
||||||
|
Assert.initial_amount_too_low ~msg: __LOC__ result ;
|
||||||
|
|
||||||
|
(* .5 Balance should fail *)
|
||||||
|
originate root src 50 >>= Assert.wrap >>= fun result ->
|
||||||
|
Assert.initial_amount_too_low ~msg: __LOC__ result ;
|
||||||
|
|
||||||
|
(* 2. Balance should work *)
|
||||||
|
originate root src 200 >>= Assert.ok >>= fun _ ->
|
||||||
|
return ()
|
||||||
|
|
||||||
|
|
||||||
|
let delegate root ?(tc=root.tezos_context) ?baker ?fee src delegate =
|
||||||
let fee = Option.unopt ~default:10 fee in
|
let fee = Option.unopt ~default:10 fee in
|
||||||
Apply.delegation_pred
|
Apply.delegation_pred
|
||||||
?baker
|
?baker
|
||||||
~tc
|
~tc
|
||||||
~pred: root
|
~pred: root
|
||||||
(src, delegate, fee)
|
(src, delegate, fee)
|
||||||
in
|
|
||||||
|
|
||||||
test_simple_origination originate >>=?? fun () ->
|
let test_delegation () =
|
||||||
test_delegation
|
|
||||||
(originate ?fee: None ?baker: None ~spendable: true)
|
|
||||||
(delegate ?fee: None ?baker: None) >>=?? fun () ->
|
|
||||||
|
|
||||||
Error_monad.return ()
|
Init.main () >>=? fun root ->
|
||||||
|
let account_a = List.nth Account.bootstrap_accounts 0 in
|
||||||
|
let account_b = List.nth Account.bootstrap_accounts 1 in
|
||||||
|
|
||||||
|
(* Delegatable should change delegate *)
|
||||||
|
originate root ~delegatable: true account_a 200
|
||||||
|
>>=? fun ((contracts, _errs), tc) ->
|
||||||
|
let contract = List.hd contracts in
|
||||||
|
let account_ac = {account_a with contract} in
|
||||||
|
delegate root ~tc account_ac account_b.hpub >>= Assert.ok ~msg: __LOC__ >>= fun _ ->
|
||||||
|
|
||||||
let tests = [
|
(* Not-Delegatable should not change delegate *)
|
||||||
"main", (fun _ -> main ()) ;
|
originate root ~delegatable: false account_a 200
|
||||||
]
|
>>=? fun ((contracts, _errs), tc) ->
|
||||||
|
let contract = List.hd contracts in
|
||||||
|
let account_a = {account_a with contract} in
|
||||||
|
delegate root ~tc account_a account_b.hpub >>= Assert.wrap >>= fun res ->
|
||||||
|
Assert.non_delegatable ~msg: __LOC__ res ;
|
||||||
|
|
||||||
|
return ()
|
||||||
|
|
||||||
|
let tests =
|
||||||
|
List.map
|
||||||
|
(fun (n, f) -> (n, (fun (_: string) -> f () >>= Assert.wrap)))
|
||||||
|
[ "origination.simple", test_simple_origination ;
|
||||||
|
"origination.delegate", test_delegation ;
|
||||||
|
]
|
||||||
|
|
||||||
let main () =
|
|
||||||
let module Test = Test.Make(Error_monad) in
|
|
||||||
Test.run "origination." tests
|
|
||||||
|
@ -7,40 +7,18 @@
|
|||||||
(* *)
|
(* *)
|
||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
|
|
||||||
|
open Proto_alpha
|
||||||
|
open Error_monad
|
||||||
|
|
||||||
let name = "Isolate Transactions"
|
let name = "Isolate Transactions"
|
||||||
module Logger = Logging.Make(struct let name = name end)
|
module Logger = Logging.Make(struct let name = name end)
|
||||||
let section = Lwt_log.Section.make name
|
|
||||||
let () =
|
|
||||||
Lwt_log.Section.set_level section Lwt_log.Warning(*.Debug*)
|
|
||||||
open Logger
|
open Logger
|
||||||
|
|
||||||
module Helpers = Isolate_helpers
|
module Helpers = Isolate_helpers
|
||||||
open Helpers
|
module Assert = Helpers.Assert
|
||||||
open Proto_alpha.Error_monad
|
|
||||||
|
|
||||||
let test_cycle_transfer (pred: Helpers.Block.result) =
|
let test_basic (): unit tzresult Lwt.t =
|
||||||
let transfer = Helpers.Apply.transaction_pred ~pred in
|
Helpers.Init.main () >>=? fun starting_block ->
|
||||||
let tc = pred.tezos_context in
|
|
||||||
let cycle n =
|
|
||||||
Helpers.Account.make_accounts ~tc n >>=? fun (accounts, tc) ->
|
|
||||||
let pairs = List.combine accounts @@ List.shift accounts in
|
|
||||||
let aux tc (src, dst) =
|
|
||||||
transfer ~tc (src, dst, 10000, Some(10)) >>=? fun (_, tc) -> return tc
|
|
||||||
in
|
|
||||||
fold_left_s aux tc pairs >>=? fun tc ->
|
|
||||||
let aux (account: Helpers.Account.t) =
|
|
||||||
Helpers.Assert.equal_cents_balance ~tc ~msg: __LOC__ (account.contract, Helpers.Account.init_amount * 100 - 10)
|
|
||||||
in
|
|
||||||
iter_s aux accounts
|
|
||||||
in
|
|
||||||
cycle 2 >>=? fun _ ->
|
|
||||||
cycle 13 >>=? fun _ ->
|
|
||||||
cycle 50 >>=? fun _ ->
|
|
||||||
return ()
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let run (starting_block: Helpers.Block.result): unit tzresult Lwt.t =
|
|
||||||
let init_tc = starting_block.tezos_context in
|
let init_tc = starting_block.tezos_context in
|
||||||
|
|
||||||
Helpers.Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) ->
|
Helpers.Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) ->
|
||||||
@ -144,21 +122,32 @@ let run (starting_block: Helpers.Block.result): unit tzresult Lwt.t =
|
|||||||
>>= Assert.wrap >>= fun result ->
|
>>= Assert.wrap >>= fun result ->
|
||||||
Assert.inconsistent_pkh ~msg: __LOC__ result ;
|
Assert.inconsistent_pkh ~msg: __LOC__ result ;
|
||||||
debug "No manager key" ;
|
debug "No manager key" ;
|
||||||
|
|
||||||
test_cycle_transfer starting_block >>=? fun _ ->
|
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
let test_cycle_transfer () =
|
||||||
|
Helpers.Init.main () >>=? fun pred ->
|
||||||
|
let transfer = Helpers.Apply.transaction_pred ~pred in
|
||||||
|
let tc = pred.tezos_context in
|
||||||
|
let cycle n =
|
||||||
|
Helpers.Account.make_accounts ~tc n >>=? fun (accounts, tc) ->
|
||||||
|
let pairs = List.combine accounts @@ List.shift accounts in
|
||||||
|
let aux tc (src, dst) =
|
||||||
|
transfer ~tc (src, dst, 10000, Some(10)) >>=? fun (_, tc) -> return tc
|
||||||
|
in
|
||||||
|
fold_left_s aux tc pairs >>=? fun tc ->
|
||||||
|
let aux (account: Helpers.Account.t) =
|
||||||
|
Helpers.Assert.equal_cents_balance ~tc ~msg: __LOC__ (account.contract, Helpers.Account.init_amount * 100 - 10)
|
||||||
|
in
|
||||||
|
iter_s aux accounts
|
||||||
|
in
|
||||||
|
cycle 2 >>=? fun _ ->
|
||||||
|
cycle 13 >>=? fun _ ->
|
||||||
|
cycle 50 >>=? fun _ ->
|
||||||
|
return ()
|
||||||
|
|
||||||
let main () =
|
let tests =
|
||||||
Helpers.Init.main () >>=? fun starting_block ->
|
List.map
|
||||||
run starting_block
|
(fun (n, f) -> (n, (fun (_: string) -> f () >>= Assert.wrap)))
|
||||||
|
[ "transaction.basic", test_basic ;
|
||||||
|
"transaction.cycle_transfer", test_cycle_transfer
|
||||||
let tests = [
|
]
|
||||||
"main", (fun _ -> main () >>= Assert.wrap) ;
|
|
||||||
]
|
|
||||||
|
|
||||||
let main () =
|
|
||||||
let module Test = Test.Make(Error_monad) in
|
|
||||||
Test.run "transactions." tests
|
|
||||||
|
Loading…
Reference in New Issue
Block a user