diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index f5d7819fd..c1cc1d680 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -13,15 +13,15 @@ let get_program = | Some s -> ok s | None -> ( let%bind (program , state) = type_file "./contracts/coase.ligo" in - let () = Typer.Solver.discard_state state in - s := Some program ; - ok program + s := Some (program , state) ; + ok (program , state) ) let compile_main () = - let%bind typed_prg = get_program () in - let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in - let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind (typed_prg, state) = get_program () in + let () = Typer.Solver.discard_state state in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in diff --git a/src/test/hash_lock_tests.ml b/src/test/hash_lock_tests.ml index 3f9e79c79..b7bbe7bf1 100644 --- a/src/test/hash_lock_tests.ml +++ b/src/test/hash_lock_tests.ml @@ -50,7 +50,7 @@ let empty_message = e_lambda (Var.of_name "arguments") let commit () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in let%bind lock_time = mk_time "2000-01-02T00:10:11Z" in let test_hash_raw = sha_256_hash (Bytes.of_string "hello world") in @@ -79,12 +79,12 @@ let commit () = ~sender:first_contract () in - expect_eq ~options program "commit" + expect_eq ~options (program, state) "commit" (e_pair salted_hash init_storage) (e_pair empty_op_list post_storage) (* Test that the contract fails if we haven't committed before revealing the answer *) let reveal_no_commit () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let empty_message = empty_message in let reveal = e_record_ez [("hashable", e_bytes_string "hello world"); ("message", empty_message)] @@ -95,13 +95,13 @@ let reveal_no_commit () = ("salted_hash", (t_bytes ()))]) in let init_storage = storage test_hash true pre_commits in - expect_string_failwith program "reveal" + expect_string_failwith (program, state) "reveal" (e_pair reveal init_storage) "You have not made a commitment to hash against yet." (* Test that the contract fails if our commit isn't 24 hours old yet *) let reveal_young_commit () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let empty_message = empty_message in let reveal = e_record_ez [("hashable", e_bytes_string "hello world"); ("message", empty_message)] @@ -128,13 +128,13 @@ let reveal_young_commit () = ~sender:first_contract () in - expect_string_failwith ~options program "reveal" + expect_string_failwith ~options (program, state) "reveal" (e_pair reveal init_storage) "It has not been 24 hours since your commit yet." (* Test that the contract fails if our reveal doesn't meet our commitment *) let reveal_breaks_commit () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let empty_message = empty_message in let reveal = e_record_ez [("hashable", e_bytes_string "hello world"); ("message", empty_message)] @@ -160,13 +160,13 @@ let reveal_breaks_commit () = ~sender:first_contract () in - expect_string_failwith ~options program "reveal" + expect_string_failwith ~options (program, state) "reveal" (e_pair reveal init_storage) "This reveal does not match your commitment." (* Test that the contract fails if we reveal the wrong bytes for the stored hash *) let reveal_wrong_commit () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let empty_message = empty_message in let reveal = e_record_ez [("hashable", e_bytes_string "hello"); ("message", empty_message)] @@ -192,13 +192,13 @@ let reveal_wrong_commit () = ~sender:first_contract () in - expect_string_failwith ~options program "reveal" + expect_string_failwith ~options (program, state) "reveal" (e_pair reveal init_storage) "Your commitment did not match the storage hash." (* Test that the contract fails if we try to reuse it after unused flag changed *) let reveal_no_reuse () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let empty_message = empty_message in let reveal = e_record_ez [("hashable", e_bytes_string "hello"); ("message", empty_message)] @@ -224,13 +224,13 @@ let reveal_no_reuse () = ~sender:first_contract () in - expect_string_failwith ~options program "reveal" + expect_string_failwith ~options (program, state) "reveal" (e_pair reveal init_storage) "This contract has already been used." (* Test that the contract executes successfully with valid commit-reveal *) let reveal () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let empty_message = empty_message in let reveal = e_record_ez [("hashable", e_bytes_string "hello world"); ("message", empty_message)] @@ -257,7 +257,7 @@ let reveal () = ~sender:first_contract () in - expect_eq ~options program "reveal" + expect_eq ~options (program, state) "reveal" (e_pair reveal init_storage) (e_pair empty_op_list post_storage) let main = test_suite "Hashlock" [ diff --git a/src/test/id_tests.ml b/src/test/id_tests.ml index f5839dd5b..a1fca2a62 100644 --- a/src/test/id_tests.ml +++ b/src/test/id_tests.ml @@ -33,7 +33,7 @@ let (first_owner , first_contract) = Protocol.Alpha_context.Contract.to_b58check kt , kt let buy_id () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -60,13 +60,13 @@ let buy_id () = e_int 2; e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in - let%bind () = expect_eq ~options program "buy" + let%bind () = expect_eq ~options (program, state) "buy" (e_pair param storage) (e_pair (e_list []) new_storage) in ok () let buy_id_sender_addr () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -93,14 +93,14 @@ let buy_id_sender_addr () = e_int 2; e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in - let%bind () = expect_eq ~options program "buy" + let%bind () = expect_eq ~options (program, state) "buy" (e_pair param storage) (e_pair (e_list []) new_storage) in ok () (* Test that contract fails if we attempt to buy an ID for the wrong amount *) let buy_id_wrong_amount () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -117,13 +117,13 @@ let buy_id_wrong_amount () = ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.fifty_cents) () in let param = e_pair owner_website (e_some (e_address new_addr)) in - let%bind () = expect_string_failwith ~options program "buy" + let%bind () = expect_string_failwith ~options (program, state) "buy" (e_pair param storage) "Incorrect amount paid." in ok () let update_details_owner () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -158,13 +158,13 @@ let update_details_owner () = let param = e_tuple [e_int 1 ; e_some details ; e_some (e_address new_addr)] in - let%bind () = expect_eq ~options program "update_details" + let%bind () = expect_eq ~options (program, state) "update_details" (e_pair param storage) (e_pair (e_list []) new_storage) in ok () let update_details_controller () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -199,14 +199,14 @@ let update_details_controller () = let param = e_tuple [e_int 1 ; e_some details ; e_some (e_address owner_addr)] in - let%bind () = expect_eq ~options program "update_details" + let%bind () = expect_eq ~options (program, state) "update_details" (e_pair param storage) (e_pair (e_list []) new_storage) in ok () (* Test that contract fails when we attempt to update details of nonexistent ID *) let update_details_nonexistent () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -233,14 +233,14 @@ let update_details_nonexistent () = let param = e_tuple [e_int 2 ; e_some details ; e_some (e_address owner_addr)] in - let%bind () = expect_string_failwith ~options program "update_details" + let%bind () = expect_string_failwith ~options (program, state) "update_details" (e_pair param storage) "This ID does not exist." in ok () (* Test that contract fails when we attempt to update details from wrong addr *) let update_details_wrong_addr () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -266,14 +266,14 @@ let update_details_wrong_addr () = let param = e_tuple [e_int 0 ; e_some details ; e_some (e_address owner_addr)] in - let%bind () = expect_string_failwith ~options program "update_details" + let%bind () = expect_string_failwith ~options (program, state) "update_details" (e_pair param storage) "You are not the owner or controller of this ID." in ok () (* Test that giving none on both profile and controller address is a no-op *) let update_details_unchanged () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -299,13 +299,13 @@ let update_details_unchanged () = let param = e_tuple [e_int 1 ; e_typed_none (t_bytes ()) ; e_typed_none (t_address ())] in - let%bind () = expect_eq ~options program "update_details" + let%bind () = expect_eq ~options (program, state) "update_details" (e_pair param storage) (e_pair (e_list []) storage) in ok () let update_owner () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -337,14 +337,14 @@ let update_owner () = e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in let param = e_pair (e_int 1) (e_address owner_addr) in - let%bind () = expect_eq ~options program "update_owner" + let%bind () = expect_eq ~options (program, state) "update_owner" (e_pair param storage) (e_pair (e_list []) new_storage) in ok () (* Test that contract fails when we attempt to update owner of nonexistent ID *) let update_owner_nonexistent () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -368,14 +368,14 @@ let update_owner_nonexistent () = e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in let param = e_pair (e_int 2) (e_address new_addr) in - let%bind () = expect_string_failwith ~options program "update_owner" + let%bind () = expect_string_failwith ~options (program, state) "update_owner" (e_pair param storage) "This ID does not exist." in ok () (* Test that contract fails when we attempt to update owner from non-owner addr *) let update_owner_wrong_addr () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -399,13 +399,13 @@ let update_owner_wrong_addr () = e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in let param = e_pair (e_int 0) (e_address new_addr) in - let%bind () = expect_string_failwith ~options program "update_owner" + let%bind () = expect_string_failwith ~options (program, state) "update_owner" (e_pair param storage) "You are not the owner of this ID." in ok () let skip () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -432,14 +432,14 @@ let skip () = e_int 3; e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in - let%bind () = expect_eq ~options program "skip" + let%bind () = expect_eq ~options (program, state) "skip" (e_pair (e_unit ()) storage) (e_pair (e_list []) new_storage) in ok () (* Test that contract fails if we try to skip without paying the right amount *) let skip_wrong_amount () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let owner_addr = addr 5 in let owner_website = e_bytes_string "ligolang.org" in let id_details_1 = e_record_ez [("owner", e_address owner_addr) ; @@ -461,7 +461,7 @@ let skip_wrong_amount () = e_int 2; e_tuple [e_mutez 1000000 ; e_mutez 1000000]] in - let%bind () = expect_string_failwith ~options program "skip" + let%bind () = expect_string_failwith ~options (program, state) "skip" (e_pair (e_unit ()) storage) "Incorrect amount paid." in ok () diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index bbe645b47..ab9242837 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -4,17 +4,11 @@ open Test_helpers open Ast_imperative.Combinators let retype_file f = - let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in - let () = Typer.Solver.discard_state state in - ok typed + Ligo.Compile.Utils.type_file f "reasonligo" Env let mtype_file f = - let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" Env in - let () = Typer.Solver.discard_state state in - ok typed + Ligo.Compile.Utils.type_file f "cameligo" Env let type_file f = - let%bind typed,state = Ligo.Compile.Utils.type_file f "pascaligo" Env in - let () = Typer.Solver.discard_state state in - ok typed + Ligo.Compile.Utils.type_file f "pascaligo" Env let type_alias () : unit result = let%bind program = type_file "./contracts/type-alias.ligo" in diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index b618dadd9..df3a42887 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -76,39 +76,39 @@ let params counter msg keys is_validl f s = (* Provide one valid signature when the threshold is two of two keys *) let not_enough_1_of_2 f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let exp_failwith = "Not enough signatures passed the check" in let keys = gen_keys () in let%bind test_params = params 0 empty_message [keys] [true] f s in let%bind () = expect_string_failwith - program "main" (e_pair test_params (init_storage 2 0 [keys;gen_keys()])) exp_failwith in + (program, state) "main" (e_pair test_params (init_storage 2 0 [keys;gen_keys()])) exp_failwith in ok () let unmatching_counter f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let exp_failwith = "Counters does not match" in let keys = gen_keys () in let%bind test_params = params 1 empty_message [keys] [true] f s in let%bind () = expect_string_failwith - program "main" (e_pair test_params (init_storage 1 0 [keys])) exp_failwith in + (program, state) "main" (e_pair test_params (init_storage 1 0 [keys])) exp_failwith in ok () (* Provide one invalid signature (correct key but incorrect signature) when the threshold is one of one key *) let invalid_1_of_1 f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let exp_failwith = "Invalid signature" in let keys = [gen_keys ()] in let%bind test_params = params 0 empty_message keys [false] f s in let%bind () = expect_string_failwith - program "main" (e_pair test_params (init_storage 1 0 keys)) exp_failwith in + (program, state) "main" (e_pair test_params (init_storage 1 0 keys)) exp_failwith in ok () (* Provide one valid signature when the threshold is one of one key *) let valid_1_of_1 f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let keys = gen_keys () in - let%bind () = expect_eq_n_trace_aux [0;1;2] program "main" + let%bind () = expect_eq_n_trace_aux [0;1;2] (program, state) "main" (fun n -> let%bind params = params n empty_message [keys] [true] f s in ok @@ e_pair params (init_storage 1 n [keys]) @@ -120,10 +120,10 @@ let valid_1_of_1 f s () = (* Provive two valid signatures when the threshold is two of three keys *) let valid_2_of_3 f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let param_keys = [gen_keys (); gen_keys ()] in let st_keys = param_keys @ [gen_keys ()] in - let%bind () = expect_eq_n_trace_aux [0;1;2] program "main" + let%bind () = expect_eq_n_trace_aux [0;1;2] (program, state) "main" (fun n -> let%bind params = params n empty_message param_keys [true;true] f s in ok @@ e_pair params (init_storage 2 n st_keys) @@ -135,7 +135,7 @@ let valid_2_of_3 f s () = (* Provide one invalid signature and two valid signatures when the threshold is two of three keys *) let invalid_3_of_3 f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let valid_keys = [gen_keys() ; gen_keys()] in let invalid_key = gen_keys () in let param_keys = valid_keys @ [invalid_key] in @@ -143,18 +143,18 @@ let invalid_3_of_3 f s () = let%bind test_params = params 0 empty_message param_keys [false;true;true] f s in let exp_failwith = "Invalid signature" in let%bind () = expect_string_failwith - program "main" (e_pair test_params (init_storage 2 0 st_keys)) exp_failwith in + (program, state) "main" (e_pair test_params (init_storage 2 0 st_keys)) exp_failwith in ok () (* Provide two valid signatures when the threshold is three of three keys *) let not_enough_2_of_3 f s () = - let%bind program,_ = get_program f s() in + let%bind (program , state) = get_program f s() in let valid_keys = [gen_keys() ; gen_keys()] in let st_keys = gen_keys () :: valid_keys in let%bind test_params = params 0 empty_message (valid_keys) [true;true] f s in let exp_failwith = "Not enough signatures passed the check" in let%bind () = expect_string_failwith - program "main" (e_pair test_params (init_storage 3 0 st_keys)) exp_failwith in + (program, state) "main" (e_pair test_params (init_storage 3 0 st_keys)) exp_failwith in ok () let main = test_suite "Multisig" [ diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index bf163195c..6c230881e 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -65,7 +65,7 @@ let storage {state_hash ; threshold ; max_proposal ; max_msg_size ; id_counter_l (* sender not stored in the authorized set *) let wrong_addr () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let init_storage = storage { threshold = 1 ; max_proposal = 1 ; max_msg_size = 1 ; state_hash = Bytes.empty ; id_counter_list = [1,0 ; 2,0] ; @@ -75,13 +75,13 @@ let wrong_addr () = let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in let%bind () = let exp_failwith = "Unauthorized address" in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair (send_param empty_message) init_storage) exp_failwith in ok () (* send a message which exceed the size limit *) let message_size_exceeded () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let init_storage = storage { threshold = 1 ; max_proposal = 1 ; max_msg_size = 1 ; state_hash = Bytes.empty ; id_counter_list = [1,0] ; @@ -91,13 +91,13 @@ let message_size_exceeded () = let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in let%bind () = let exp_failwith = "Message size exceed maximum limit" in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair (send_param empty_message) init_storage) exp_failwith in ok () (* sender has already has reached maximum number of proposal *) let maximum_number_of_proposal () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload1 = pack_payload program (send_param empty_message) in let bytes1 = e_bytes_raw packed_payload1 in let init_storage = storage { @@ -109,13 +109,13 @@ let maximum_number_of_proposal () = let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in let%bind () = let exp_failwith = "Maximum number of proposal reached" in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair (send_param empty_message2) init_storage) exp_failwith in ok () (* sender message is already stored in the message store *) let send_already_accounted () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload = pack_payload program empty_message in let bytes = e_bytes_raw packed_payload in let init_storage = storage { @@ -126,12 +126,12 @@ let send_already_accounted () = let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair (send_param empty_message) init_storage) (e_pair empty_op_list init_storage) (* sender message isn't stored in the message store *) let send_never_accounted () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload = pack_payload program empty_message in let bytes = e_bytes_raw packed_payload in let init_storage' = { @@ -147,12 +147,12 @@ let send_never_accounted () = let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair (send_param empty_message) init_storage) (e_pair empty_op_list final_storage) (* sender withdraw message is already binded to one address in the message store *) let withdraw_already_accounted_one () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload = pack_payload program empty_message in let bytes = e_bytes_raw packed_payload in let param = withdraw_param in @@ -168,12 +168,12 @@ let withdraw_already_accounted_one () = let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair param init_storage) (e_pair empty_op_list final_storage) (* sender withdraw message is already binded to two addresses in the message store *) let withdraw_already_accounted_two () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload = pack_payload program empty_message in let bytes = e_bytes_raw packed_payload in let param = withdraw_param in @@ -189,12 +189,12 @@ let withdraw_already_accounted_two () = let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair param init_storage) (e_pair empty_op_list final_storage) (* triggers the threshold and check that all the participants get their counters decremented *) let counters_reset () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload = pack_payload program empty_message in let bytes = e_bytes_raw packed_payload in let param = send_param empty_message in @@ -212,12 +212,12 @@ let counters_reset () = let options = let sender = contract 3 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair param init_storage) (e_pair empty_op_list final_storage) (* sender withdraw message was never accounted *) let withdraw_never_accounted () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let param = withdraw_param in let init_storage = storage { threshold = 2 ; max_proposal = 1 ; max_msg_size = 1 ; state_hash = Bytes.empty ; @@ -227,12 +227,12 @@ let withdraw_never_accounted () = let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair param init_storage) (e_pair empty_op_list init_storage) (* successful storing in the message store *) let succeeded_storing () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind packed_payload = pack_payload program empty_message in let bytes = e_bytes_raw packed_payload in let init_storage th = { @@ -243,7 +243,7 @@ let succeeded_storing () = let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - let%bind () = expect_eq_n_trace_aux ~options [1;2] program "main" + let%bind () = expect_eq_n_trace_aux ~options [1;2] (program, state) "main" (fun th -> let init_storage = storage (init_storage th) in ok @@ e_pair (send_param empty_message) init_storage diff --git a/src/test/pledge_tests.ml b/src/test/pledge_tests.ml index a10b17295..6f6b371ea 100644 --- a/src/test/pledge_tests.ml +++ b/src/test/pledge_tests.ml @@ -45,36 +45,36 @@ let empty_message = e_lambda (Var.of_name "arguments") let pledge () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let storage = e_address oracle_addr in let parameter = e_unit () in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender:oracle_contract ~amount:(Memory_proto_alpha.Protocol.Alpha_context.Tez.one) () in - expect_eq ~options program "donate" + expect_eq ~options (program, state) "donate" (e_pair parameter storage) (e_pair (e_list []) storage) let distribute () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let storage = e_address oracle_addr in let parameter = empty_message in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender:oracle_contract () in - expect_eq ~options program "distribute" + expect_eq ~options (program, state) "distribute" (e_pair parameter storage) (e_pair (e_list []) storage) let distribute_unauthorized () = - let%bind program, _ = get_program () in + let%bind (program , state) = get_program () in let storage = e_address oracle_addr in let parameter = empty_message in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender:stranger_contract () in - expect_string_failwith ~options program "distribute" + expect_string_failwith ~options (program, state) "distribute" (e_pair parameter storage) "You're not the oracle for this distribution." diff --git a/src/test/replaceable_id_tests.ml b/src/test/replaceable_id_tests.ml index 6de612bab..771b439a7 100644 --- a/src/test/replaceable_id_tests.ml +++ b/src/test/replaceable_id_tests.ml @@ -39,45 +39,45 @@ let entry_pass_message = e_constructor "Pass_message" @@ empty_message let change_addr_success () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let init_storage = storage 1 in let param = entry_change_addr 2 in let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair param init_storage) (e_pair empty_op_list (storage 2)) let change_addr_fail () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let init_storage = storage 1 in let param = entry_change_addr 2 in let options = let sender = contract 3 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in let exp_failwith = "Unauthorized sender" in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair param init_storage) exp_failwith let pass_message_success () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let init_storage = storage 1 in let param = entry_pass_message in let options = let sender = contract 1 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair param init_storage) (e_pair empty_op_list init_storage) let pass_message_fail () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let init_storage = storage 1 in let param = entry_pass_message in let options = let sender = contract 2 in Proto_alpha_utils.Memory_proto_alpha.make_options ~sender () in let exp_failwith = "Unauthorized sender" in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair param init_storage) exp_failwith let main = test_suite "Replaceable ID" [ diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index adeb5649a..cc1e25afb 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -86,11 +86,10 @@ let sha_256_hash pl = open Ast_imperative.Combinators let typed_program_with_imperative_input_to_michelson - (program: Ast_typed.program) (entry_point: string) + ((program , state): Ast_typed.program * Ast_typed.typer_state) (entry_point: string) (input: Ast_imperative.expression) : Compiler.compiled_expression result = Printexc.record_backtrace true; let env = Ast_typed.program_environment Environment.default program in - let state = Typer.Solver.initial_state in let%bind sugar = Compile.Of_imperative.compile_expression input in let%bind core = Compile.Of_sugar.compile_expression sugar in let%bind app = Compile.Of_core.apply entry_point core in @@ -100,9 +99,9 @@ let typed_program_with_imperative_input_to_michelson Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied let run_typed_program_with_imperative_input ?options - (program: Ast_typed.program) (entry_point: string) + ((program , state): Ast_typed.program * Ast_typed.typer_state) (entry_point: string) (input: Ast_imperative.expression) : Ast_core.expression result = - let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in + let%bind michelson_program = typed_program_with_imperative_input_to_michelson (program , state) entry_point input in let%bind michelson_output = Ligo.Run.Of_michelson.run_no_failwith ?options michelson_program.expr michelson_program.expr_ty in Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output @@ -160,7 +159,7 @@ let expect_eq_core ?options program entry_point input expected = Ast_core.Misc.assert_value_eq (expected,result) in expect ?options program entry_point input expecter -let expect_evaluate program entry_point expecter = +let expect_evaluate (program, _state) entry_point expecter = let error = let title () = "expect evaluate" in let content () = Format.asprintf "Entry_point: %s" entry_point in @@ -173,11 +172,11 @@ let expect_evaluate program entry_point expecter = let%bind res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in expecter res_simpl -let expect_eq_evaluate program entry_point expected = +let expect_eq_evaluate ((program , state) : Ast_typed.program * Ast_typed.typer_state) entry_point expected = let%bind expected = expression_to_core expected in let expecter = fun result -> Ast_core.Misc.assert_value_eq (expected , result) in - expect_evaluate program entry_point expecter + expect_evaluate (program, state) entry_point expecter let expect_n_aux ?options lst program entry_point make_input make_expecter = let aux n = diff --git a/src/test/time_lock_repeat_tests.ml b/src/test/time_lock_repeat_tests.ml index adfe66169..efadf31a2 100644 --- a/src/test/time_lock_repeat_tests.ml +++ b/src/test/time_lock_repeat_tests.ml @@ -43,21 +43,21 @@ let storage st interval execute = ("execute", execute)] let early_call () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in let%bind lock_time = mk_time "2000-01-01T10:10:10Z" in let init_storage = storage lock_time 86400 empty_message in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in let exp_failwith = "You have to wait before you can execute this contract again." in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair (e_unit ()) init_storage) exp_failwith let fake_uncompiled_empty_message = e_string "[lambda of type: (lambda unit (list operation)) ]" (* Test that when we use the contract the next use time advances by correct interval *) let interval_advance () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind predecessor_timestamp = mk_time "2000-01-01T10:10:10Z" in let%bind lock_time = mk_time "2000-01-01T00:10:10Z" in let init_storage = storage lock_time 86400 empty_message in @@ -66,7 +66,7 @@ let interval_advance () = let new_storage_fake = storage new_timestamp 86400 fake_uncompiled_empty_message in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair (e_unit ()) init_storage) (e_pair empty_op_list new_storage_fake) let main = test_suite "Time Lock Repeating" [ diff --git a/src/test/time_lock_tests.ml b/src/test/time_lock_tests.ml index f345401c9..ee99d1542 100644 --- a/src/test/time_lock_tests.ml +++ b/src/test/time_lock_tests.ml @@ -41,24 +41,24 @@ let to_sec t = Tezos_utils.Time.Protocol.to_seconds t let storage st = e_timestamp (Int64.to_int @@ to_sec st) let early_call () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in let%bind lock_time = mk_time "2000-01-01T10:10:10Z" in let init_storage = storage lock_time in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in let exp_failwith = "Contract is still time locked" in - expect_string_failwith ~options program "main" + expect_string_failwith ~options (program, state) "main" (e_pair (call empty_message) init_storage) exp_failwith let call_on_time () = - let%bind program,_ = get_program () in + let%bind (program , state) = get_program () in let%bind predecessor_timestamp = mk_time "2000-01-01T10:10:10Z" in let%bind lock_time = mk_time "2000-01-01T00:10:10Z" in let init_storage = storage lock_time in let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in - expect_eq ~options program "main" + expect_eq ~options (program, state) "main" (e_pair (call empty_message) init_storage) (e_pair empty_op_list init_storage) let main = test_suite "Time lock" [ diff --git a/src/test/tzip12_tests.ml b/src/test/tzip12_tests.ml index db5996c9e..af81b9672 100644 --- a/src/test/tzip12_tests.ml +++ b/src/test/tzip12_tests.ml @@ -49,7 +49,7 @@ let sender = e_address @@ sender let external_contract = e_annotation (e_constant C_IMPLICIT_ACCOUNT [e_key_hash external_contract]) (t_contract (t_nat ())) let transfer f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair sender from_, e_nat 100)]); @@ -64,10 +64,10 @@ let transfer f s () = let input = e_pair parameter storage in let expected = e_pair (e_typed_list [] (t_operation ())) new_storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_eq program ~options "transfer" input expected + expect_eq (program, state) ~options "transfer" input expected let transfer_not_e_allowance f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair sender from_, e_nat 0)]); @@ -76,11 +76,11 @@ let transfer_not_e_allowance f s () = let parameter = e_record_ez [("address_from", from_);("address_to",to_); ("value",e_nat 10)] in let input = e_pair parameter storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_string_failwith ~options program "transfer" input + expect_string_failwith ~options (program, state) "transfer" input "Not Enough Allowance" let transfer_not_e_balance f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 0); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair sender from_, e_nat 100)]); @@ -89,11 +89,11 @@ let transfer_not_e_balance f s () = let parameter = e_record_ez [("address_from", from_);("address_to",to_); ("value",e_nat 10)] in let input = e_pair parameter storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_string_failwith ~options program "transfer" input + expect_string_failwith ~options (program, state) "transfer" input "Not Enough Balance" let approve f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair from_ sender, e_nat 0)]); @@ -108,10 +108,10 @@ let approve f s () = let input = e_pair parameter storage in let expected = e_pair (e_typed_list [] (t_operation ())) new_storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_eq program ~options "approve" input expected + expect_eq (program, state) ~options "approve" input expected let approve_unsafe f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); @@ -120,11 +120,11 @@ let approve_unsafe f s () = let parameter = e_record_ez [("spender", from_);("value",e_nat 100)] in let input = e_pair parameter storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_string_failwith ~options program "approve" input + expect_string_failwith ~options (program, state) "approve" input "Unsafe Allowance Change" let get_allowance f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); @@ -134,10 +134,10 @@ let get_allowance f s () = let input = e_pair parameter storage in let expected = e_pair (e_typed_list [] (t_operation ())) storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_eq program ~options "getAllowance" input expected + expect_eq (program, state) ~options "getAllowance" input expected let get_balance f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); @@ -147,10 +147,10 @@ let get_balance f s () = let input = e_pair parameter storage in let expected = e_pair (e_typed_list [] (t_operation ())) storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_eq program ~options "getBalance" input expected + expect_eq (program, state) ~options "getBalance" input expected let get_total_supply f s () = - let%bind program,_ = get_program f s () in + let%bind (program , state) = get_program f s () in let storage = e_record_ez [ ("tokens", e_big_map [(sender, e_nat 100); (from_, e_nat 100); (to_, e_nat 100)]); ("allowances", e_big_map [(e_pair from_ sender, e_nat 100)]); @@ -160,7 +160,7 @@ let get_total_supply f s () = let input = e_pair parameter storage in let expected = e_pair (e_typed_list [] (t_operation ())) storage in let options = Proto_alpha_utils.Memory_proto_alpha.make_options () in - expect_eq program ~options "getTotalSupply" input expected + expect_eq (program, state) ~options "getTotalSupply" input expected let main = test_suite "tzip-12" [ test "transfer" (transfer file_FA12 "pascaligo"); diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index 24cce7663..89f829a86 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -2,8 +2,7 @@ open Trace open Test_helpers let type_file f = - let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in - ok @@ (typed,state) + Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") let get_program = let s = ref None in @@ -36,10 +35,10 @@ let reset title start_time finish_time = let yea = e_constructor "Vote" (e_constructor "Yea" (e_unit ())) let init_vote () = - let%bind (program , _) = get_program () in + let%bind (program , state) = get_program () in let%bind result = Test_helpers.run_typed_program_with_imperative_input - program "main" (e_pair yea (init_storage "basic")) in + (program, state) "main" (e_pair yea (init_storage "basic")) in let%bind (_, storage) = Ast_core.extract_pair result in let%bind storage' = Ast_core.extract_record storage in (* let votes = List.assoc (Label "voters") storage' in