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

Michelson: adds LOOP_LEFT, ITER, MAP body

Browse Source
This commit is contained in:
Milo Davis 2017-10-05 17:29:57 +02:00 committed by Benjamin Canou
parent c387ed823a
commit 6c992b58df
17 changed files with 295 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/client/embedded/alpha/client_proto_programs.ml
View File

@ -9,6 +9,7 @@
module Ed25519 = Environment.Ed25519
open Client_proto_args
open Michelson_v1_printer
module Program = Client_aliases.Alias (struct

48
src/proto/alpha/michelson_v1_primitives.ml
View File

@ -94,6 +94,8 @@ type prim =
| I_UNIT
| I_UPDATE
| I_XOR
| I_ITER
| I_LOOP_LEFT
| T_bool
| T_contract
| T_int
@ -214,6 +216,8 @@ let string_of_prim = function
| I_UNIT -> "UNIT"
| I_UPDATE -> "UPDATE"
| I_XOR -> "XOR"
| I_ITER -> "ITER"
| I_LOOP_LEFT -> "LOOP_LEFT"
| T_bool -> "bool"
| T_contract -> "contract"
| T_int -> "int"
@ -315,6 +319,8 @@ let prim_of_string = function
| "UNIT" -> ok I_UNIT
| "UPDATE" -> ok I_UPDATE
| "XOR" -> ok I_XOR
| "ITER" -> ok I_ITER
| "LOOP_LEFT" -> ok I_LOOP_LEFT
| "bool" -> ok T_bool
| "contract" -> ok T_contract
| "int" -> ok T_int
@ -457,24 +463,26 @@ let prim_encoding =
| I_UNIT -> 78
| I_UPDATE -> 79
| I_XOR -> 80
| T_bool -> 81
| T_contract -> 82
| T_int -> 83
| T_key -> 84
| T_key_hash -> 85
| T_lambda -> 86
| T_list -> 87
| T_map -> 88
| T_nat -> 89
| T_option -> 90
| T_or -> 91
| T_pair -> 92
| T_set -> 93
| T_signature -> 94
| T_string -> 95
| T_tez -> 96
| T_timestamp -> 97
| T_unit -> 99 in
| I_ITER -> 81
| I_LOOP_LEFT -> 82
| T_bool -> 83
| T_contract -> 84
| T_int -> 85
| T_key -> 86
| T_key_hash -> 87
| T_lambda -> 88
| T_list -> 89
| T_map -> 90
| T_nat -> 91
| T_option -> 92
| T_or -> 93
| T_pair -> 94
| T_set -> 95
| T_signature -> 96
| T_string -> 97
| T_tez -> 98
| T_timestamp -> 99
| T_unit -> 100 in
let of_int_map = [|
K_parameter ;
K_return ;
@ -557,6 +565,8 @@ let prim_encoding =
I_UNIT ;
I_UPDATE ;
I_XOR ;
I_ITER ;
I_LOOP_LEFT ;
T_bool ;
T_contract ;
T_int ;
@ -576,7 +586,7 @@ let prim_encoding =
T_timestamp ;
T_unit |] in
let of_int i =
if Compare.Int.(i >= 0 || i <= 99) then
if Compare.Int.(i >= 0 || i <= 100) then
of_int_map.(i)
else
raise Data_encoding.No_case_matched in

2
src/proto/alpha/michelson_v1_primitives.mli
View File

@ -92,6 +92,8 @@ type prim =
| I_UNIT
| I_UPDATE
| I_XOR
| I_ITER
| I_LOOP_LEFT
| T_bool
| T_contract
| T_int

43
src/proto/alpha/script_interpreter.ml
View File

@ -142,6 +142,17 @@ let rec interp
return (ret :: tail, qta, ctxt, origination))
l ([], qta, ctxt, origination) >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| List_map_body body, Item (l, rest) ->
let rec help rest qta = function
| [] -> logged_return ~origination (Item ([], rest), qta, ctxt)
| hd :: tl ->
step origination qta ctxt body (Item (hd, rest))
>>=? fun (Item (hd, rest), qta, _, _) ->
help rest qta tl
>>=? fun (Item (tl, rest), qta, ctxt, origination) ->
logged_return ~origination (Item (hd :: tl, rest), qta, ctxt)
in help rest qta l >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (res, qta - 1, ctxt)
| List_reduce, Item (lam, Item (l, Item (init, rest))) ->
fold_left_s
(fun (partial, qta, ctxt, origination) arg ->
@ -154,6 +165,14 @@ let rec interp
let len = List.length list in
let len = Script_int.(abs (of_int len)) in
logged_return (Item (len, rest), qta - 1, ctxt)
| List_iter body, Item (l, init_stack) ->
fold_left_s
(fun (stack, qta, ctxt, origination) arg ->
step origination qta ctxt body (Item (arg, stack))
>>=? fun (stack, qta, ctxt, origination) ->
return (stack, qta, ctxt, origination))
(init_stack, qta, ctxt, origination) l >>=? fun (stack, qta, ctxt, origination) ->
logged_return ~origination (stack, qta, ctxt)
(* sets *)
| Empty_set t, rest ->
logged_return (Item (empty_set t, rest), qta - 1, ctxt)
@ -177,6 +196,15 @@ let rec interp
return (partial, qta, ctxt, origination))
(init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| Set_iter body, Item (set, init_stack) ->
fold_left_s
(fun (stack, qta, ctxt, origination) arg ->
step origination qta ctxt body (Item (arg, stack))
>>=? fun (stack, qta, ctxt, origination) ->
return (stack, qta, ctxt, origination))
(init_stack, qta, ctxt, origination)
(set_fold (fun e acc -> e :: acc) set []) >>=? fun (stack, qta, ctxt, origination) ->
logged_return ~origination (stack, qta, ctxt)
| Set_mem, Item (v, Item (set, rest)) ->
logged_return (Item (set_mem v set, rest), qta - 1, ctxt)
| Set_update, Item (v, Item (presence, Item (set, rest))) ->
@ -206,6 +234,16 @@ let rec interp
return (partial, qta, ctxt, origination))
(init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (res, rest), qta, ctxt)
| Map_iter body, Item (map, init_stack) ->
let items =
List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
fold_left_s
(fun (stack, qta, ctxt, origination) arg ->
step origination qta ctxt body (Item (arg, stack))
>>=? fun (stack, qta, ctxt, origination) ->
return (stack, qta, ctxt, origination))
(init_stack, qta, ctxt, origination) items >>=? fun (stack, qta, ctxt, origination) ->
logged_return ~origination (stack, qta, ctxt)
| Map_mem, Item (v, Item (map, rest)) ->
logged_return (Item (map_mem v map, rest), qta - 1, ctxt)
| Map_get, Item (v, Item (map, rest)) ->
@ -364,6 +402,11 @@ let rec interp
step origination (qta - 1) ctxt descr trans
| Loop _, Item (false, rest) ->
logged_return (rest, qta, ctxt)
| Loop_left body, Item (L v, rest) ->
step origination qta ctxt body (Item (v, rest)) >>=? fun (trans, qta, ctxt, origination) ->
step origination (qta - 1) ctxt descr trans
| Loop_left _, Item (R v, rest) ->
logged_return (Item (v, rest), qta, ctxt)
| Dip b, Item (ign, rest) ->
step origination qta ctxt b rest >>=? fun (res, qta, ctxt, origination) ->
logged_return ~origination (Item (ign, res), qta, ctxt)

