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

bugfix: new typer did not keep the state between the program and the test case's function call

Browse Source
This commit is contained in:
Suzanne Dupéron 2020-05-29 20:37:11 +02:00
parent 4cb34a1d7e
commit b2ee003577
13 changed files with 130 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/test/coase_tests.ml
View File

@ -13,13 +13,13 @@ 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 (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) =

28
src/test/hash_lock_tests.ml
View File

@ -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" [

52
src/test/id_tests.ml
View File

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

12
src/test/integration_tests.ml
View File

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

28
src/test/multisig_tests.ml
View File

@ -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" [

40
src/test/multisig_v2_tests.ml
View File

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

12
src/test/pledge_tests.ml
View File

@ -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."

16
src/test/replaceable_id_tests.ml
View File

@ -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" [

13
src/test/test_helpers.ml
View File

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

8
src/test/time_lock_repeat_tests.ml
View File

@ -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" [

8
src/test/time_lock_tests.ml
View File

@ -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" [

32
src/test/tzip12_tests.ml
View File

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

7
src/test/vote_tests.ml
View File

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