502 lines
27 KiB
OCaml
502 lines
27 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2016. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
|
|
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*)
|
|
|
|
open Logger
|
|
|
|
open Isolate_helpers
|
|
open Shorthands
|
|
|
|
let (>>??) = Assert.(>>??)
|
|
let (>>=??) = Assert.(>>=??)
|
|
|
|
open Tezos_micheline
|
|
|
|
let parse_param s : Proto_alpha.Tezos_context.Script.expr =
|
|
let (parsed, _) = Michelson_v1_parser.parse_expression s in
|
|
parsed.expanded
|
|
|
|
|
|
let parse_script code_str storage_str : Proto_alpha.Tezos_context.Script.t =
|
|
let code = parse_param code_str in
|
|
let storage = parse_param storage_str in
|
|
let return: Proto_alpha.Tezos_context.Script.t = {code ; storage} in
|
|
return
|
|
|
|
|
|
let program param ret st code =
|
|
let storage s = " storage " ^ s ^ " ; \n" in
|
|
let parameter s = " parameter " ^ s ^ " ; \n" in
|
|
let return s = " return " ^ s ^ " ; \n" in
|
|
"{\n" ^ (storage st) ^ (parameter param) ^ (return ret) ^ " " ^ code ^ "}"
|
|
|
|
let quote s = "\"" ^ s ^ "\""
|
|
|
|
let test parse_execute =
|
|
let dir_path = "test/contracts/" in
|
|
let test ?tc (file_name: string) (storage: string) (input: string) =
|
|
let full_path = dir_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 test_fails ?location parse_execute f s i =
|
|
test parse_execute 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 _ =
|
|
let ret : Micheline_printer.location = {comment=None} in
|
|
ret in
|
|
let output_node = Micheline.inject_locations location_maker output_can in
|
|
Format.fprintf
|
|
Format.str_formatter "%a" Micheline_printer.print_expr output_node ;
|
|
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 ss = string_of_canon sp in
|
|
let os = string_of_canon op in
|
|
debug "Storage : %s" ss ;
|
|
debug "Output : %s" os ;
|
|
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 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) ->
|
|
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) ->
|
|
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 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_output ?location a b c d =
|
|
test_output ?location parse_execute a b c d >>= function
|
|
| Ok(x) -> return x
|
|
| Error(errs) -> (
|
|
match location with
|
|
| None -> ()
|
|
| 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
|
|
|
|
(* FORMAT: assert_output contract_file storage input expected_result *)
|
|
test_output ~location: __LOC__ "ret_int" "Unit" "Unit" "300" >>=? fun _ ->
|
|
|
|
(* Identity on strings *)
|
|
test_output ~location: __LOC__ "str_id" "Unit" "\"Hello\"" "\"Hello\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "str_id" "Unit" "\"abcd\"" "\"abcd\"" >>=? fun _ ->
|
|
|
|
(* Identity on pairs *)
|
|
test_output ~location: __LOC__ "pair_id" "Unit" "(Pair True False)" "(Pair True False)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "pair_id" "Unit" "(Pair False True)" "(Pair False True)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "pair_id" "Unit" "(Pair True True)" "(Pair True True)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "pair_id" "Unit" "(Pair False False)" "(Pair False False)" >>=? fun _ ->
|
|
|
|
(* Logical not *)
|
|
test_output ~location: __LOC__ "not" "Unit" "True" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "not" "Unit" "False" "True" >>=? fun _ ->
|
|
|
|
(* Logical and *)
|
|
test_output ~location: __LOC__ "and" "Unit" "(Pair False False)" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "and" "Unit" "(Pair False True)" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "and" "Unit" "(Pair True False)" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "and" "Unit" "(Pair True True)" "True" >>=? fun _ ->
|
|
|
|
(* Logical or *)
|
|
test_output ~location: __LOC__ "or" "Unit" "(Pair False False)" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "or" "Unit" "(Pair False True)" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "or" "Unit" "(Pair True False)" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "or" "Unit" "(Pair True True)" "True" >>=? fun _ ->
|
|
|
|
(* XOR *)
|
|
test_output ~location: __LOC__ "xor" "Unit" "(Pair False False)" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "xor" "Unit" "(Pair False True)" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "xor" "Unit" "(Pair True False)" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "xor" "Unit" "(Pair True True)" "False" >>=? fun _ ->
|
|
|
|
|
|
(* Build list *)
|
|
test_output ~location: __LOC__ "build_list" "Unit" "0" "{ 0 }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "build_list" "Unit" "3" "{ 0 ; 1 ; 2 ; 3 }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "build_list" "Unit" "10" "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }" >>=? fun _ ->
|
|
|
|
(* Concatenate all strings of a list into one string *)
|
|
test_output ~location: __LOC__ "concat_list" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "\"abc\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "concat_list" "Unit" "{}" "\"\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "concat_list" "Unit" "{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }" "\"Hello World!\"" >>=? fun _ ->
|
|
|
|
(* Find maximum int in list -- returns None if not found *)
|
|
test_output ~location: __LOC__ "max_in_list" "Unit" "{}" "None" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "max_in_list" "Unit" "{ 1 }" "(Some 1)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "max_in_list" "Unit" "{ -1 }" "(Some -1)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "max_in_list" "Unit" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "max_in_list" "Unit" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "max_in_list" "Unit" "{ -10 ; -1 ; -20 ; -100 }" "(Some -1)" >>=? fun _ ->
|
|
|
|
(* Identity on lists *)
|
|
test_output ~location: __LOC__ "list_id" "Unit" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_id" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_id" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "list_id_map" "Unit" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_id_map" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_id_map" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
|
|
|
|
|
|
(* Identity on maps *)
|
|
test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 1 }" "{ Elt 0 1 }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 0 }" "{ Elt 0 0 }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "map_id" "Unit" "{ Elt 0 0 ; Elt 3 4 }" "{ Elt 0 0 ; Elt 3 4 }" >>=? fun _ ->
|
|
|
|
(* Map block on lists *)
|
|
test_output ~location: __LOC__ "list_map_block" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_map_block" "Unit" "{ 1 ; 1 ; 1 ; 1 }" "{ 1 ; 2 ; 3 ; 4 }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_map_block" "Unit" "{ 1 ; 2 ; 3 ; 0 }" "{ 1 ; 3 ; 5 ; 3 }" >>=? fun _ ->
|
|
|
|
(* List iter *)
|
|
test_output ~location: __LOC__ "list_iter" "Unit" "{ 10 ; 2 ; 1 }" "20" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_iter" "Unit" "{ 3 ; 6 ; 9 }" "162" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "list_iter2" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "\"cba\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "list_iter2" "Unit" "{}" "\"\"" >>=? fun _ ->
|
|
|
|
|
|
(* Identity on sets *)
|
|
test_output ~location: __LOC__ "set_id" "Unit" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_id" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_id" "Unit" "{ \"asdf\" ; \"bcde\" }" "{ \"asdf\" ; \"bcde\" }" >>=? fun _ ->
|
|
|
|
(* Set member -- set is in storage *)
|
|
test_output ~location: __LOC__ "set_member" "{}" "\"Hi\"" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_member" "{ \"Hi\" }" "\"Hi\"" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_member" "{ \"Hello\" ; \"World\" }" "\"\"" "False" >>=? fun _ ->
|
|
|
|
(* Set size *)
|
|
test_output ~location: __LOC__ "set_size" "Unit" "{}" "0" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_size" "Unit" "{ 1 }" "1" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_size" "Unit" "{ 1 ; 2 ; 3 }" "3" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_size" "Unit" "{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }" "6" >>=? fun _ ->
|
|
|
|
(* Set iter *)
|
|
test_output ~location: __LOC__ "set_iter" "Unit" "{}" "0" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_iter" "Unit" "{ 1 }" "1" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_iter" "Unit" "{ -100 ; 1 ; 2 ; 3 }" "-94" >>=? fun _ ->
|
|
|
|
(* Map size *)
|
|
test_output ~location: __LOC__ "map_size" "Unit" "{}" "0" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 }" "1" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 }" "3" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "map_size" "Unit" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }" "6" >>=? fun _ ->
|
|
|
|
(* Contains all elements -- does the second list contain all of the same elements *)
|
|
(* as the first one? I'm ignoring element multiplicity *)
|
|
test_output ~location: __LOC__ "contains_all" "Unit" "(Pair {} {})" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"a\" } { \"B\" })" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"A\" } { \"B\" })" "False" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" } { \"B\" })" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "contains_all" "Unit" "(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })" "True" >>=? fun _ ->
|
|
|
|
(* Concatenate the string in storage with all strings in the given list *)
|
|
test_output ~location: __LOC__ "concat_hello" "Unit" "{ \"World!\" }" "{ \"Hello World!\" }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "concat_hello" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "concat_hello" "Unit" "{ \"test1\" ; \"test2\" }" "{ \"Hello test1\" ; \"Hello test2\" }" >>=? fun _ ->
|
|
|
|
(* Create an empty map and add a string to it *)
|
|
test_output ~location: __LOC__ "empty_map" "Unit" "Unit" "{ Elt \"hello\" \"world\" }" >>=? fun _ ->
|
|
|
|
(* Get the value stored at the given key in the map *)
|
|
test_output ~location: __LOC__ "get_map_value" "{ Elt \"hello\" \"hi\" }" "\"hello\"" "(Some \"hi\")" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "get_map_value" "{ Elt \"hello\" \"hi\" }" "\"\"" "None" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "get_map_value" "{ Elt \"1\" \"one\" ; Elt \"2\" \"two\" }" "\"1\"" "(Some \"one\")" >>=? fun _ ->
|
|
|
|
(* Map iter *)
|
|
test_output ~location: __LOC__ "map_iter" "Unit" "{ Elt 0 100 ; Elt 2 100 }" "(Pair 2 200)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "map_iter" "Unit" "{ Elt 1 1 ; Elt 2 100 }" "(Pair 3 101)" >>=? fun _ ->
|
|
|
|
(* Return True if True branch of if was taken and False otherwise *)
|
|
test_output ~location: __LOC__ "if" "Unit" "True" "True" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "if" "Unit" "False" "False" >>=? fun _ ->
|
|
|
|
(* Generate a pair of or types *)
|
|
test_output ~location: __LOC__ "swap_left_right" "Unit" "(Left True)" "(Right True)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "swap_left_right" "Unit" "(Right \"a\")" "(Left \"a\")" >>=? fun _ ->
|
|
|
|
(* Reverse a list *)
|
|
test_output ~location: __LOC__ "reverse" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "reverse" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "reverse_loop" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "reverse_loop" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
|
|
|
|
(* Reverse using LOOP_LEFT *)
|
|
test_output ~location: __LOC__ "loop_left" "Unit" "{}" "{}" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "loop_left" "Unit" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ ->
|
|
|
|
(* Exec concat contract *)
|
|
test_output ~location: __LOC__ "exec_concat" "Unit" "\"\"" "\"_abc\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "exec_concat" "Unit" "\"test\"" "\"test_abc\"" >>=? fun _ ->
|
|
|
|
(* Get current steps to quota *)
|
|
test_output ~location: __LOC__ "steps_to_quota" "Unit" "Unit" "39991" >>=? fun _ ->
|
|
|
|
let bootstrap_0 = List.nth Account.bootstrap_accounts 0 in
|
|
get_balance_res bootstrap_0 sb >>=?? fun _balance ->
|
|
let amount = Proto_alpha.Tezos_context.Tez.to_string @@ Cast.cents_of_int Script.init_amount in
|
|
(* Get the current balance of the contract *)
|
|
test_output ~location: __LOC__ "balance" "Unit" "Unit" ("\"" ^ amount ^ "\"") >>=? fun _ ->
|
|
|
|
(* Test comparisons on tez { EQ ; GT ; LT ; GE ; LE } *)
|
|
test_output ~location: __LOC__ "compare" "Unit" "(Pair \"1.00\" \"2.00\")" "{ False ; False ; True ; False ; True }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "compare" "Unit" "(Pair \"2.00\" \"1.00\")" "{ False ; True ; False ; True ; False }" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "compare" "Unit" "(Pair \"2.37\" \"2.37\")" "{ True ; False ; False ; True ; True }" >>=? fun _ ->
|
|
|
|
(* Test addition and subtraction on tez *)
|
|
test_output ~location: __LOC__ "tez_add_sub" "Unit" "(Pair \"2\" \"1\")" "(Pair \"3\" \"1\")" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "tez_add_sub" "Unit" "(Pair \"2.31\" \"1.01\")" "(Pair \"3.32\" \"1.3\")" >>=? fun _ ->
|
|
|
|
(* Test get first element of list *)
|
|
test_output ~location: __LOC__ "first" "Unit" "{ 1 ; 2 ; 3 ; 4 }" "1" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "first" "Unit" "{ 4 }" "4" >>=? fun _ ->
|
|
|
|
(* Hash input string *)
|
|
(* Test assumed to be correct -- hash is based on encoding of AST *)
|
|
test_output ~location: __LOC__ "hash_string" "Unit" "\"abcdefg\"" "\"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "hash_string" "Unit" "\"12345\"" "\"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3\"" >>=? fun _ ->
|
|
|
|
(* Test ASSERT *)
|
|
test_output ~location: __LOC__ "assert" "Unit" "True" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert" "Unit" "False" >>=? fun _ ->
|
|
|
|
(* COMPARE ; ASSERT_ *)
|
|
test_output ~location: __LOC__ "assert_eq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_eq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_eq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_eq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_neq" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_neq" "Unit" "(Pair -1 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_lt" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_lt" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_lt" "Unit" "(Pair 0 0)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_le" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "assert_le" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_le" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_gt" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_gt" "Unit" "(Pair -1 0)" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_gt" "Unit" "(Pair 0 0)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_ge" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "assert_ge" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_ge" "Unit" "(Pair -1 0)" >>=? fun _ ->
|
|
|
|
(* ASSERT_CMP *)
|
|
test_output ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_cmpneq" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmpneq" "Unit" "(Pair -1 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_cmplt" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmplt" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmplt" "Unit" "(Pair 0 0)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_cmple" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "assert_cmple" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmple" "Unit" "(Pair 0 -1)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair -1 0)" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair 0 0)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "assert_cmpge" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "assert_cmpge" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ ->
|
|
test_fails ~location: __LOC__ "assert_cmpge" "Unit" "(Pair -1 0)" >>=? fun _ ->
|
|
|
|
(* IF_SOME *)
|
|
test_output ~location: __LOC__ "if_some" "Unit" "(Some \"hello\")" "\"hello\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "if_some" "Unit" "None" "\"\"" >>=? fun _ ->
|
|
|
|
(* Tests the SET_CAR and SET_CDR instructions *)
|
|
test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"world\"" "(Pair \"world\" 0)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"abc\"" "(Pair \"abc\" 0)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"\"" "(Pair \"\" 0)" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 0)" "1" "(Pair \"hello\" 1)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 500)" "3" "(Pair \"hello\" 3)" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 7)" "100" "(Pair \"hello\" 100)" >>=? fun _ ->
|
|
|
|
test_storage ~location: __LOC__ "set_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"0\") 4) 5))) 6)" "\"3\"" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"3\") 4) 5))) 6)" >>=? fun _ ->
|
|
|
|
test_storage ~location: __LOC__ "map_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"0\") 4) 5))) 6)" "Unit" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 \"1\") 4) 5))) 6)" >>=? fun _ ->
|
|
|
|
(* Did the given key sign the string? (key is bootstrap1) *)
|
|
test_output ~location: __LOC__ "check_signature" "(Pair \"26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "True" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "check_signature" "(Pair \"26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "False" >>=? fun _ ->
|
|
|
|
(* Convert a public key to a public key hash *)
|
|
test_output ~location: __LOC__ "hash_key" "Unit" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "\"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "hash_key" "Unit" "\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"" "\"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\"" >>=? fun _ ->
|
|
|
|
(* Test timestamp operations *)
|
|
test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair 100 100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair 100 -100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "add_timestamp_delta" "Unit" "(Pair \"1970-01-01T00:00:00Z\" 0)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair 100 100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair -100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "add_delta_timestamp" "Unit" "(Pair 0 \"1970-01-01T00:00:00Z\")" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 -100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "sub_timestamp_delta" "Unit" "(Pair 100 2000000000000000000)" "-1999999999999999900" >>=? fun _ ->
|
|
|
|
test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 0 0)" "0" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 0 1)" "-1" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair 1 0)" "1" >>=? fun _ ->
|
|
test_output ~location: __LOC__ "diff_timestamps" "Unit" "(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")" "200" >>=? fun _ ->
|
|
|
|
(* Test NOW *)
|
|
let now = sb.tezos_header.shell.timestamp in
|
|
let now_str = quote @@ Tezos_base.Time.to_notation now in
|
|
test_storage ~location: __LOC__ "store_now" "\"1970-01-01T00:03:20Z\"" "Unit" now_str >>=? fun _ ->
|
|
|
|
(* Test TRANSFER_TO *)
|
|
Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) ->
|
|
let account_str = quote @@ Ed25519.Public_key_hash.to_b58check account.hpub in
|
|
test_tc ~tc "transfer_to" "Unit" account_str >>=? fun tc ->
|
|
let amount = Account.init_amount + 100 in
|
|
Assert.equal_cents_balance ~tc (account.contract, amount * 100) >>=?? fun _ ->
|
|
|
|
(* Test CREATE_ACCOUNT *)
|
|
Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) ->
|
|
let account_str = quote @@ Ed25519.Public_key_hash.to_b58check account.hpub in
|
|
test_contract ~tc "create_account" account_str account_str >>=? fun (cs, tc) ->
|
|
Assert.equal_int 1 @@ List.length cs ;
|
|
|
|
(* Test CREATE_CONTRACT *)
|
|
test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) ->
|
|
Assert.equal_int 1 @@ List.length cs ;
|
|
let contract = List.hd cs in
|
|
Proto_alpha.Tezos_context.Contract.get_script tc contract >>=?? fun res ->
|
|
let script = Option.unopt_exn (Failure "get_script") res in
|
|
Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
|
|
Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
|
|
|
|
(* Test DEFAULT_ACCOUNT *)
|
|
let account = Account.new_account () in
|
|
let b_str = quote @@ Ed25519.Public_key_hash.to_b58check account.hpub in
|
|
test_contract ~tc "default_account" "Unit" b_str >>=? fun (_cs, tc) ->
|
|
Assert.equal_cents_balance ~tc (account.contract, 100 * 100) >>=?? fun _ ->
|
|
return ()
|
|
|
|
|
|
let test_program parse_execute =
|
|
let open Error_monad in
|
|
let id_code = "code
|
|
{ DUP ;
|
|
PAIR ;
|
|
CAR }" in
|
|
let id_int_program =
|
|
program "int" "int" "int" id_code in
|
|
let id_ill_param_program =
|
|
program "string" "int" "string" id_code in
|
|
let id_ill_return_program =
|
|
program "int" "string" "int" id_code in
|
|
let id_pbool_program =
|
|
program "(pair bool bool)" "(pair bool bool)" "unit" id_code in
|
|
let push_300_code = "code
|
|
{ CAR ;
|
|
PUSH nat 300 ;
|
|
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 ->
|
|
Assert.ill_typed_data_error ~msg: "Good data type" x ;
|
|
parse_execute 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 _ ->
|
|
return ()
|
|
|
|
|
|
let main (): unit Error_monad.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 = Proto_alpha.Tezos_context.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 ()) ;
|
|
]
|
|
|
|
let main () =
|
|
Test.run "michelson." tests
|