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

Michelson: add isolate test for big maps

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-05 17:35:00 +01:00
parent 5ae24aa7a3
commit 8bec8b7b9c
5 changed files with 147 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/bin_client/test/contracts/big_map_union.tz Normal file
View File

@ -0,0 +1,9 @@
parameter (list (pair string int)) ;
storage (pair (big_map string int) unit) ;
return unit ;
code { UNPAAIAIR ;
ITER { UNPAIR ; DUUUP ; DUUP; GET ;
IF_NONE { PUSH int 0 } {} ;
SWAP ; DIP { ADD ; SOME } ;
UPDATE } ;
PAIR ; UNIT ; PAIR }

6
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml
View File

@ -31,7 +31,7 @@ let manager_full src ?(fee = Tez.zero) ops context =
manager src ~fee ops context >>=? fun ops -> return @@ sourced ops
let transaction ?(parameters = None) amount destination =
let transaction ?parameters amount destination =
Transaction {
amount ;
parameters ;
@ -70,8 +70,8 @@ let origination_full ?(spendable = true) ?(delegatable = true) ?(fee = Tez.zero)
manager_full src ~fee [origination ~spendable ~delegatable src credit] context
let transaction_full ?(fee = Tez.zero) src dst amount context =
manager src ~fee [transaction amount dst] context
let transaction_full ?(fee = Tez.zero) ?parameters src dst amount context =
manager src ~fee [transaction ?parameters amount dst] context
>>=? fun manager_op ->
return @@ sourced manager_op

4
src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli
View File

@ -23,7 +23,7 @@ val manager_full :
Proto_alpha.Environment.Context.t -> proto_operation proto_tzresult Lwt.t
val transaction :
?parameters:Script.expr option -> Tez.t -> Contract.contract ->
?parameters:Script.expr -> Tez.t -> Contract.contract ->
manager_operation
val origination :
@ -46,7 +46,7 @@ val origination_full :
proto_operation proto_tzresult Lwt.t
val transaction_full :
?fee:Tez.tez -> Helpers_account.t -> Contract.contract -> Tez.t ->
?fee:Tez.tez -> ?parameters:Proto_alpha.Tezos_context.Script.expr -> Helpers_account.t -> Contract.contract -> Tez.t ->
Proto_alpha.Environment.Context.t -> proto_operation proto_tzresult Lwt.t
val delegate :

1
src/proto_alpha/lib_protocol/test/main.ml
View File

@ -14,4 +14,5 @@ let () =
Test_transaction.tests @
Test_endorsement.tests @
Test_origination.tests @
Test_big_maps.tests @
Test_michelson.tests )

132
src/proto_alpha/lib_protocol/test/test_big_maps.ml Normal file
View File