132
src/proto/alpha/script_ir_translator.ml
View File

@ -41,6 +41,9 @@ type error += Bad_stack_item of int
type error += Inconsistent_annotations of string * string
type error += Inconsistent_type_annotations : Script.location * _ ty * _ ty -> error
type error += Unexpected_annotation of Script.location
type error += Invalid_map_body : Script.location * _ stack_ty -> error
type error += Invalid_map_block_fail of Script.location
type error += Invalid_iter_body : Script.location * _ stack_ty * _ stack_ty -> error
(* Value typing errors *)
type error += Invalid_constant : Script.location * Script.expr * _ ty -> error
@ -173,7 +176,9 @@ let namespace = function
| I_TRANSFER_TOKENS
| I_UNIT
| I_UPDATE
| I_XOR -> Instr_namespace
| I_XOR
| I_ITER
| I_LOOP_LEFT -> Instr_namespace
| T_bool
| T_contract
| T_int
@ -1134,10 +1139,25 @@ and parse_instr
let branch ibt ibf =
{ loc ; instr = If_cons (ibt, ibf) ; bef ; aft = ibt.aft } in
merge_branches loc btr bfr { branch }
| Prim (loc, I_SIZE, [], instr_annot),
Item_t (List_t _, rest, _) ->
return (typed loc (List_size, Item_t (Nat_t, rest, instr_annot)))
| Prim (loc, I_MAP, [], instr_annot),
Item_t (Lambda_t (param, ret), Item_t (List_t elt, rest, _), _) ->
check_item_ty elt param loc I_MAP 2 2 >>=? fun (Eq _) ->
return (typed loc (List_map, Item_t (List_t ret, rest, instr_annot)))
| Prim (loc, I_MAP, [ body ], instr_annot),
(Item_t (List_t elt, starting_rest, _)) ->
check_kind [ Seq_kind ] body >>=? fun () ->
parse_instr ?type_logger tc_context ctxt body (Item_t (elt, starting_rest, None)) >>=? begin function
| Typed ({ aft = Item_t (ret, rest, _) } as ibody) ->
trace
(Invalid_map_body (loc, ibody.aft))
(Lwt.return (stack_ty_eq 1 rest starting_rest)) >>=? fun (Eq _) ->
return (typed loc (List_map_body ibody, Item_t (List_t ret, rest, instr_annot)))
| Typed { aft } -> fail (Invalid_map_body (loc, aft))
| Failed _ -> fail (Invalid_map_block_fail loc)
end
| Prim (loc, I_REDUCE, [], instr_annot),
Item_t (Lambda_t (Pair_t ((pelt, _), (pr, _)), r),
Item_t (List_t elt, Item_t (init, rest, _), _), _) ->
@ -1148,6 +1168,20 @@ and parse_instr
| Prim (loc, I_SIZE, [], instr_annot),
Item_t (List_t _, rest, _) ->
return (typed loc (List_size, Item_t (Nat_t, rest, instr_annot)))
| Prim (loc, I_ITER, [ body ], instr_annot),
Item_t (List_t elt, rest, _) ->
check_kind [ Seq_kind ] body >>=? fun () ->
fail_unexpected_annot loc instr_annot >>=? fun () ->
parse_instr ?type_logger tc_context ctxt body (Item_t (elt, rest, None)) >>=? begin function
| Typed ({ aft } as ibody) ->
trace
(Invalid_iter_body (loc, rest, ibody.aft))
(Lwt.return (stack_ty_eq 1 aft rest)) >>=? fun (Eq _) ->
return (typed loc (List_iter ibody, rest))
| Failed { descr } ->
let ibody = descr rest in
return (typed loc (List_iter ibody, rest))
end
(* sets *)
| Prim (loc, I_EMPTY_SET, [ t ], instr_annot),
rest ->
@ -1167,6 +1201,21 @@ and parse_instr
check_item_ty elt pelt loc I_REDUCE 2 3 >>=? fun (Eq _) ->
check_item_ty init r loc I_REDUCE 3 3 >>=? fun (Eq _) ->
return (typed loc (Set_reduce, Item_t (r, rest, instr_annot)))
| Prim (loc, I_ITER, [ body ], annot),
Item_t (Set_t comp_elt, rest, _) ->
check_kind [ Seq_kind ] body >>=? fun () ->
fail_unexpected_annot loc annot >>=? fun () ->
let elt = ty_of_comparable_ty comp_elt in
parse_instr ?type_logger tc_context ctxt body (Item_t (elt, rest, None)) >>=? begin function
| Typed ({ aft } as ibody) ->
trace
(Invalid_iter_body (loc, rest, ibody.aft))
(Lwt.return (stack_ty_eq 1 aft rest)) >>=? fun (Eq _) ->
return (typed loc (Set_iter ibody, rest))
| Failed { descr } ->
let ibody = descr rest in
return (typed loc (Set_iter ibody, rest))
end
| Prim (loc, I_MEM, [], instr_annot),
Item_t (v, Item_t (Set_t elt, rest, _), _) ->
let elt = ty_of_comparable_ty elt in
@ -1203,6 +1252,23 @@ and parse_instr
check_item_ty r pr loc I_REDUCE 1 3 >>=? fun (Eq _) ->
check_item_ty init r loc I_REDUCE 3 3 >>=? fun (Eq _) ->
return (typed loc (Map_reduce, Item_t (r, rest, instr_annot)))
| Prim (loc, I_ITER, [ body ], instr_annot),
Item_t (Map_t (comp_elt, element_ty), rest, _) ->
check_kind [ Seq_kind ] body >>=? fun () ->
fail_unexpected_annot loc instr_annot >>=? fun () ->
let key = ty_of_comparable_ty comp_elt in
parse_instr ?type_logger tc_context ctxt body
(Item_t (Pair_t ((key, None), (element_ty, None)), rest, None))
>>=? begin function
| Typed ({ aft } as ibody) ->
trace
(Invalid_iter_body (loc, rest, ibody.aft))
(Lwt.return (stack_ty_eq 1 aft rest)) >>=? fun (Eq _) ->
return (typed loc (Map_iter ibody, rest))
| Failed { descr } ->
let ibody = descr rest in
return (typed loc (Map_iter ibody, rest))
end
| Prim (loc, I_MEM, [], instr_annot),
Item_t (vk, Item_t (Map_t (ck, _), rest, _), _) ->
let k = ty_of_comparable_ty ck in
@ -1279,6 +1345,20 @@ and parse_instr
let ibody = descr (Item_t (Bool_t, rest, stack_annot)) in
return (typed loc (Loop ibody, rest))
end
| Prim (loc, I_LOOP_LEFT, [ body ], instr_annot),
(Item_t (Union_t ((tl, tl_annot), (tr, tr_annot)), rest, _) as stack) ->
check_kind [ Seq_kind ] body >>=? fun () ->
fail_unexpected_annot loc instr_annot >>=? fun () ->
parse_instr ?type_logger tc_context ctxt body (Item_t (tl, rest, tl_annot)) >>=? begin function
| Typed ibody ->
trace
(Unmatched_branches (loc, ibody.aft, stack))
(Lwt.return (stack_ty_eq 1 ibody.aft stack)) >>=? fun (Eq _) ->
return (typed loc (Loop_left ibody, (Item_t (tr, rest, tr_annot))))
| Failed { descr } ->
let ibody = descr (Item_t (Union_t ((tl, tl_annot), (tr, tr_annot)), rest, None)) in
return (typed loc (Loop_left ibody, Item_t (tr, rest, tr_annot)))
end
| Prim (loc, I_LAMBDA, [ arg ; ret ; code ], instr_annot),
stack ->
(Lwt.return (parse_ty arg)) >>=? fun (Ex_ty arg, arg_annot) ->
@ -1584,8 +1664,8 @@ and parse_instr
| I_H | I_STEPS_TO_QUOTA
as name), (_ :: _ as l), _), _ ->
fail (Invalid_arity (loc, name, 0, List.length l))
| Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL
| I_EMPTY_SET | I_DIP | I_LOOP
| Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER
| I_EMPTY_SET | I_DIP | I_LOOP | I_LOOP_LEFT
as name), ([]
| _ :: _ :: _ as l), _), _ ->
fail (Invalid_arity (loc, name, 1, List.length l))
@ -1628,7 +1708,7 @@ and parse_instr
stack ->
fail (Bad_stack (loc, name, 1, stack))
| Prim (loc, (I_SWAP | I_PAIR | I_CONS
| I_MAP | I_GET | I_MEM | I_EXEC
| I_GET | I_MEM | I_EXEC
| I_CHECK_SIGNATURE | I_ADD | I_SUB | I_MUL
| I_EDIV | I_AND | I_OR | I_XOR
| I_LSL | I_LSR | I_CONCAT as name), _, _),
@ -1639,7 +1719,7 @@ and parse_instr
fail @@ unexpected expr [ Seq_kind ] Instr_namespace
[ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ;
I_PAIR ; I_CAR ; I_CDR ; I_CONS ;
I_MEM ; I_UPDATE ; I_MAP ; I_REDUCE ;
I_MEM ; I_UPDATE ; I_MAP ; I_REDUCE ; I_ITER ;
I_GET ; I_EXEC ; I_FAIL ; I_SIZE ;
I_CONCAT ; I_ADD ; I_SUB ;
I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ;
@ -2203,7 +2283,47 @@ let () =
| _ -> None)
(fun (Ex_ty tya, Ex_ty tyb) ->
Inconsistent_types (tya, tyb)) ;
register_error_kind
`Permanent
~id:"invalidMapBody"
~title: "Invalid map body"
~description:
"The body of a map block did not match the expected type"
(obj2
(req "loc" Script.location_encoding)
(req "bodyType" ex_stack_ty_enc))
(function
| Invalid_map_body (loc, stack) ->
Some (loc, Ex_stack_ty stack)
| _ -> None)
(fun (loc, Ex_stack_ty stack) ->
Invalid_map_body (loc, stack)) ;
register_error_kind
`Permanent
~id:"invalidMapBlockFail"
~title:"FAIL instruction occurred as body of map block"
~description:"FAIL cannot be the only instruction in the body.\
The propper type of the return list cannot be inferred."
(obj1 (req "loc" Script.location_encoding))
(function
| Invalid_map_block_fail loc -> Some loc
| _ -> None)
(fun loc -> Invalid_map_block_fail loc) ;
register_error_kind
`Permanent
~id:"invalidIterBody"
~title:"ITER body returned wrong stack type"
~description:"The body of an ITER instruction\
must result in the same stack type as before\
the ITER."
(obj3
(req "loc" Script.location_encoding)
(req "befStack" ex_stack_ty_enc)
(req "aftStack" ex_stack_ty_enc))
(function
| Invalid_iter_body (loc, bef, aft) -> Some (loc, Ex_stack_ty bef, Ex_stack_ty aft)
| _ -> None)
(fun (loc, Ex_stack_ty bef, Ex_stack_ty aft) -> Invalid_iter_body (loc, bef, aft)) ;
(* Toplevel errors *)
register_error_kind
`Permanent

