diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli index b0a3c01e9..f8c8a2407 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.mli +++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli @@ -14,6 +14,7 @@ type error += | Unspendable_contract of Contract_repr.contract (* `Permanent *) | Non_existing_contract of Contract_repr.contract (* `Temporary *) | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *) + | Empty_transaction of Contract_repr.t (* `Temporary *) | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *) | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *) | Failure of string (* `Permanent *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml index 80031bcf4..ba72e695a 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -95,6 +95,8 @@ let get_constants b = module Contract = struct + let pp = Alpha_context.Contract.pp + let pkh c = Alpha_context.Contract.is_implicit c |> function | Some p -> return p | None -> failwith "pkh: only for implicit contracts" diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.mli b/src/proto_alpha/lib_protocol/test/helpers/context.mli index 91f04a3e8..97c172676 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/context.mli @@ -34,6 +34,7 @@ val get_constants: t -> Constants.t tzresult Lwt.t module Contract : sig + val pp : Format.formatter -> Contract.t -> unit val pkh: Contract.t -> public_key_hash tzresult Lwt.t type balance_kind = Main | Deposit | Fees | Rewards diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml index 241196f5e..98eff7135 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml @@ -95,9 +95,7 @@ let detect_script_failure : | Applied _ -> Ok () | Skipped _ -> assert false | Failed (_, errs) -> - record_trace - (failure "The transfer simulation failed.") - (Alpha_environment.wrap_error (Error errs)) in + Alpha_environment.wrap_error (Error errs) in List.fold_left (fun acc (Internal_operation_result (_, r)) -> acc >>? fun () -> @@ -114,14 +112,20 @@ let detect_script_failure : detect_script_failure rest in fun { contents } -> detect_script_failure contents -let add_operation ?(allow_failure=false) st op = +let add_operation ?expect_failure st op = let open Apply_operation_result in M.apply_operation st.state op >>=? function | state, Operation_metadata result -> - begin if allow_failure then - return () - else - Lwt.return @@ detect_script_failure result + Lwt.return @@ detect_script_failure result >>= fun result -> + begin match expect_failure with + | None -> + Lwt.return result + | Some f -> + match result with + | Ok _ -> + failwith "Error expected while adding operation" + | Error e -> + f e end >>=? fun () -> return { st with state ; rev_operations = op :: st.rev_operations } | state, No_operation_metadata -> diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli index 721f4ef6f..f096c04f6 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/incremental.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli @@ -24,7 +24,7 @@ val begin_construction: Block.t -> incremental tzresult Lwt.t val add_operation: - ?allow_failure:bool -> + ?expect_failure:(error list -> unit tzresult Lwt.t) -> incremental -> Operation.packed -> incremental tzresult Lwt.t val finalize_block: incremental -> Block.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/transfer.ml b/src/proto_alpha/lib_protocol/test/transfer.ml index 45d1851c7..3ba771bc4 100644 --- a/src/proto_alpha/lib_protocol/test/transfer.ml +++ b/src/proto_alpha/lib_protocol/test/transfer.ml @@ -19,12 +19,12 @@ open Test_tez destination contract with or without the fee of transfer. 2- Check the equivalent of the balance of the source/destination contract before and after the transfer *) -let transfer_and_check_balances ~loc b ?(fee=Tez.zero) src dst amount = +let transfer_and_check_balances ~loc b ?(fee=Tez.zero) ?expect_failure src dst amount = Tez.(+?) fee amount >>?= fun amount_fee -> Context.Contract.balance (I b) src >>=? fun bal_src -> Context.Contract.balance (I b) dst >>=? fun bal_dst -> Op.transaction (I b) ~fee src dst amount >>=? fun op -> - Incremental.add_operation b op >>=? fun b -> + Incremental.add_operation ?expect_failure b op >>=? fun b -> Assert.balance_was_debited ~loc (I b) src bal_src amount_fee >>=? fun () -> Assert.balance_was_credited ~loc (I b) dst bal_dst amount >>=? fun () -> return (b, op) @@ -67,10 +67,11 @@ let register_two_contracts () = (** 1- Create a block and two contracts/accounts; 2- Add a single transfer into this block; 3- Bake this block. *) -let single_transfer ?fee amount = +let single_transfer ?fee ?expect_failure amount = register_two_contracts () >>=? fun (b, contract_1, contract_2) -> Incremental.begin_construction b >>=? fun b -> - transfer_and_check_balances ~loc:__LOC__ ?fee b contract_1 contract_2 amount >>=? fun (b,_) -> + transfer_and_check_balances ~loc:__LOC__ ?fee ?expect_failure + b contract_1 contract_2 amount >>=? fun (b,_) -> Incremental.finalize_block b >>=? fun _ -> return () @@ -80,7 +81,13 @@ let block_with_a_single_transfer () = (** single transfer without fee *) let transfer_zero_tez () = - single_transfer Tez.zero + single_transfer ~expect_failure:( + function + | Alpha_environment.Ecoproto_error (Contract_storage.Empty_transaction _) :: _ -> + return () + | _ -> + failwith "Empty transaction should fail") + Tez.zero (** single transfer with fee *) let block_with_a_single_transfer_with_fee () =