balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Proto_alpha/test: split tests.

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-05 20:51:58 +01:00
parent 1cc7dd46fe
commit c6bf7d78b6
8 changed files with 149 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml
View File

@ -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)

2
src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli
View File

@ -8,5 +8,5 @@
(**************************************************************************)
val name : string
module Logger : Logging.LOG
include Logging.LOG

29
src/proto_alpha/lib_protocol/test/test_isolate_dsl.ml
View File

@ -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
]

48
src/proto_alpha/lib_protocol/test/test_isolate_endorsement.ml
View File

@ -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 ;
]

13
src/proto_alpha/lib_protocol/test/test_isolate_main.ml
View File

@ -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 )

95
src/proto_alpha/lib_protocol/test/test_isolate_michelson.ml
View File

@ -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 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 ?tc program input storage
in
test
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

119
src/proto_alpha/lib_protocol/test/test_isolate_origination.ml
View File

@ -7,71 +7,20 @@
(* *)
(**************************************************************************)
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 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 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
@ -80,28 +29,60 @@ let main (): unit Error_monad.tzresult Lwt.t =
~tc
~pred: root
(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
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 () ->
let test_delegation () =
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 = [
"main", (fun _ -> main ()) ;
]
(* Not-Delegatable should not change delegate *)
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

75
src/proto_alpha/lib_protocol/test/test_isolate_transaction.ml
View File

@ -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
]