3
src/proto/alpha/script_ir_translator.mli
View File

@ -47,6 +47,9 @@ type error += Transfer_in_lambda of Script.location
type error += Transfer_in_dip of Script.location
type error += Bad_stack_length
type error += Bad_stack_item of int
type error += Invalid_map_body : Script.location * _ Script_typed_ir.stack_ty -> error
type error += Invalid_map_block_fail of Script.location
type error += Invalid_iter_body : Script.location * _ Script_typed_ir.stack_ty * _ Script_typed_ir.stack_ty -> error
(* Value typing errors *)
type error += Invalid_constant : Script.location * Script.expr * _ Script_typed_ir.ty -> error

13
src/proto/alpha/script_typed_ir.ml
View File

@ -134,10 +134,15 @@ and ('bef, 'aft) instr =
('a list * 'bef, 'aft) instr
| List_map :
(('param, 'ret) lambda * ('param list * 'rest), 'ret list * 'rest) instr
| List_map_body : ('a * 'rest, 'b * 'rest) descr ->
('a list * 'rest, 'b list * 'rest) instr
| List_reduce :
(('param * 'res, 'res) lambda *
('param list * ('res * 'rest)), 'res * 'rest) instr
| List_size : ('a list * 'rest, n num * 'rest) instr
| List_iter :
('a * 'rest, 'rest) descr ->
('a list * 'rest, 'rest) instr
(* sets *)
| Empty_set : 'a comparable_ty ->
('rest, 'a set * 'rest) instr
@ -146,6 +151,9 @@ and ('bef, 'aft) instr =
| Set_reduce :
(('param * 'res, 'res) lambda *
('param set * ('res * 'rest)), 'res * 'rest) instr
| Set_iter :
('a * 'rest, 'rest) descr ->
('a set * 'rest, 'rest) instr
| Set_mem :
('elt * ('elt set * 'rest), bool * 'rest) instr
| Set_update :
@ -159,6 +167,9 @@ and ('bef, 'aft) instr =
| Map_reduce :
((('a * 'v) * 'res, 'res) lambda *
(('a, 'v) map * ('res * 'rest)), 'res * 'rest) instr
| Map_iter :
(('a * 'v) * 'rest, 'rest) descr ->
(('a, 'v) map * 'rest, 'rest) instr
| Map_mem :
('a * (('a, 'v) map * 'rest), bool * 'rest) instr
| Map_get :
@ -263,6 +274,8 @@ and ('bef, 'aft) instr =
(bool * 'bef, 'aft) instr
| Loop : ('rest, bool * 'rest) descr ->
(bool * 'rest, 'rest) instr
| Loop_left : ('a * 'rest, ('a, 'b) union * 'rest) descr ->
(('a, 'b) union * 'rest, 'b * 'rest) instr
| Dip : ('bef, 'aft) descr ->
('top * 'bef, 'top * 'aft) instr
| Exec :

2
src/proto/alpha/tezos_context.mli
View File

@ -207,6 +207,8 @@ module Script : sig
| I_UNIT
| I_UPDATE
| I_XOR
| I_ITER
| I_LOOP_LEFT
| T_bool
| T_contract
| T_int

8
test/contracts/fail.tz
View File

@ -1,6 +1,6 @@
parameter unit
parameter unit;
code
{ # This contract will never accept a incoming transaction
FAIL}
return unit
storage unit
FAIL};
return unit;
storage unit;

6
test/contracts/list_iter.tz Normal file
View File

@ -0,0 +1,6 @@
parameter (list int);
storage unit;
return int;
code { CAR; PUSH int 1; SWAP;
ITER { MUL };
UNIT; SWAP; PAIR}

6
test/contracts/list_iter2.tz Normal file
View File

@ -0,0 +1,6 @@
parameter (list string);
return string;
storage unit;
code { CAR; PUSH string ""; SWAP;
ITER { CONCAT };
UNIT; SWAP; PAIR}

6
test/contracts/list_map_block.tz Normal file
View File

@ -0,0 +1,6 @@
parameter (list int);
return (list int);
storage unit;
code { CAR; PUSH int 0; SWAP;
MAP { DIP{DUP}; ADD; DIP{PUSH int 1; ADD}};
UNIT; SWAP; PAIR; DIP{DROP}}

8
test/contracts/loop_left.tz Normal file
View File

@ -0,0 +1,8 @@
parameter (list string);
return (list string);
storage unit;
code { CAR; NIL string; SWAP; PAIR; LEFT (list string);
LOOP_LEFT { DUP; CAR; DIP{CDR};
IF_CONS { SWAP; DIP{CONS}; PAIR; LEFT (list string) }
{ RIGHT (pair (list string) (list string)) }; };
UNIT; SWAP; PAIR }

7
test/contracts/map_iter.tz Normal file
View File

@ -0,0 +1,7 @@
parameter (map int int);
return (pair int int);
storage unit;
code { CAR; PUSH int 0; DUP; PAIR; SWAP;
ITER { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr
DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR };
UNIT; SWAP; PAIR}

4
test/contracts/set_iter.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (set int);
return int;
storage unit;
code { CAR; PUSH int 0; SWAP; ITER { ADD }; UNIT; SWAP; PAIR }

2
test/contracts/weather_insurance.tz
View File

@ -13,6 +13,6 @@ code { DUP; DUP;
DIIP{CDAR}; # Place contracts below numbers
DIP{CADR}; # Get actual rain
CDDAR; # Get rain threshold
CMPLT; IF {CAR @lt; ANNOT @winner} {CDR @geq; ANNOT @winner}; # Select contract to receive tokens
CMPLT; IF {CAR @winner} {CDR @winner}; # Select contract to receive tokens
BALANCE; UNIT; TRANSFER_TOKENS; # Setup and execute transfer
PAIR }; # Save storage

35
test/test_contracts.sh
View File

@ -15,9 +15,16 @@ key2=bar
$client gen keys $key1
$client gen keys $key2
CONTRACT_PATH=contracts
printf "\n\n"
CONTRACT_PATH=contracts
# Assert well typed
echo "Typechecking contracts in '${CONTRACT_PATH}'"
ls $CONTRACT_PATH \
| xargs -I{} $client typecheck program $CONTRACT_PATH/{} > /dev/null
printf "All contracts are well typed\n\n"
# FORMAT: assert_output contract_file storage input expected_result
@ -94,6 +101,19 @@ assert_output $CONTRACT_PATH/map_id.tz Unit '(Map (Item 0 1))' '(Map (Item 0 1))
assert_output $CONTRACT_PATH/map_id.tz Unit '(Map (Item 0 0))' '(Map (Item 0 0))'
assert_output $CONTRACT_PATH/map_id.tz Unit '(Map (Item 0 0) (Item 3 4))' '(Map (Item 0 0) (Item 3 4))'
# Map block on lists
assert_output $CONTRACT_PATH/list_map_block.tz Unit '(List)' 'List'
assert_output $CONTRACT_PATH/list_map_block.tz Unit '(List 1 1 1 1)' '(List 1 2 3 4)'
assert_output $CONTRACT_PATH/list_map_block.tz Unit '(List 1 2 3 0)' '(List 1 3 5 3)'
# List iter
assert_output $CONTRACT_PATH/list_iter.tz Unit '(List 10 2 1)' 20
assert_output $CONTRACT_PATH/list_iter.tz Unit '(List 3 6 9)' 162
assert_output $CONTRACT_PATH/list_iter2.tz Unit '(List "a" "b" "c")' '"cba"'
assert_output $CONTRACT_PATH/list_iter2.tz Unit '(List)' '""'
# Identity on sets
assert_output $CONTRACT_PATH/set_id.tz Unit '(Set "a" "b" "c")' '(Set "a" "b" "c")'
assert_output $CONTRACT_PATH/set_id.tz Unit '(Set)' 'Set'
@ -110,6 +130,11 @@ assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1)' 1
assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1 2 3)' 3
assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1 2 3 4 5 6)' 6
# Set iter
assert_output $CONTRACT_PATH/set_iter.tz Unit '(Set)' 0
assert_output $CONTRACT_PATH/set_iter.tz Unit '(Set 1)' 1
assert_output $CONTRACT_PATH/set_iter.tz Unit '(Set -100 1 2 3)' '-94'
# Map size
assert_output $CONTRACT_PATH/map_size.tz Unit '(Map)' 0
assert_output $CONTRACT_PATH/map_size.tz Unit '(Map (Item "a" 1))' 1
@ -154,6 +179,10 @@ assert_output $CONTRACT_PATH/get_map_value.tz \
'(Map (Item "1" "one") (Item "2" "two"))' \
'"1"' '(Some "one")'
# Map iter
assert_output $CONTRACT_PATH/map_iter.tz Unit '(Map (Item 0 100) (Item 2 100))' '(Pair 2 200)'
assert_output $CONTRACT_PATH/map_iter.tz Unit '(Map (Item 1 1) (Item 2 100))' '(Pair 3 101)'
# Return True if True branch of if was taken and False otherwise
assert_output $CONTRACT_PATH/if.tz Unit True True
assert_output $CONTRACT_PATH/if.tz Unit False False
@ -168,6 +197,10 @@ assert_output $CONTRACT_PATH/reverse.tz Unit '(List "c" "b" "a")' '(List "a" "b"
assert_output $CONTRACT_PATH/reverse_loop.tz Unit '(List )' 'List'
assert_output $CONTRACT_PATH/reverse_loop.tz Unit '(List "c" "b" "a")' '(List "a" "b" "c")'
# Reverse using LOOP_LEFT
assert_output $CONTRACT_PATH/loop_left.tz Unit '(List )' 'List'
assert_output $CONTRACT_PATH/loop_left.tz Unit '(List "c" "b" "a")' '(List "a" "b" "c")'
# Exec concat contract
assert_output $CONTRACT_PATH/exec_concat.tz Unit '""' '"_abc"'
assert_output $CONTRACT_PATH/exec_concat.tz Unit '"test"' '"test_abc"'