diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml index 104623da9..1cdb1fd79 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml @@ -8,9 +8,4 @@ (**************************************************************************) let name = "Isolate Helpers" -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 - -include Logger +include Logging.Make(struct let name = name end) diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli index 58b2acebb..29dd9cb7f 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli @@ -8,5 +8,5 @@ (**************************************************************************) val name : string -module Logger : Logging.LOG include Logging.LOG + diff --git a/src/proto_alpha/lib_protocol/test/test_isolate_dsl.ml b/src/proto_alpha/lib_protocol/test/test_isolate_dsl.ml index 45ed21458..3649808df 100644 --- a/src/proto_alpha/lib_protocol/test/test_isolate_dsl.ml +++ b/src/proto_alpha/lib_protocol/test/test_isolate_dsl.ml @@ -8,16 +8,15 @@ (**************************************************************************) open Proto_alpha -open Helpers_logger.Logger +open Error_monad +open Helpers_logger +open Isolate_helpers exception No_error -open Isolate_helpers - -let run (starting_block : Block.result): unit proto_tzresult Lwt.t = - - let open Proto_alpha.Environment.Error_monad in +let test_dsl () : unit proto_tzresult Lwt.t = + Init.main () >>=? fun starting_block -> let init_tc = starting_block.tezos_context in 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 () -let main () = - let open Proto_alpha.Error_monad in - Init.main () >>=? fun starting_block -> - run starting_block - - -let tests = [ - "main", (fun _ -> main ()) ; -] - -let main () = - let module Test = Test.Make(Error_monad) in - Test.run "dsl." tests +let tests = + List.map + (fun (n, f) -> (n, (fun (_ : string) -> f () >>= Assert.wrap))) + [ "dsl", test_dsl + ] diff --git a/src/proto_alpha/lib_protocol/test/test_isolate_endorsement.ml b/src/proto_alpha/lib_protocol/test/test_isolate_endorsement.ml index 3d22950eb..f87a61a6a 100644 --- a/src/proto_alpha/lib_protocol/test/test_isolate_endorsement.ml +++ b/src/proto_alpha/lib_protocol/test/test_isolate_endorsement.ml @@ -8,19 +8,16 @@ (**************************************************************************) open Proto_alpha +open Tezos_context +open Error_monad let name = "Isolate Endorsement" 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 open Isolate_helpers open Shorthands -open Error_monad let (>>?=) = Assert.(>>?=) @@ -46,7 +43,8 @@ let test_wrong_delegate endorse_a starting_block = return () -let test_endorsement_payment root = +let test_endorsement_payment () = + Init.main () >>=? fun root -> let bootstrap_accounts = Account.bootstrap_accounts in let open Proto_alpha.Tezos_context in get_tc_full root >>=? fun tc -> @@ -96,8 +94,8 @@ let test_endorsement_payment root = iter_s aux @@ List.product slots prios -let test_multiple_endorsement (pred: Block.result) = - let open Proto_alpha.Tezos_context in +let test_multiple_endorsement () = + Init.main () >>=? fun pred -> let tc = pred.tezos_context in let level = Level.current tc in Proto_alpha.Services_registration.endorsement_rights tc level None >>=? fun (_, endorsers) -> @@ -110,7 +108,8 @@ let test_multiple_endorsement (pred: Block.result) = return () -let test_wrong_endorsement starting_block = +let test_wrong_endorsement () = + Init.main () >>=? fun starting_block -> let account = Account.new_account () in let endorse slot (res: Block.result) = Block.endorsement @@ -121,7 +120,8 @@ let test_wrong_endorsement 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 -> let fitness_0 = block_0.validation.fitness in 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 ; return () - -let (>>=??) = Assert.(>>=??) - -let main (): unit proto_tzresult Lwt.t = - let open Error_monad in - - Init.main () >>=? fun starting_block -> - 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 +let tests = + List.map + (fun (n, f) -> (n, (fun (_ : string) -> f () >>= Assert.wrap))) + [ "endorsement.payment", test_endorsement_payment ; + "endorsement.wrong", test_wrong_endorsement ; + "endorsement.multiple", test_multiple_endorsement ; + "endorsement.fitness", test_fitness ; + ] diff --git a/src/proto_alpha/lib_protocol/test/test_isolate_main.ml b/src/proto_alpha/lib_protocol/test/test_isolate_main.ml index 66acb05c4..0b22abed5 100644 --- a/src/proto_alpha/lib_protocol/test/test_isolate_main.ml +++ b/src/proto_alpha/lib_protocol/test/test_isolate_main.ml @@ -8,9 +8,10 @@ (**************************************************************************) let () = - Test_isolate_dsl.main (); - Test_isolate_transaction.main (); - Test_isolate_endorsement.main (); - Test_isolate_origination.main (); - Test_isolate_michelson.main () - + let module Test = Test.Make(Error_monad) in + Test.run "proto_alpha." + ( Test_isolate_dsl.tests @ + Test_isolate_transaction.tests @ + Test_isolate_endorsement.tests @ + Test_isolate_origination.tests @ + Test_isolate_michelson.tests ) diff --git a/src/proto_alpha/lib_protocol/test/test_isolate_michelson.ml b/src/proto_alpha/lib_protocol/test/test_isolate_michelson.ml index d46f24cc0..ea2199cb1 100644 --- a/src/proto_alpha/lib_protocol/test/test_isolate_michelson.ml +++ b/src/proto_alpha/lib_protocol/test/test_isolate_michelson.ml @@ -12,9 +12,6 @@ open Tezos_context let name = "Isolate Michelson" 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 contract_path = @@ -50,24 +47,26 @@ let program param ret st code = let quote s = "\"" ^ s ^ "\"" -let test parse_execute = - let test ?tc (file_name: string) (storage: string) (input: string) = - let full_path = contract_path // file_name ^ ".tz" in - let file = Helpers_misc.read_file full_path in - let spaced_file = Str.global_replace (Str.regexp_string "\n") "\n " file in - let program = "{" ^ spaced_file ^ "}" in - parse_execute ?tc program input storage - in - test +let parse_execute sb ?tc code_str param_str storage_str = + 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 file = Helpers_misc.read_file full_path in + let spaced_file = Str.global_replace (Str.regexp_string "\n") "\n " file in + let program = "{" ^ spaced_file ^ "}" in + parse_execute ctxt ?tc program input storage -let test_fails ?location parse_execute f s i = - test parse_execute f s i >>= fun x -> +let test_fails ctxt ?location f s i = + test ctxt f s i >>= fun x -> let msg = Option.unopt ~default:"Not failing" location in Assert.generic_economic_error ~msg x ; return () - let string_of_canon output_prim = let output_can = Proto_alpha.Michelson_v1_primitives.strings_of_prims output_prim in let location_maker _ = @@ -79,9 +78,8 @@ let string_of_canon output_prim = let output = Format.flush_str_formatter () in output - -let test_print parse_execute fn s i = - test parse_execute fn s i >>=? fun (sp, op, _) -> +let test_print ctxt fn s i = + test ctxt fn s i >>=? fun (sp, op, _, _) -> let ss = string_of_canon sp in let os = string_of_canon op in debug "Storage : %s" ss ; @@ -89,36 +87,37 @@ let test_print parse_execute fn s i = return () -let test_output parse_execute ?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) -> +let test_output ctxt ?location (file_name: string) (storage: string) (input: string) (expected_output: string) = + test ctxt file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts) -> let output = string_of_canon output_prim in let msg = Option.unopt ~default:"strings aren't equal" location in Assert.equal_string ~msg expected_output output ; return () -let test_tc ?tc parse_execute (file_name: string) (storage: string) (input: string) = - test parse_execute ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts) -> +let test_tc ctxt ?tc (file_name: string) (storage: string) (input: string) = + test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts) -> return (tc) -let test_contract ?tc parse_execute (file_name: string) (storage: string) (input: string) = - test parse_execute ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts) -> +let test_contract ctxt ?tc (file_name: string) (storage: string) (input: string) = + test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts) -> return (contracts, tc) -let test_storage parse_execute ?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) -> +let test_storage ctxt ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) = + test ctxt file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts) -> let storage = string_of_canon storage_prim in let msg = Option.unopt ~default:"strings aren't equal" location in Assert.equal_string ~msg expected_storage storage ; return () -let test_example parse_execute sb = +let test_example () = + Init.main () >>=?? fun sb -> 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 | Error(errs) -> ( match location with @@ -126,11 +125,11 @@ let test_example parse_execute sb = | Some(loc) -> debug "loc : %s" loc ) ; Lwt.return (Error(errs)) in - let test_fails ?location = test_fails ?location parse_execute in - let test_tc ?tc = test_tc ?tc parse_execute in - let test_contract ?tc = test_contract ?tc parse_execute in - (* let test_print ?location = test_print ?location parse_execute in*) - let test_storage ?location = test_storage ?location parse_execute in + let test_fails ?location = test_fails ?location sb in + let test_tc ?tc = test_tc ?tc sb in + let test_contract ?tc = test_contract ?tc sb in + (* let test_print ?location = test_print ?location sb in*) + let test_storage ?location = test_storage ?location sb in (* FORMAT: assert_output contract_file storage input expected_result *) test_output ~location: __LOC__ "ret_int" "Unit" "Unit" "300" >>=? fun _ -> @@ -451,7 +450,8 @@ let test_example parse_execute sb = return () -let test_program parse_execute = +let test_program () = + Init.main () >>=?? fun sb -> let id_code = "code { DUP ; PAIR ; @@ -470,35 +470,16 @@ let test_program parse_execute = PAIR }" in let push_300 = program "unit" "nat" "unit" push_300_code in - parse_execute id_int_program "2" "3" >>=? fun _ -> - parse_execute id_ill_param_program "2" "3" >>= fun x -> + parse_execute sb id_int_program "2" "3" >>=? fun _ -> + parse_execute sb id_ill_param_program "2" "3" >>= fun 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 ; - parse_execute push_300 "Unit" "Unit" >>=? fun _ -> - parse_execute id_pbool_program "(Pair True True)" "Unit" >>=? fun _ -> + parse_execute sb push_300 "Unit" "Unit" >>=? fun _ -> + parse_execute sb id_pbool_program "(Pair True True)" "Unit" >>=? fun _ -> 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 = [ - "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 diff --git a/src/proto_alpha/lib_protocol/test/test_isolate_origination.ml b/src/proto_alpha/lib_protocol/test/test_isolate_origination.ml index e3081f563..81b0020a7 100644 --- a/src/proto_alpha/lib_protocol/test/test_isolate_origination.ml +++ b/src/proto_alpha/lib_protocol/test/test_isolate_origination.ml @@ -7,101 +7,82 @@ (* *) (**************************************************************************) +open Proto_alpha +open Error_monad let name = "Isolate Origination" 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 open Isolate_helpers +open Helpers_block let (>>?=) = Assert.(>>?=) let (>>=??) = Assert.(>>=??) -let test_simple_origination originate = - let open Proto_alpha.Error_monad in +let originate root ?(tc=root.tezos_context) ?baker ?spendable ?fee ?delegatable src amount = + let delegatable = Option.unopt ~default:true delegatable in + let spendable = Option.unopt ~default:true spendable in + let fee = Option.unopt ~default:10 fee in + Apply.origination_pred + ?baker + ~tc + ~pred: root + (src, amount, spendable, delegatable, fee) + +let test_simple_origination () = + + Init.main () >>=? fun root -> let src = List.hd Account.bootstrap_accounts in (* 0 balance should fail *) - originate src 0 >>= Assert.wrap >>= fun result -> + originate root 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 -> + originate root src 50 >>= Assert.wrap >>= fun result -> Assert.initial_amount_too_low ~msg: __LOC__ result ; (* 2. Balance should work *) - originate src 200 >>= Assert.ok >>= fun _ -> + originate root 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 delegate root ?(tc=root.tezos_context) ?baker ?fee src delegate = + let fee = Option.unopt ~default:10 fee in + Apply.delegation_pred + ?baker + ~tc + ~pred: root + (src, delegate, fee) - let open Proto_alpha.Error_monad in +let test_delegation () = + + 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 - ~delegatable: true account_a 200 + 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 ~tc account_ac account_b.hpub >>= Assert.ok ~msg: __LOC__ >>= fun _ -> + delegate root ~tc account_ac account_b.hpub >>= Assert.ok ~msg: __LOC__ >>= fun _ -> (* Not-Delegatable should not change delegate *) - originate - ~delegatable: false account_a 200 + 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 ~tc account_a account_b.hpub >>= Assert.wrap >>= fun res -> + 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 (): 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 spendable = Option.unopt ~default:true spendable in - let fee = Option.unopt ~default:10 fee in - Apply.origination_pred - ?baker - ~tc - ~pred: root - (src, amount, spendable, delegatable, fee) - in - let delegate ?(tc=root.tezos_context) ?baker ?fee src delegate = - let fee = Option.unopt ~default:10 fee in - Apply.delegation_pred - ?baker - ~tc - ~pred: root - (src, delegate, fee) - in - - test_simple_origination originate >>=?? fun () -> - test_delegation - (originate ?fee: None ?baker: None ~spendable: true) - (delegate ?fee: None ?baker: None) >>=?? fun () -> - - Error_monad.return () - - -let tests = [ - "main", (fun _ -> main ()) ; -] - -let main () = - let module Test = Test.Make(Error_monad) in - Test.run "origination." tests diff --git a/src/proto_alpha/lib_protocol/test/test_isolate_transaction.ml b/src/proto_alpha/lib_protocol/test/test_isolate_transaction.ml index 85da233b6..7da17ecb8 100644 --- a/src/proto_alpha/lib_protocol/test/test_isolate_transaction.ml +++ b/src/proto_alpha/lib_protocol/test/test_isolate_transaction.ml @@ -7,40 +7,18 @@ (* *) (**************************************************************************) +open Proto_alpha +open Error_monad + let name = "Isolate Transactions" 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 module Helpers = Isolate_helpers -open Helpers -open Proto_alpha.Error_monad +module Assert = Helpers.Assert -let test_cycle_transfer (pred: Helpers.Block.result) = - 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 run (starting_block: Helpers.Block.result): unit tzresult Lwt.t = +let test_basic (): unit tzresult Lwt.t = + Helpers.Init.main () >>=? fun starting_block -> let init_tc = starting_block.tezos_context in 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.inconsistent_pkh ~msg: __LOC__ result ; debug "No manager key" ; - - test_cycle_transfer starting_block >>=? fun _ -> - 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 () = - Helpers.Init.main () >>=? fun starting_block -> - run starting_block - - -let tests = [ - "main", (fun _ -> main () >>= Assert.wrap) ; -] - -let main () = - let module Test = Test.Make(Error_monad) in - Test.run "transactions." tests +let tests = + List.map + (fun (n, f) -> (n, (fun (_: string) -> f () >>= Assert.wrap))) + [ "transaction.basic", test_basic ; + "transaction.cycle_transfer", test_cycle_transfer + ]