Alpha, Client: don't count gas for unparsing in logging

This commit is contained in:
Alain Mebsout 2018-06-28 02:40:20 +02:00 committed by Benjamin Canou
parent 0c8549b871
commit f6c4be2b40

View File

@ -1561,15 +1561,18 @@ and parse_instr
Lwt.return check in Lwt.return check in
let check_item_ty exp got loc n = let check_item_ty exp got loc n =
check_item (ty_eq ctxt exp got) loc n in check_item (ty_eq ctxt exp got) loc n in
let log_stack ctxt loc stack_ty aft : context tzresult Lwt.t = let log_stack ctxt loc stack_ty aft =
match type_logger, script_instr with match type_logger, script_instr with
| None, _ | None, _
| Some _, (Seq (-1, _) | Int _ | String _ | Bytes _) -> return ctxt | Some _, (Seq (-1, _) | Int _ | String _ | Bytes _) -> return ()
| Some log, (Prim _ | Seq _) -> | Some log, (Prim _ | Seq _) ->
unparse_stack ctxt stack_ty >>=? fun (stack_ty, ctxt) -> (* Unparsing for logging done in an unlimited context as this
unparse_stack ctxt aft >>=? fun (aft, ctxt) -> is used only by the client and not the protocol *)
let ctxt = Gas.set_unlimited ctxt in
unparse_stack ctxt stack_ty >>=? fun (stack_ty, _) ->
unparse_stack ctxt aft >>=? fun (aft, _) ->
log loc stack_ty aft; log loc stack_ty aft;
return ctxt return ()
in in
let return : let return :
context -> bef judgement -> (bef judgement * context) tzresult Lwt.t = fun ctxt judgement -> context -> bef judgement -> (bef judgement * context) tzresult Lwt.t = fun ctxt judgement ->
@ -1586,7 +1589,7 @@ and parse_instr
| Failed _ -> | Failed _ ->
return (judgement, ctxt) in return (judgement, ctxt) in
let typed ctxt loc instr aft = let typed ctxt loc instr aft =
log_stack ctxt loc stack_ty aft >>=? fun ctxt -> log_stack ctxt loc stack_ty aft >>=? fun () ->
return ctxt (Typed { loc ; instr ; bef = stack_ty ; aft }) in return ctxt (Typed { loc ; instr ; bef = stack_ty ; aft }) in
match script_instr, stack_ty with match script_instr, stack_ty with
(* stack ops *) (* stack ops *)
@ -2036,7 +2039,7 @@ and parse_instr
Item_t (v, _rest, _) -> Item_t (v, _rest, _) ->
fail_unexpected_annot loc annot >>=? fun () -> fail_unexpected_annot loc annot >>=? fun () ->
let descr aft = { loc ; instr = Failwith v ; bef = stack_ty ; aft } in let descr aft = { loc ; instr = Failwith v ; bef = stack_ty ; aft } in
log_stack ctxt loc stack_ty Empty_t >>=? fun ctxt -> log_stack ctxt loc stack_ty Empty_t >>=? fun () ->
return ctxt (Failed { descr }) return ctxt (Failed { descr })
(* timestamp operations *) (* timestamp operations *)
| Prim (loc, I_ADD, [], annot), | Prim (loc, I_ADD, [], annot),