diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index 22650f4a9bc50db076202eed6585cb101d76ab78..d372190f4510618057ec5fedf746585198488780 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -3253,6 +3253,7 @@ module Registration_section = struct k = halt; loc = dummy_loc; tag = Entrypoint_repr.default; + unparsed_ty = Script_repr.unit; }) () end diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index e533fad48ef34c823dbc0ae0923fc9bd3ba54c55..deeddb0b3e902ac39bbbbe1b303c3ab0b4942b39 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -1532,9 +1532,9 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = | Bogus_opening -> R true) in (step [@ocaml.tailcall]) g gas k ks accu stack - | IEmit {tag; ty = event_type; k; loc} -> + | IEmit {tag; ty = event_type; unparsed_ty; k; loc = _} -> let event_data = accu in - emit_event (ctxt, sc) gas ~loc ~event_type ~tag ~event_data + emit_event (ctxt, sc) gas ~event_type ~unparsed_ty ~tag ~event_data >>=? fun (accu, ctxt, gas) -> (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack) diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 0343f9bebbda87ea23b5244c34061d2464ea38ea..d18d1a8927e54903b43e0a8a66672975f3d1d033 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -566,8 +566,8 @@ let make_transaction_to_sc_rollup ctxt ~destination ~amount ~entrypoint (** [emit_event] generates an internal operation that will effect an event emission if the contract code returns this successfully. *) -let emit_event (type t tc) (ctxt, sc) gas ~loc ~(event_type : (t, tc) ty) ~tag - ~(event_data : t) = +let emit_event (type t tc) (ctxt, sc) gas ~(event_type : (t, tc) ty) + ~unparsed_ty ~tag ~(event_data : t) = let ctxt = update_context gas ctxt in (* No need to take care of lazy storage as only packable types are allowed *) let lazy_storage_diff = None in @@ -576,9 +576,6 @@ let emit_event (type t tc) (ctxt, sc) gas ~loc ~(event_type : (t, tc) ty) ~tag Gas.consume ctxt (Script.strip_locations_cost unparsed_data) >>?= fun ctxt -> let unparsed_data = Micheline.strip_locations unparsed_data in fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) -> - unparse_ty ~loc ctxt event_type >>?= fun (unparsed_ty, ctxt) -> - Gas.consume ctxt (Script.strip_locations_cost unparsed_ty) >>?= fun ctxt -> - let unparsed_ty = Micheline.strip_locations unparsed_ty in let operation = Event {ty = unparsed_ty; tag; unparsed_data} in let iop = {source = Contract.Originated sc.self; operation; nonce} in let res = {piop = Internal_operation iop; lazy_storage_diff} in diff --git a/src/proto_alpha/lib_protocol/script_interpreter_logging.ml b/src/proto_alpha/lib_protocol/script_interpreter_logging.ml index ef7a267712ddaae66df3e1be88099f071cb578b2..39a7eb3071ef6803d2fd5303b9e9d2970d1d8b4c 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_logging.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_logging.ml @@ -1586,14 +1586,14 @@ let kinstr_split : continuation = k; reconstruct = (fun k -> IMin_block_time (loc, k)); } - | IEmit {loc; ty; tag; k}, Item_t (_, s) -> + | IEmit {loc; ty; unparsed_ty; tag; k}, Item_t (_, s) -> let s = Item_t (operation_t, s) in ok @@ Ex_split_kinstr { cont_init_stack = s; continuation = k; - reconstruct = (fun k -> IEmit {loc; ty; tag; k}); + reconstruct = (fun k -> IEmit {loc; ty; unparsed_ty; tag; k}); } | IEmit _, Bot_t -> . | IHalt loc, _s -> ok @@ Ex_split_halt loc diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 454349c54190a63c49897794e45e834312acb7d7..951bf1470c088cb6fd3616fc2b62d4a9e905b885 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -4640,12 +4640,28 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : Item_t (Chest_key_t, Item_t (Chest_t, Item_t (Nat_t, rest))) ) -> let instr = {apply = (fun k -> IOpen_chest (loc, k))} in typed ctxt loc instr (Item_t (union_bytes_bool_t, rest)) + (* Events *) + | Prim (loc, I_EMIT, [], annot), Item_t (data, rest) -> + check_packable ~legacy loc data >>?= fun () -> + parse_entrypoint_annot_strict loc annot >>?= fun tag -> + unparse_ty ~loc:() ctxt data >>?= fun (unparsed_ty, ctxt) -> + Gas.consume ctxt (Script.strip_locations_cost unparsed_ty) + >>?= fun ctxt -> + let unparsed_ty = Micheline.strip_locations unparsed_ty in + let instr = + {apply = (fun k -> IEmit {loc; tag; ty = data; unparsed_ty; k})} + in + typed ctxt loc instr (Item_t (Operation_t, rest)) | Prim (loc, I_EMIT, [ty_node], annot), Item_t (data, rest) -> parse_packable_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ty_node >>?= fun (Ex_ty ty, ctxt) -> check_item_ty ctxt ty data loc I_EMIT 1 2 >>?= fun (Eq, ctxt) -> parse_entrypoint_annot_strict loc annot >>?= fun tag -> - let instr = {apply = (fun k -> IEmit {loc; tag; ty = data; k})} in + Gas.consume ctxt (Script.strip_locations_cost ty_node) >>?= fun ctxt -> + let unparsed_ty = Micheline.strip_locations ty_node in + let instr = + {apply = (fun k -> IEmit {loc; tag; ty = data; unparsed_ty; k})} + in typed ctxt loc instr (Item_t (Operation_t, rest)) (* Primitive parsing errors *) | ( Prim diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 33471f475c7364b2f723062c417c78241f21bb42..66aa00a23b185e3be8579a88c7386d499e775800 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1087,6 +1087,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = loc : Script.location; tag : Entrypoint.t; ty : ('a, _) ty; + unparsed_ty : Script.expr; k : (operation, 's, 'r, 'f) kinstr; } -> ('a, 's, 'r, 'f) kinstr diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 09e06ddbf84ce997a70a08b12acd82173666cd08..5dbff914eb23fd8966db96e24f8447142a93b449 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1084,6 +1084,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = loc : Script.location; tag : Entrypoint.t; ty : ('a, _) ty; + unparsed_ty : Script.expr; k : (operation, 's, 'r, 'f) kinstr; } -> ('a, 's, 'r, 'f) kinstr diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml index 6b7bfc56d22d64ee5b8b73c63f318f22c56aaf77..6a1fd023693fa50820fe161932eee1db22cc1026 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml @@ -615,10 +615,10 @@ and kinstr_size : | IJoin_tickets (loc, cty, k) -> ret_succ_adding (accu ++ ty_size cty) (base1 loc k +! word_size) | IOpen_chest (loc, k) -> ret_succ_adding accu (base1 loc k) - | IEmit {loc; tag; ty; k} -> + | IEmit {loc; tag; ty; unparsed_ty; k} -> ret_succ_adding - (accu ++ ty_size ty) - (base1 loc k +! Entrypoint.in_memory_size tag +! (word_size *? 2)) + (accu ++ ty_size ty ++ expr_size unparsed_ty) + (base1 loc k +! Entrypoint.in_memory_size tag +! (word_size *? 3)) | IHalt loc -> ret_succ_adding accu (base0 loc) | ILog _ -> (* This instruction is ignored because it is only used for testing. diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/contracts/emit.tz b/src/proto_alpha/lib_protocol/test/integration/michelson/contracts/emit.tz index e57179214e091e05a204c353de1b67f73e0ed7e6..c8c2da0886d0959cbfda0ecc10aef16563fd5aa7 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/contracts/emit.tz +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/contracts/emit.tz @@ -4,7 +4,7 @@ code { DROP ; UNIT ; PUSH string "right" ; RIGHT nat ; - EMIT %tag1 (or (nat %int) (string %str)) ; + EMIT %tag1 ; PUSH nat 2 ; LEFT string ; EMIT %tag2 (or (nat %int) (string %str)) ; diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml index 9bee0ddb6aea3d2120fc4ef70a080804c5cb8bca..9625e49f354e7289e02529c5b9d291fefbe5d906 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_contract_event.ml @@ -30,9 +30,8 @@ open Lwt_result_syntax (** Testing ------- Component: Protocol (event logging) - Invocation: dune exec \ - src/proto_alpha/lib_protocol/test/integration/michelson/main.exe \ - -- test '^event logging$' + Invocation: cd src/proto_alpha/lib_protocol/test/integration/michelson && \ + dune exec ./main.exe -- test '^event logging$' Subject: This module tests that the event logs can be written to the receipt in correct order and expected format. *) @@ -117,8 +116,11 @@ let contract_test () = () | _ -> assert false) ; (match root ty2 with - | Prim (_, T_or, [Prim (_, T_nat, [], []); Prim (_, T_string, [], [])], []) - -> + | Prim + ( _, + T_or, + [Prim (_, T_nat, [], ["%int"]); Prim (_, T_string, [], ["%str"])], + [] ) -> () | _ -> assert false) ; return_unit diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml index fe813692e223d0ff580085609a31ed928ba56a20..f8b6638f0a0798831a25d19d57679978bb83dc96 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml @@ -967,7 +967,14 @@ let check_kinstr_size () = Kinstr ("IOpen_chest", IOpen_chest (loc, halt ())); Kinstr ( "IEmit", - IEmit {loc; tag = entrypoint "entry"; ty = Unit_t; k = halt ()} ); + IEmit + { + loc; + tag = entrypoint "entry"; + ty = Unit_t; + unparsed_ty = Micheline.(strip_locations @@ Seq (loc, [])); + k = halt (); + } ); Kinstr ("IHalt ()", halt ()); ] diff --git a/tests_python/contracts_alpha/opcodes/emit.tz b/tests_python/contracts_alpha/opcodes/emit.tz index 8d758d903e7c4e251f52c80860e6d6c7435742d1..d104dc6bb51ed3e3b2997ed1702fd7c1b5a44711 100644 --- a/tests_python/contracts_alpha/opcodes/emit.tz +++ b/tests_python/contracts_alpha/opcodes/emit.tz @@ -4,7 +4,7 @@ UNIT ; PUSH nat 10 ; LEFT string ; - EMIT %event (or (nat %number) (string %words)) ; + EMIT %event ; PUSH string "lorem ipsum" ; RIGHT nat ; EMIT %event (or (nat %number) (string %words)) ; diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestScriptHashRegression::test_contract_hash[client_regtest_custom_scrubber0].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestScriptHashRegression::test_contract_hash[client_regtest_custom_scrubber0].out index c3202dcb353f1fef84aeb0238a90ed36dc95189a..26cbbd0594a0c02a872477c17a99099d4bd07568 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestScriptHashRegression::test_contract_hash[client_regtest_custom_scrubber0].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestScriptHashRegression::test_contract_hash[client_regtest_custom_scrubber0].out @@ -167,7 +167,7 @@ exprujbvaRkoroj5eVgboUyeP3578oJgScTQ78eBYMgfdLVaGWPPTW [CONTRACT_PATH]/opcodes/d exprur99uFkrwM63FXSTqSTypHcfEmzb5KQ9EypTRqZWDY5NP6tCHL [CONTRACT_PATH]/opcodes/dup-n.tz exprtarW6tiguR7YAo6SxhCUDs1pLDhx9xJEG78h6GnXLAWpt3H1pT [CONTRACT_PATH]/opcodes/ediv.tz exprvQhRaLYxiWN3QsJgT6VKf6DmGVuXR8DxeU63P9A8iNWA4TVQfs [CONTRACT_PATH]/opcodes/ediv_mutez.tz -exprtnW41ZGRWUYs6dHuHJm9W6Hw1CYynpQMWiEt9NxR8mysqK43XT [CONTRACT_PATH]/opcodes/emit.tz +exprtuM993oiKiYWoztZwpAaUuvDDcx9xDX31Q88kpuo7owk6Q8JeR [CONTRACT_PATH]/opcodes/emit.tz exprv8Sy3DsiKMm3ZQPmi46kZGn9ctTigpLB2t6xYFdYkkeVHMXy6z [CONTRACT_PATH]/opcodes/empty_map.tz exprufqf2G8PoZN768K2YGex6M7zmz7bYHE5LF5QHJBVvFtAFLi6qr [CONTRACT_PATH]/opcodes/exec_concat.tz exprut53jocMPdPP8FXrKRDYSoRaxk1FXqCt7o46ak2wQaocjsSwwx [CONTRACT_PATH]/opcodes/first.tz diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--emit.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--emit.tz].out index 79ab213c7a63df1a8a2f6c2a66a30b52676fe611..f54dd5db711c881792c15e085f27bf2a35a88286 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--emit.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--emit.tz].out @@ -1,7 +1,7 @@ tests_alpha/test_contract.py::TestTypecheck::test_typecheck[opcodes/emit.tz] Well typed -Gas remaining: 1039990.816 units remaining +Gas remaining: 1039991.050 units remaining { parameter unit ; storage unit ; code { DROP @@ -12,7 +12,7 @@ Gas remaining: 1039990.816 units remaining /* [ nat : unit ] */ ; LEFT string /* [ or nat string : unit ] */ ; - EMIT %event (or (nat %number) (string %words)) + EMIT %event /* [ operation : unit ] */ ; PUSH string "lorem ipsum" /* [ string : operation : unit ] */ ; diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[emit.tz-Unit-Unit-Unit].out b/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[emit.tz-Unit-Unit-Unit].out index e86c69bed686810759bf4b261d69d697af65e571..4e1684aee78538c4d393cf5b6124ba36e7ed5869 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[emit.tz-Unit-Unit-Unit].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[emit.tz-Unit-Unit-Unit].out @@ -10,63 +10,63 @@ emitted operations Payload: (Left 10) Internal Event: From: KT1BEqzn5Wx8uJrZNvuS9DVHmLvG9td3fDLi - Type: (or nat string) + Type: (or (nat %number) (string %words)) Tag: event Payload: (Right "lorem ipsum") big_map diff trace - - location: 7 (remaining gas: 1039986.766 units remaining) + - location: 7 (remaining gas: 1039986.865 units remaining) [ (Pair Unit Unit) ] - - location: 7 (remaining gas: 1039986.756 units remaining) + - location: 7 (remaining gas: 1039986.855 units remaining) [ ] - - location: 8 (remaining gas: 1039986.746 units remaining) + - location: 8 (remaining gas: 1039986.845 units remaining) [ Unit ] - - location: 9 (remaining gas: 1039986.736 units remaining) + - location: 9 (remaining gas: 1039986.835 units remaining) [ 10 Unit ] - - location: 12 (remaining gas: 1039986.726 units remaining) + - location: 12 (remaining gas: 1039986.825 units remaining) [ (Left 10) Unit ] - - location: 14 (remaining gas: 1039986.291 units remaining) + - location: 14 (remaining gas: 1039986.603 units remaining) [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 18 (remaining gas: 1039986.281 units remaining) + - location: 15 (remaining gas: 1039986.593 units remaining) [ "lorem ipsum" 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 21 (remaining gas: 1039986.271 units remaining) + - location: 18 (remaining gas: 1039986.583 units remaining) [ (Right "lorem ipsum") 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 23 (remaining gas: 1039985.836 units remaining) - [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d + - location: 20 (remaining gas: 1039986.361 units remaining) + [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 27 (remaining gas: 1039985.826 units remaining) + - location: 24 (remaining gas: 1039986.351 units remaining) [ {} - 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d + 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 29 (remaining gas: 1039985.816 units remaining) - [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d + - location: 26 (remaining gas: 1039986.341 units remaining) + [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d {} 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 30 (remaining gas: 1039985.806 units remaining) - [ { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d } + - location: 27 (remaining gas: 1039986.331 units remaining) + [ { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d } 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a Unit ] - - location: 31 (remaining gas: 1039985.796 units remaining) + - location: 28 (remaining gas: 1039986.321 units remaining) [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a - { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d } + { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d } Unit ] - - location: 32 (remaining gas: 1039985.786 units remaining) + - location: 29 (remaining gas: 1039986.311 units remaining) [ { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a ; - 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d } + 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d } Unit ] - - location: 33 (remaining gas: 1039985.776 units remaining) + - location: 30 (remaining gas: 1039986.301 units remaining) [ (Pair { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000004076403620368ffff056576656e74ff0505000a ; - 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000104076403620368ffff056576656e74ff0508010000000b6c6f72656d20697073756d } + 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe6000001040764046200000007256e756d62657204680000000625776f726473ffff056576656e74ff0508010000000b6c6f72656d20697073756d } Unit) ] diff --git a/tezt/tests/contracts/proto_alpha/emit_events.tz b/tezt/tests/contracts/proto_alpha/emit_events.tz index 3a14c0dc185495e372e1385830f6a6cc29157dc9..c54e2a0997ab5e7254a8aa5dad743b5f205e2934 100644 --- a/tezt/tests/contracts/proto_alpha/emit_events.tz +++ b/tezt/tests/contracts/proto_alpha/emit_events.tz @@ -4,7 +4,7 @@ code { DROP; UNIT; PUSH string "right"; RIGHT nat; - EMIT %tag1 (or (nat %int) (string %str)) ; + EMIT %tag1 ; PUSH nat 2; LEFT string; EMIT %tag2 (or (nat %int) (string %str)) ; diff --git a/tezt/tests/events.ml b/tezt/tests/events.ml index bf06f4379ccc40ef900bb9a5a0da1751cbf4cffd..4089d6eeadcdbb7d821eabe14c63970724708ddf 100644 --- a/tezt/tests/events.ml +++ b/tezt/tests/events.ml @@ -72,21 +72,31 @@ let test_emit_event protocol = |-> "internal_operation_results" in let event = events |=> 0 in - let assert_type event = + let assert_prim ~prim ~annots json = + assert (json |-> "prim" |> as_string = prim) ; + assert (json |-> "annots" |> as_list |> List.map as_string = annots) + in + let assert_type ~annots event = let ty = event |-> "type" in - assert (ty |-> "prim" |> as_string = "or") ; + assert_prim ty ~prim:"or" ~annots:[] ; let args = ty |-> "args" in - assert (args |=> 0 |-> "prim" |> as_string = "nat") ; - assert (args |=> 1 |-> "prim" |> as_string = "string") + assert_prim + (args |=> 0) + ~prim:"nat" + ~annots:(if annots then ["%int"] else []) ; + assert_prim + (args |=> 1) + ~prim:"string" + ~annots:(if annots then ["%str"] else []) in - assert_type event ; + assert_type ~annots:false event ; let data = event |-> "payload" in assert (data |-> "prim" |> as_string = "Right") ; assert (data |-> "args" |=> 0 |-> "string" |> as_string = "right") ; let tag = event |-> "tag" |> as_string in assert (tag = "tag1") ; let event = events |=> 1 in - assert_type event ; + assert_type ~annots:true event ; let data = event |-> "payload" in assert (data |-> "prim" |> as_string = "Left") ; assert (data |-> "args" |=> 0 |-> "int" |> as_string = "2") ;