@ -0,0 +1,132 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let name = "Isolate Big Maps"
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*)
open Logger
module Helpers = Isolate_helpers
module Assert = Helpers.Assert
let (>>??) = Helpers.Assert.(>>??)
let (>>=??) = Helpers.Assert.(>>=??)
let parse_expr s : Proto_alpha.Tezos_context.Script.expr tzresult =
Micheline_parser.no_parsing_error (Michelson_v1_parser.parse_expression s) >>? fun parsed ->
ok parsed.expanded
let parse_script code_str storage_str : Proto_alpha.Tezos_context.Script.t tzresult =
parse_expr code_str >>? fun code ->
parse_expr storage_str >>? fun storage ->
ok { Proto_alpha.Tezos_context.Script.code ; storage }
let code = {|
{ parameter (list (pair string int)) ;
storage (pair (big_map string int) unit) ;
return unit ;
code { UNPAAIAIR ;
ITER { UNPAIR ; DUUUP ; DUUP; GET ;
IF_NONE { PUSH int 0 } {} ;
SWAP ; DIP { ADD ; SOME } ;
UPDATE } ;
PAIR ; UNIT ; PAIR } }
|}
let storage = {| Pair { Elt "A" 1 ; Elt "B" 2 } Unit |}
let expect_big_map tc contract print_key key_type print_data data_type contents =
let open Proto_alpha.Error_monad in
iter_p
(fun (n, exp) ->
let key = Proto_alpha.Script_ir_translator.hash_data key_type n in
Proto_alpha.Tezos_context.Contract.Big_map_storage.get_opt tc contract key >>=? fun data ->
match data, exp with
| None, None ->
debug " - big_map[%a] is not defined (ok)" print_key n ;
return ()
| None, Some _ ->
debug " - big_map[%a] is not defined (error)" print_key n ;
Helpers_assert.fail_msg "Wrong big map contents"
| Some data, None ->
Proto_alpha.Script_ir_translator.parse_data tc data_type (Micheline.root data) >>=? fun data ->
debug " - big_map[%a] = %a (error)" print_key n print_data data ;
Helpers_assert.fail_msg "Wrong big map contents"
| Some data, Some exp ->
Proto_alpha.Script_ir_translator.parse_data tc data_type (Micheline.root data) >>=? fun data ->
debug " - big_map[%a] = %a (expected %a)" print_key n print_data data print_data exp ;
Helpers_assert.equal data exp ;
return ())
contents
let main () =
Helpers.Init.main () >>=?? fun pred ->
let tc = pred.Helpers.Block.tezos_context in
let src = List.hd Helpers.Account.bootstrap_accounts in
Lwt.return (parse_script code storage) >>=? fun script ->
Helpers.Apply.script_origination_pred
~tc ~pred (script , src, 100_00) >>=?? fun ((contracts, errs), tc) ->
begin match errs with
| None | Some [] -> Proto_alpha.Error_monad.return ()
| Some (err :: _) -> Proto_alpha.Error_monad.fail err
end >>=?? fun () ->
begin match contracts with
| [ contract ] -> return contract
| _ -> failwith "more than one contract"
end >>=? fun contract ->
debug "contract created" ;
let expect_big_map tc exp =
expect_big_map tc contract
(fun ppf k -> Format.fprintf ppf "%s" k)
Proto_alpha.Script_typed_ir.String_t
(fun ppf n -> Format.fprintf ppf "%s" (Proto_alpha.Tezos_context.Script_int.to_string n))
Proto_alpha.Script_typed_ir.Int_t
(List.map (fun (n, v) -> (n, Option.map ~f:Proto_alpha.Tezos_context.Script_int.of_int v)) exp) in
expect_big_map tc
[ "A", Some 1 ; "B", Some 2 ; "C", None ; "D", None ] >>=?? fun () ->
debug "initial big map is ok" ;
let call tc input result =
Lwt.return (parse_expr input) >>=? fun parameters ->
Helpers.Operation.transaction_full
src contract (Helpers_cast.cents_of_int 100_00)
(Helpers_cast.ctxt_of_tc tc)
~parameters >>=?? fun op ->
Helpers.Apply.operation ~tc
~src pred.Helpers_block.hash
(Helpers_block.get_op_header_res pred)
op >>=?? fun ((_, errs), tc) ->
begin match errs with
| None | Some [] -> Proto_alpha.Error_monad.return ()
| Some (err :: _) -> Proto_alpha.Error_monad.fail err
end >>=?? fun () ->
expect_big_map tc result >>=?? fun () ->
debug "big map after call %s is ok" input ;
return tc in
call tc
{| {} |}
[ "A", Some 1 ; "B", Some 2 ; "C", None ; "D", None ] >>=? fun tc ->
call tc
{| { Pair "A" 2 } |}
[ "A", Some 3 ; "B", Some 2 ; "C", None ; "D", None ] >>=? fun tc ->
call tc
{| { Pair "A" 2 ; Pair "A" 2 ; Pair "D" 8 } |}
[ "A", Some 7 ; "B", Some 2 ; "C", None ; "D", Some 8 ] >>=? fun tc ->
call tc
{| { Pair "C" 3 } |}
[ "A", Some 7 ; "B", Some 2 ; "C", Some 3 ; "D", Some 8 ] >>=? fun _tc ->
Error_monad.return ()
let tests = [
"main", (fun _ -> main ()) ;
]