From 93750bc82a0e2ea94052fffbf188b6271f0ff7aa Mon Sep 17 00:00:00 2001 From: Andre Popovitch Date: Wed, 7 Apr 2021 12:56:03 -0400 Subject: [PATCH] Add test of opcode --- .../test/contracts/opcodes/add.tz | 25 ++++++ src/proto_alpha/lib_protocol/test/dune | 8 +- .../lib_protocol/test/helpers/scripts.ml | 79 +++++++++++++++++ src/proto_alpha/lib_protocol/test/main.ml | 3 +- .../lib_protocol/test/test_interpretation.ml | 61 ++----------- .../test/test_michelson_opcodes.ml | 87 +++++++++++++++++++ 6 files changed, 204 insertions(+), 59 deletions(-) create mode 100644 src/proto_alpha/lib_protocol/test/contracts/opcodes/add.tz create mode 100644 src/proto_alpha/lib_protocol/test/helpers/scripts.ml create mode 100644 src/proto_alpha/lib_protocol/test/test_michelson_opcodes.ml diff --git a/src/proto_alpha/lib_protocol/test/contracts/opcodes/add.tz b/src/proto_alpha/lib_protocol/test/contracts/opcodes/add.tz new file mode 100644 index 000000000000..cbefea08a7a4 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/contracts/opcodes/add.tz @@ -0,0 +1,25 @@ +parameter unit; +storage unit; +code + { + CAR; + + PUSH int 2; PUSH int 2; ADD; PUSH int 4; ASSERT_CMPEQ; + PUSH int 2; PUSH int 2; ADD; PUSH int 4; ASSERT_CMPEQ; + PUSH int 2; PUSH nat 2; ADD; PUSH int 4; ASSERT_CMPEQ; + PUSH nat 2; PUSH int 2; ADD; PUSH int 4; ASSERT_CMPEQ; + PUSH nat 2; PUSH nat 2; ADD; PUSH nat 4; ASSERT_CMPEQ; + + # Offset a timestamp by 60 seconds + PUSH int 60; PUSH timestamp "2019-09-09T12:08:37Z"; ADD; + PUSH timestamp "2019-09-09T12:09:37Z"; ASSERT_CMPEQ; + + PUSH timestamp "2019-09-09T12:08:37Z"; PUSH int 60; ADD; + PUSH timestamp "2019-09-09T12:09:37Z"; ASSERT_CMPEQ; + + PUSH mutez 1000; PUSH mutez 1000; ADD; + PUSH mutez 2000; ASSERT_CMPEQ; + + NIL operation; + PAIR; + } diff --git a/src/proto_alpha/lib_protocol/test/dune b/src/proto_alpha/lib_protocol/test/dune index a154c14a532b..e8edbe8e4181 100644 --- a/src/proto_alpha/lib_protocol/test/dune +++ b/src/proto_alpha/lib_protocol/test/dune @@ -34,14 +34,18 @@ ; runs only the `Quick tests (rule (alias runtest_proto_alpha) - (deps (glob_files contracts/*)) + (deps + (glob_files contracts/*) + (glob_files contracts/opcodes/*)) (package tezos-protocol-alpha-tests) (action (run %{exe:main.exe} -v -q))) ; runs both `Quick and `Slow tests (rule (alias runtest_slow) - (deps (glob_files contracts/*)) + (deps + (glob_files contracts/*) + (glob_files contracts/opcodes/*)) (package tezos-protocol-alpha-tests) (action (run %{exe:main.exe} -v))) diff --git a/src/proto_alpha/lib_protocol/test/helpers/scripts.ml b/src/proto_alpha/lib_protocol/test/helpers/scripts.ml new file mode 100644 index 000000000000..51c73995f4f6 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/scripts.ml @@ -0,0 +1,79 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Alpha_context +open Script_interpreter + +let ( >>=?? ) x y = + x + >>= function + | Ok s -> + y s + | Error err -> + Lwt.return @@ Error (Environment.wrap_tztrace err) + +let default_source = Contract.implicit_contract Signature.Public_key_hash.zero + +let default_step_constants = + { + source = default_source; + payer = default_source; + self = default_source; + amount = Tez.zero; + chain_id = Chain_id.zero; + } + +let test_context () = + Context.init 3 + >>=? fun (b, _cs) -> + Incremental.begin_construction b + >>=? fun v -> return (Incremental.alpha_ctxt v) + +(** Helper function that parses and types a script, its initial storage and + parameters from strings. It then executes the typed script with the storage + and parameter and returns the result. *) +let run_script ctx ?(step_constants = default_step_constants) contract + ?(entrypoint = "default") ~storage ~parameter () = + let contract_expr = Expr.from_string contract in + let storage_expr = Expr.from_string storage in + let parameter_expr = Expr.from_string parameter in + let script = + Script.{code = lazy_expr contract_expr; storage = lazy_expr storage_expr} + in + Script_interpreter.execute + ctx + Readable + step_constants + ~script + ~entrypoint + ~parameter:parameter_expr + ~internal:false + >>=?? fun res -> return res + +let read_file filename = + let ch = open_in filename in + let s = really_input_string ch (in_channel_length ch) in + close_in ch ; s diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index 77b51f58a27a..06bf7d412282 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -61,5 +61,6 @@ let () = ("failing_noop operation", Test_failing_noop.tests); ("storage description", Test_storage.tests); ("time", Test_time_repr.tests); - ("constants", Test_constants.tests) ] + ("constants", Test_constants.tests); + ("opcodes", Test_michelson_opcodes.tests) ] |> Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/test/test_interpretation.ml b/src/proto_alpha/lib_protocol/test/test_interpretation.ml index de7b4a165bd2..dcb859af1009 100644 --- a/src/proto_alpha/lib_protocol/test/test_interpretation.ml +++ b/src/proto_alpha/lib_protocol/test/test_interpretation.ml @@ -10,52 +10,6 @@ open Protocol open Alpha_context open Script_interpreter -let ( >>=?? ) x y = - x - >>= function - | Ok s -> - y s - | Error err -> - Lwt.return @@ Error (Environment.wrap_tztrace err) - -let test_context () = - Context.init 3 - >>=? fun (b, _cs) -> - Incremental.begin_construction b - >>=? fun v -> return (Incremental.alpha_ctxt v) - -let default_source = Contract.implicit_contract Signature.Public_key_hash.zero - -let default_step_constants = - { - source = default_source; - payer = default_source; - self = default_source; - amount = Tez.zero; - chain_id = Chain_id.zero; - } - -(** Helper function that parses and types a script, its initial storage and - parameters from strings. It then executes the typed script with the storage - and parameter and returns the result. *) -let run_script ctx ?(step_constants = default_step_constants) contract - ?(entrypoint = "default") ~storage ~parameter () = - let contract_expr = Expr.from_string contract in - let storage_expr = Expr.from_string storage in - let parameter_expr = Expr.from_string parameter in - let script = - Script.{code = lazy_expr contract_expr; storage = lazy_expr storage_expr} - in - Script_interpreter.execute - ctx - Readable - step_constants - ~script - ~entrypoint - ~parameter:parameter_expr - ~internal:false - >>=?? fun res -> return res - module Logger : STEP_LOGGER = struct let log_interp _ctxt _descr _stack = () @@ -70,17 +24,17 @@ let run_step ctxt code param = Script_interpreter.step (module Logger) ctxt - default_step_constants + Scripts.default_step_constants code param (** Runs a script with an ill-typed parameter and verifies that a Bad_contract_parameter error is returned. *) let test_bad_contract_parameter () = - test_context () + Scripts.test_context () >>=? fun ctx -> (* Run script with a parameter of wrong type *) - run_script + Scripts.run_script ctx "{parameter unit; storage unit; code { CAR; NIL operation; PAIR }}" ~storage:"Unit" @@ -92,20 +46,15 @@ let test_bad_contract_parameter () = | Error (Environment.Ecoproto_error (Bad_contract_parameter source') :: _) -> Test_services.(check Testable.contract) "incorrect field in Bad_contract_parameter" - default_source + Scripts.default_source source' ; return_unit | Error errs -> Alcotest.failf "Unexpected error: %a" Error_monad.pp_print_error errs -let read_file filename = - let ch = open_in filename in - let s = really_input_string ch (in_channel_length ch) in - close_in ch ; s - (* Check that too many recursive calls of the Michelson interpreter result in an error *) let test_stack_overflow () = - test_context () + Scripts.test_context () >>=? fun ctxt -> let descr instr = Script_typed_ir.{loc = 0; bef = Empty_t; aft = Empty_t; instr} diff --git a/src/proto_alpha/lib_protocol/test/test_michelson_opcodes.ml b/src/proto_alpha/lib_protocol/test/test_michelson_opcodes.ml new file mode 100644 index 000000000000..ae33c466002c --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/test_michelson_opcodes.ml @@ -0,0 +1,87 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let opcodes_test_contracts_path = "./contracts/opcodes/" + +let add_badly () = + (* `contract` should perhaps be moved to its own file. *) + let contract = + {|{ +parameter unit; +storage unit; +code + { + CAR; + + PUSH int 2; PUSH int 2; ADD; PUSH int 5; ASSERT_CMPEQ; + + # Offset a timestamp by 60 seconds + PUSH int 60; PUSH timestamp "2019-09-09T12:08:37Z"; ADD; + PUSH timestamp "2019-09-09T12:09:37Z"; ASSERT_CMPEQ; + + PUSH timestamp "2019-09-09T12:08:37Z"; PUSH int 60; ADD; + PUSH timestamp "2019-09-09T12:09:37Z"; ASSERT_CMPEQ; + + PUSH mutez 1000; PUSH mutez 1000; ADD; + PUSH mutez 2000; ASSERT_CMPEQ; + + NIL operation; + PAIR; + } +}|} + in + Scripts.test_context () + >>=? fun ctx -> + Scripts.run_script ctx contract ~storage:"Unit" ~parameter:"Unit" () + >>= function + | Ok _ -> + (* The real assertion demonstrating that the operation was correct should in + the contract itself, via ASSERT_CMPEQ or similar. *) + Alcotest.failf + "ASSERT_CMPEQ failed to cause the contract to evaluate to an error" + | Error _ -> + return_unit + +let test_contract_runs_without_error filename () = + let contract_unfixed = + Scripts.read_file (Filename.concat opcodes_test_contracts_path filename) + in + let contract = String.concat "" ["{"; contract_unfixed; "}"] in + Scripts.test_context () + >>=? fun ctx -> + Scripts.run_script ctx contract ~storage:"Unit" ~parameter:"Unit" () + >>= function + | Ok _ -> + (* The real assertion demonstrating that the operation was correct should be in the contract itself, via ASSERT_CMPEQ *) + return_unit + | Error errs -> + Alcotest.failf "Unexpected error: %a" Error_monad.pp_print_error errs + +let tests = + [ Test_services.tztest "ASSERT_CMPEQ" `Quick add_badly; + Test_services.tztest + "add" + `Quick + (test_contract_runs_without_error "add.tz") ] -- GitLab