diff --git a/src/client/embedded/alpha/michelson_macros.ml b/src/client/embedded/alpha/michelson_macros.ml index b4daaf6b1..dec790b11 100644 --- a/src/client/embedded/alpha/michelson_macros.ml +++ b/src/client/embedded/alpha/michelson_macros.ml @@ -353,6 +353,54 @@ let expand_compare original = | Prim (loc, "IFGE", args, None) -> Some (Seq (loc, [ Prim (loc, "GE", [], None) ; Prim (loc, "IF", args, None) ], None)) + | _ -> None;; + + +let expand_asserts original = + let fail_false loc = + [ Seq(loc, [], None) ; Seq(loc, [ Prim (loc, "FAIL", [], None) ], None) ] in + let fail_true loc = + [ Seq(loc, [ Prim (loc, "FAIL", [], None) ], None) ; Seq(loc, [], None) ] in + match original with + | Prim (loc, "ASSERT", [], None) -> + Some (Seq (loc, [ Prim (loc, "IF", fail_false loc, None) ], None)) + | Prim (loc, "ASSERT_NONE", [], None) -> + Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_false loc, None) ], None)) + | Prim (loc, "ASSERT_SOME", [], None) -> + Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_true loc, None) ], None)) + | Prim (loc, "ASSERT_LEFT", [], None) -> + Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_false loc, None) ], None)) + | Prim (loc, "ASSERT_RIGHT", [], None) -> + Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_true loc, None) ], None)) + | Prim (loc, s, [], None) + when String.(length s > 7 && equal (sub s 0 7) "ASSERT_") -> + begin + let remaining = String.(sub s 7 ((length s) - 7)) in + let remaining_prim = Prim(loc, remaining, [], None) in + match remaining with + | "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" -> + Some (Seq (loc, [ remaining_prim ; + Prim (loc, "IF", fail_false loc, None) ], None)) + | _ -> + begin + match expand_compare remaining_prim with + | None -> None + | Some seq -> + Some (Seq (loc, [ seq ; + Prim (loc, "IF", fail_false loc, None) ], None)) + end + end + | _ -> None + + +let expand_if_some = function + | Prim (loc, "IF_SOME", [ right ; left ], None) -> + Some (Seq (loc, [ Prim (loc, "IF_NONE", [ left ; right ], None) ], None)) + | _ -> None + +let expand_if_right = function + | Prim (loc, "IF_RIGHT", [ right ; left ], None) -> + Some (Seq (loc, [ Prim (loc, "IF_LEFT", [ left ; right ], None) ], None)) | _ -> None let expand original = @@ -374,7 +422,10 @@ let expand original = expand_paaiair ; expand_unpaaiair ; expand_duuuuup ; - expand_compare ] + expand_compare ; + expand_asserts ; + expand_if_some ; + expand_if_right ] open Script @@ -521,27 +572,23 @@ let unexpand_dxiiivp expanded = | _ -> None let unexpand_duuuuup expanded = - let is_duuuuup_prim_name str = - let len = String.length str in - len >= 3 - && String.get str 0 = 'D' - && String.get str (len - 1) = 'P' - && begin - let all_u = ref true in - for i = 1 to len - 2 do - all_u := !all_u && String.get str i = 'U' - done ; - !all_u - end in - match expanded with - | Seq (loc, - [ Prim (_, "DIP", - [ Prim (_, sub, [], None) ], None) ; - Prim (_, "SWAP", [], None) ], None) - when is_duuuuup_prim_name sub -> - let name = "DU" ^ String.sub sub 1 (String.length sub - 1) in - Some (Prim (loc, name, [], None)) - | _ -> None + let rec help expanded = + match expanded with + | Seq (loc, [ Prim (_, "DUP", [], None) ], None) -> Some (loc, 1) + | Seq (_, [ Prim (_, "DIP", [expanded'], None); + Prim (_, "SWAP", [], None) ], None) -> + begin + match help expanded' with + | None -> None + | Some (loc, n) -> Some (loc, n + 1) + end + | _ -> None + in let rec dupn = function + | 0 -> "P" + | n -> "U" ^ (dupn (n - 1)) in + match help expanded with + | None -> None + | Some (loc, n) -> Some (Prim (loc, "D" ^ (dupn n), [], None)) let unexpand_paaiair expanded = match expanded with @@ -650,6 +697,51 @@ let unexpand_compare expanded = Some (Prim (loc, "IFGE", args, None)) | _ -> None +let unexpand_asserts expanded = + match expanded with + | Seq (loc, [ Prim (_, "IF", [ Seq (_, [ ], None) ; + Seq (_, [ Prim(_, "FAIL", [], None) ], None) ], + None) ], None) -> + Some (Prim (loc, "ASSERT", [], None)) + | Seq (loc, [ Seq (_, [ Prim(_, "COMPARE", [], None) ; Prim(_, comparison, [], None) ], None) ; + Prim (_, "IF", [ Seq (_, [ ], None) ; + Seq (_, [ Prim(_, "FAIL", [], None) ], None) ], + None) ], None) -> + Some (Prim (loc, "ASSERT_CMP" ^ comparison, [], None)) + | Seq (loc, [ Prim (_, comparison, [], None) ; + Prim (_, "IF", [ Seq (_, [ ], None) ; + Seq (_, [ Prim(_, "FAIL", [], None) ], None) ], + None) ], None) -> + Some (Prim (loc, "ASSERT_" ^ comparison, [], None)) + | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ ], None) ; + Seq (_, [ Prim(_, "FAIL", [], None) ], None) ], + None) ], None) -> + Some (Prim (loc, "ASSERT_NONE", [], None)) + | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Prim(_, "FAIL", [], None) ], None) ; + Seq (_, [ ], None)], + None) ], None) -> + Some (Prim (loc, "ASSERT_SOME", [], None)) + | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ ], None) ; + Seq (_, [ Prim(_, "FAIL", [], None) ], None) ], + None) ], None) -> + Some (Prim (loc, "ASSERT_LEFT", [], None)) + | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Prim(_, "FAIL", [], None) ], None) ; + Seq (_, [ ], None) ], + None) ], None) -> + Some (Prim (loc, "ASSERT_RIGHT", [], None)) + | _ -> None + + +let unexpand_if_some = function + | Seq (loc, [ Prim (_, "IF_NONE", [ left ; right ], None) ], None) -> + Some (Prim (loc, "IF_SOME", [ right ; left ], None)) + | _ -> None + +let unexpand_if_right = function + | Seq (loc, [ Prim (_, "IF_LEFT", [ left ; right ], None) ], None) -> + Some (Prim (loc, "IF_RIGHT", [ right ; left ], None)) + | _ -> None + let unexpand original = let try_expansions unexpanders = match @@ -662,11 +754,14 @@ let unexpand original = | None -> original | Some rewritten -> rewritten in try_expansions - [ unexpand_caddadr ; + [ unexpand_asserts ; + unexpand_caddadr ; unexpand_set_caddadr ; unexpand_map_caddadr ; unexpand_dxiiivp ; unexpand_paaiair ; unexpand_unpaaiair ; unexpand_duuuuup ; - unexpand_compare ] + unexpand_compare ; + unexpand_if_some ; + unexpand_if_right ] diff --git a/src/client/embedded/alpha/michelson_macros.mli b/src/client/embedded/alpha/michelson_macros.mli index fc5eeffea..21802f306 100644 --- a/src/client/embedded/alpha/michelson_macros.mli +++ b/src/client/embedded/alpha/michelson_macros.mli @@ -18,7 +18,10 @@ val expand_dxiiivp : node -> node option val expand_paaiair : node -> node option val expand_duuuuup : node -> node option val expand_compare : node -> node option +val expand_asserts : node -> node option val expand_unpaaiair : node -> node option +val expand_if_some : node -> node option +val expand_if_right : node -> node option open Script @@ -31,4 +34,7 @@ val unexpand_dxiiivp : expr -> expr option val unexpand_paaiair : expr -> expr option val unexpand_duuuuup : expr -> expr option val unexpand_compare : expr -> expr option +val unexpand_asserts : expr -> expr option val unexpand_unpaaiair : expr -> expr option +val unexpand_if_some : expr -> expr option +val unexpand_if_right : expr -> expr option diff --git a/src/proto/alpha/docs/language.md b/src/proto/alpha/docs/language.md index b7267f676..6db107bbf 100644 --- a/src/proto/alpha/docs/language.md +++ b/src/proto/alpha/docs/language.md @@ -842,6 +842,16 @@ constants as is, concatenate them and use them as keys. > IF_NONE ; C / (None) : S => bt ; C / S > IF_NONE ; C / (Some a) : S => bf ; C / a : S + * `IF_SOME bt bf`: + Inspect an optional value. + + :: 'a? : 'S -> 'b : 'S + iff bt :: [ 'a : 'S -> 'b : 'S] + bf :: [ 'S -> 'b : 'S] + + > IF_SOME ; C / (Some a) : S => bt ; C / a : S + > IF_SOME ; C / (None) : S => bf ; C / S + ### Operations on unions @@ -869,6 +879,17 @@ constants as is, concatenate them and use them as keys. > IF_LEFT ; C / (Left a) : S => bt ; C / a : S > IF_LEFT ; C / (Right b) : S => bf ; C / b : S + * `IF_RIGHT bt bf`: + Inspect an optional value. + + :: or 'a 'b : 'S -> 'c : 'S + iff bt :: [ 'b : 'S -> 'c : 'S] + bf :: [ 'a : 'S -> 'c : 'S] + + > IF_LEFT ; C / (Right b) : S => bt ; C / b : S + > IF_RIGHT ; C / (Left a) : S => bf ; C / a : S + + ### Operations on lists * `CONS`: @@ -1110,6 +1131,41 @@ for under/overflows. :: key : key : 'S -> int : 'S +### Assertion operations + +All assertion operations are syntactic sugar for conditionals +with a `FAIL` instruction in the appropriate branch. +When possible, use them to increase clarity about illegal states. + + * `ASSERT`: + + > IF {} {FAIL} + + * `ASSERT_{EQ|NEQ|LT|LE|GT|GE}`: + + > ASSERT_(\op) => IF(\op) {} {FAIL} + + * `ASSERT_CMP{EQ|NEQ|LT|LE|GT|GE}`: + + > ASSERT_CMP(\op) => IFCMP(\op) {} {FAIL} + + * `ASSERT_NONE`: + Equivalent to ``. + + > ASSERT_NONE => IF_NONE {} {FAIL} + + * `ASSERT_SOME`: + Equivalent to `IF_NONE {FAIL} {}`. + + > ASSERT_NONE => IF_NONE {FAIL} {} + + * `ASSERT_LEFT`: + + > ASSERT_LEFT => IF_LEFT {} {FAIL} + + * `ASSERT_RIGHT`: + + > ASSERT_RIGHT => IF_LEFT {FAIL} {} VIII - Concrete syntax ---------------------- diff --git a/test/contracts/assert.tz b/test/contracts/assert.tz new file mode 100644 index 000000000..087b12907 --- /dev/null +++ b/test/contracts/assert.tz @@ -0,0 +1,4 @@ +parameter bool; +storage unit; +return unit; +code {CAR; ASSERT; UNIT; UNIT; PAIR} diff --git a/test/contracts/assert_cmpeq.tz b/test/contracts/assert_cmpeq.tz new file mode 100644 index 000000000..f5dd7d0f4 --- /dev/null +++ b/test/contracts/assert_cmpeq.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_cmpge.tz b/test/contracts/assert_cmpge.tz new file mode 100644 index 000000000..3db916747 --- /dev/null +++ b/test/contracts/assert_cmpge.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_cmpgt.tz b/test/contracts/assert_cmpgt.tz new file mode 100644 index 000000000..a2d172017 --- /dev/null +++ b/test/contracts/assert_cmpgt.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_cmple.tz b/test/contracts/assert_cmple.tz new file mode 100644 index 000000000..c728c2183 --- /dev/null +++ b/test/contracts/assert_cmple.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_cmplt.tz b/test/contracts/assert_cmplt.tz new file mode 100644 index 000000000..200165564 --- /dev/null +++ b/test/contracts/assert_cmplt.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_cmpneq.tz b/test/contracts/assert_cmpneq.tz new file mode 100644 index 000000000..8c8e13b93 --- /dev/null +++ b/test/contracts/assert_cmpneq.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_eq.tz b/test/contracts/assert_eq.tz new file mode 100644 index 000000000..45f6afb10 --- /dev/null +++ b/test/contracts/assert_eq.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_ge.tz b/test/contracts/assert_ge.tz new file mode 100644 index 000000000..b3a24b8a7 --- /dev/null +++ b/test/contracts/assert_ge.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_gt.tz b/test/contracts/assert_gt.tz new file mode 100644 index 000000000..559c77f66 --- /dev/null +++ b/test/contracts/assert_gt.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_le.tz b/test/contracts/assert_le.tz new file mode 100644 index 000000000..c9ace4a7f --- /dev/null +++ b/test/contracts/assert_le.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_lt.tz b/test/contracts/assert_lt.tz new file mode 100644 index 000000000..21f883dac --- /dev/null +++ b/test/contracts/assert_lt.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; DUP; PAIR} diff --git a/test/contracts/assert_neq.tz b/test/contracts/assert_neq.tz new file mode 100644 index 000000000..c381882df --- /dev/null +++ b/test/contracts/assert_neq.tz @@ -0,0 +1,4 @@ +parameter (pair int int); +storage unit; +return unit; +code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; DUP; PAIR} diff --git a/test/contracts/if_some.tz b/test/contracts/if_some.tz new file mode 100644 index 000000000..2ccc280a7 --- /dev/null +++ b/test/contracts/if_some.tz @@ -0,0 +1,4 @@ +parameter (option string); +return string; +storage unit; +code { CAR; IF_SOME {} {PUSH string ""}; UNIT; SWAP; PAIR} diff --git a/test/contracts/set_car.tz b/test/contracts/set_car.tz new file mode 100644 index 000000000..ed894a17a --- /dev/null +++ b/test/contracts/set_car.tz @@ -0,0 +1,4 @@ +parameter string; +storage (pair string nat); +return (pair string nat); +code {DUP; CDR; DIP{CAR}; SET_CAR; DUP; PAIR}; diff --git a/test/contracts/set_cdr.tz b/test/contracts/set_cdr.tz new file mode 100644 index 000000000..c434b6793 --- /dev/null +++ b/test/contracts/set_cdr.tz @@ -0,0 +1,4 @@ +parameter nat; +storage (pair string nat); +return (pair string nat); +code {DUP; CDR; DIP{CAR}; SET_CDR; DUP; PAIR}; diff --git a/test/proto_alpha/Makefile b/test/proto_alpha/Makefile index cdcb96728..3cc794918 100644 --- a/test/proto_alpha/Makefile +++ b/test/proto_alpha/Makefile @@ -114,3 +114,21 @@ test-vote: ${LIB} ${TEST_VOTE_IMPLS:.ml=.cmx} clean:: rm -f test-vote +############################################################################ +## Michelson Parser + +.PHONY: run-test-michelson-parser +run-test-michelson-parser: + @echo + ./test-michelson-parser + +TEST_MICHELSON_PARSER_IMPLS := \ + proto_alpha_helpers.ml \ + test_michelson_parser.ml + +test-michelson-parser: ${LIB} ${TEST_MICHELSON_PARSER_IMPLS:.ml=.cmx} + @echo COMPILE $(notdir $@) + @${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^ + +clean:: + rm -f test-michelson-parser diff --git a/test/proto_alpha/test_michelson_parser.ml b/test/proto_alpha/test_michelson_parser.ml new file mode 100644 index 000000000..582ee0a56 --- /dev/null +++ b/test/proto_alpha/test_michelson_parser.ml @@ -0,0 +1,316 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Client_embedded_proto_alpha +open Tezos_context.Script +open Client_alpha + +module Helpers = Proto_alpha_helpers +module Assert = Helpers.Assert + +open Script_located_ir + +let zero_loc = { start=point_zero; + stop=point_zero};; + +let assert_identity f x = + Assert.equal + (f x) + x;; + +(* Test expansion *) +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "CAAR", [], None))) + (Seq (zero_loc, + [(Prim (zero_loc, "CAR", [], None)); + (Prim (zero_loc, "CAR", [], None)) ], + None));; + +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "CAAR", [], Some "annot"))) + (Seq (zero_loc, + [(Prim (zero_loc, "CAR", [], None)); + (Prim (zero_loc, "CAR", [], Some "annot")) ], + None));; + +assert_identity Michelson_macros.expand (Prim (zero_loc, "CAR", [], Some "annot"));; + + +let arg = [ Prim (zero_loc, "CAR", [], Some "annot") ] in +Assert.equal + (Michelson_macros.expand (Prim (zero_loc, "DIP", arg, Some "new_annot"))) + (Prim (zero_loc, "DIP", arg, Some "new_annot")); +Assert.equal + (Michelson_macros.expand (Prim (zero_loc, "DIIP", arg, None))) + (Seq (zero_loc, + [ Prim (zero_loc, "DIP", + [ (Seq (zero_loc, + [ Prim (zero_loc, "DIP", arg, None) ], + None)) ], + None) ], + None)); +Assert.equal + (Michelson_macros.expand (Prim (zero_loc, "DIIIP", arg, None))) + (Seq (zero_loc, + [ Prim (zero_loc, "DIP", + [ (Seq (zero_loc, + [ Prim (zero_loc, + "DIP", + [ (Seq (zero_loc, + [ Prim (zero_loc, "DIP", arg, None) ], + None)) ], + None) ], + None)) ], + None) ], + None));; + +Assert.equal + (Michelson_macros.expand (Prim (zero_loc, "DUUP", [], None))) + (Seq (zero_loc, + [ Prim (zero_loc, "DIP", [ Seq (zero_loc, [ Prim (zero_loc, "DUP", [], None) ], None) ], None) ; + Prim (zero_loc, "SWAP", [], None) ], None));; + +Assert.equal + (Michelson_macros.expand (Prim (zero_loc, "DUUUP", [], None))) + (Seq (zero_loc, + [ Prim (zero_loc, "DIP", + [ Seq (zero_loc, [ + Prim (zero_loc, "DIP", [ + Seq (zero_loc, [ Prim (zero_loc, "DUP", [], None) ], None)], + None); + Prim (zero_loc, "SWAP", [], None) ], + None) ], + None) ; + Prim (zero_loc, "SWAP", [], None) ], None));; + +let assert_compare_macro prim_name compare_name = + Assert.equal + (Michelson_macros.expand (Prim (zero_loc, prim_name, [], None))) + (Seq (zero_loc, + [ Prim (zero_loc, "COMPARE", [], None) ; + Prim (zero_loc, compare_name, [], None) ], None));; + +let left_branch = Seq(zero_loc, [ Prim(zero_loc, "SWAP", [], None) ], None);; +let right_branch = Seq(zero_loc, [ ], None);; +let assert_compare_if_macro prim_name compare_name = + Assert.equal + (Michelson_macros.expand (Prim (zero_loc, + prim_name, + [ left_branch ; right_branch ], + None))) + (Seq (zero_loc, [ Prim(zero_loc, "COMPARE", [], None); + Prim(zero_loc, compare_name, [], None); + Prim (zero_loc, "IF", [ left_branch ; right_branch ], None) ], None)) in + +assert_compare_macro "CMPEQ" "EQ"; +assert_compare_macro "CMPNEQ" "NEQ"; +assert_compare_macro "CMPLT" "LT"; +assert_compare_macro "CMPLE" "LE"; +assert_compare_macro "CMPGT" "GT"; +assert_compare_macro "CMPGE" "GE"; + +assert_compare_if_macro "IFCMPEQ" "EQ"; +assert_compare_if_macro "IFCMPNEQ" "NEQ"; +assert_compare_if_macro "IFCMPLT" "LT"; +assert_compare_if_macro "IFCMPLE" "LE"; +assert_compare_if_macro "IFCMPGT" "GT"; +assert_compare_if_macro "IFCMPGE" "GE"; +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "ASSERT_LEFT", [], None))) + (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", + [ Seq (zero_loc, [ ], None) ; + Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ], + None) ], None)); +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "ASSERT_RIGHT", [], None))) + (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", + [ Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ; + Seq (zero_loc, [ ], None) ], + None) ], None)); +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch ], None))) + (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", [ right_branch ; left_branch ], None) ], None)); +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch ], None))) + (Seq (zero_loc, [ Prim (zero_loc, "IF_NONE", [ right_branch ; left_branch ], None) ], None));; + + +assert_identity Michelson_macros.expand (Prim (zero_loc, "PAIR", [], None));; + +let expand_unexpand x = + Michelson_macros.unexpand (Michelson_macros.expand x);; + +assert_identity expand_unexpand (Prim (zero_loc, "PAAAIAIR", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "DIIIP{DROP}", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "SET_CAR", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "SET_CDR", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "DUP", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "DUUP", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "DUUUP", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "DUUUUP", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "DUUUUUP", [], None)); + +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_EQ", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_NEQ", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_LT", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_LE", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_GT", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_GE", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_NONE", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_SOME", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_LEFT", [], None)); +assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_RIGHT", [], None)); + +assert_identity expand_unexpand (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch], None)); +assert_identity expand_unexpand (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch], None)); + +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIR", [], None))) + (Seq (zero_loc, + [Prim + (zero_loc, + "DIP", + [Seq (zero_loc, [Prim + (zero_loc, "PAIR", [], None)], + None)], + None)], + None));; + +Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIAIR", [], None))) + (Seq (zero_loc, [Prim + (zero_loc, + "DIP", + [Seq + (zero_loc, + [Prim + (zero_loc, + "PAIR", [], None)], + None)], + None); + Prim + (zero_loc, + "PAIR", [], None)], + None));; + +open Michelson_parser;; + +let get_tokens = + List.map (fun x -> x.token);; + +Assert.equal (get_tokens @@ tokenize @@ "int") + [ (Ident "int") ]; +Assert.equal (get_tokens @@ tokenize @@ "100") + [ (Int "100") ]; +Assert.equal (get_tokens @@ tokenize @@ "(option int)") + [ Open_paren ; Ident "option" ; Ident "int" ; Close_paren ]; +Assert.equal (get_tokens @@ tokenize @@ "DIP { ADD }") + [ Ident "DIP" ; Open_brace ; Ident "ADD" ; Close_brace ]; +Assert.equal (get_tokens @@ tokenize @@ "\"hello\"") + [ String "hello" ]; +Assert.equal (get_tokens @@ tokenize @@ "parameter int;") + [ Ident "parameter" ; Ident "int" ; Semi ]; +Assert.equal (get_tokens @@ tokenize @@ "PUSH string \"abcd\";") + [ Ident "PUSH" ; Ident "string" ; String "abcd" ; Semi ]; +Assert.equal (get_tokens @@ tokenize @@ "DROP; SWAP") + [ Ident "DROP" ; Semi ; Ident "SWAP" ]; +Assert.equal (get_tokens @@ tokenize @@ "string") + [ Ident "string" ] + + +let parse_expr_no_locs str = + List.map strip_locations + Michelson_parser.(parse_toplevel (tokenize str)) + +let assert_parses str parsed = + Assert.equal (parse_expr_no_locs str) parsed;; + +assert_parses "PUSH int 100" + [ (Prim ((), "PUSH", [ Prim ((), "int", [], None) ; + Int ((), "100") ], None)) ]; + +assert_parses "DROP" [ (Prim ((), "DROP", [], None)) ]; +assert_parses "DIP{DROP}" + [ Prim ((), "DIP", [ Seq((), [ Prim ((), "DROP", [], None) ], None) ], None) ]; + +assert_parses "LAMBDA int int {}" + [ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ; + Prim ((), "int", [], None) ; + Seq ((), [ ], None) ], None) ]; + +assert_parses "LAMBDA @name int int {}" + [ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ; + Prim ((), "int", [], None) ; + Seq ((), [ ], None) ], Some "@name") ]; + +assert_parses "NIL @annot string; # comment\n" + [ Prim ((), "NIL", [ Prim ((), "string", [], None) ], Some "@annot") ]; + +assert_parses "PUSH (pair bool string) (Pair False \"abc\")" + [ Prim ((), "PUSH", [ Prim ((), "pair", + [ Prim ((), "bool", [], None) ; + Prim ((), "string", [], None) ], None) ; + Prim ((), "Pair", + [ Prim ((), "False", [], None) ; + String ((), "abc")], None) ], None) ]; +assert_parses "PUSH (list nat) (List 1 2 3)" + [ Prim ((), "PUSH", [ Prim ((), "list", + [ Prim ((), "nat", [], None) ], None) ; + Prim ((), "List", + [ Int((), "1"); + Int ((), "2"); + Int ((), "3")], + None) ], None) ]; +assert_parses "PUSH (lambda nat nat) {}" + [ Prim ((), "PUSH", [ Prim ((), "lambda", + [ Prim ((), "nat", [], None); + Prim ((), "nat", [], None)], None) ; + Seq((), [], None)], + None) ]; +assert_parses "PUSH key \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\"" + [ Prim ((), "PUSH", [ Prim ((), "key", [], None) ; + String ((),"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ], + None) ]; +assert_parses "PUSH (map int bool) (Map (Item 100 False))" + [ Prim ((), "PUSH", [ Prim ((), "map", + [ Prim((), "int", [], None); + Prim((), "bool", [], None)], None) ; + Prim ((), "Map", + [Prim ((), "Item", + [Int ((), "100"); + Prim ((), "False", [], None)], None)], None) ], + None) ]; +assert_parses + "parameter int; \ +return int; \ +storage unit; \ +code {}" + [ Prim ((), "parameter", [ Prim((), "int", [], None) ], None); + Prim ((), "return", [ Prim((), "int", [], None) ], None); + Prim ((), "storage", [ Prim((), "unit", [], None) ], None); + Prim ((), "code", [ Seq((), [], None) ], None)]; +assert_parses + "parameter int; \ + storage unit; \ + return int; \ + code {CAR; PUSH int 1; ADD; UNIT; SWAP; PAIR};" + [ Prim ((), "parameter", [ Prim((), "int", [], None) ], None); + Prim ((), "storage", [ Prim((), "unit", [], None) ], None); + Prim ((), "return", [ Prim((), "int", [], None) ], None); + Prim ((), "code", [ Seq((), [ Prim ((), "CAR", [], None) ; + Prim ((), "PUSH", [ Prim((), "int", [], None) ; + Int ((), "1")], None) ; + Prim ((), "ADD", [], None) ; + Prim ((), "UNIT", [], None) ; + Prim ((), "SWAP", [], None) ; + Prim ((), "PAIR", [], None)], None) ], None)]; +assert_parses + "code {DUP @test; DROP}" + [ Prim ((), "code", [Seq ((), [ Prim ((), "DUP", [], Some "@test"); + Prim ((), "DROP", [], None)], None)], None) ]; +assert_parses + "IF {CAR} {CDR}" + [ Prim ((), "IF", [ Seq ((), [ Prim ((), "CAR", [], None) ], None); + Seq ((), [ Prim ((), "CDR", [], None) ], None) ], None) ]; +assert_parses + "IF_NONE {FAIL} {}" + [ Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], None) ], None); + Seq ((), [ ], None) ], None) ]; diff --git a/test/test_contracts.sh b/test/test_contracts.sh index 426a3260e..f8039d2f0 100755 --- a/test/test_contracts.sh +++ b/test/test_contracts.sh @@ -196,7 +196,76 @@ assert_output $CONTRACT_PATH/first.tz Unit '(List 4)' '4' assert_output $CONTRACT_PATH/hash_string.tz Unit '"abcdefg"' '"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF"' assert_output $CONTRACT_PATH/hash_string.tz Unit '"12345"' '"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3"' -# Did the given key sign the string? +# Test ASSERT +assert_output $CONTRACT_PATH/assert.tz Unit True Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert.tz on storage Unit and input False + +# COMPARE; ASSERT_ +assert_output $CONTRACT_PATH/assert_eq.tz Unit '(Pair -1 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_eq.tz on storage Unit and input '(Pair 0 -1)' + +assert_output $CONTRACT_PATH/assert_eq.tz Unit '(Pair -1 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_eq.tz on storage Unit and input '(Pair 0 -1)' + +assert_output $CONTRACT_PATH/assert_neq.tz Unit '(Pair 0 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_neq.tz on storage Unit and input '(Pair -1 -1)' + +assert_output $CONTRACT_PATH/assert_lt.tz Unit '(Pair -1 0)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_lt.tz on storage Unit and input '(Pair 0 -1)' +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_lt.tz on storage Unit and input '(Pair 0 0)' + +assert_output $CONTRACT_PATH/assert_le.tz Unit '(Pair 0 0)' Unit +assert_output $CONTRACT_PATH/assert_le.tz Unit '(Pair -1 0)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_le.tz on storage Unit and input '(Pair 0 -1)' + +assert_output $CONTRACT_PATH/assert_gt.tz Unit '(Pair 0 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_gt.tz on storage Unit and input '(Pair -1 0)' +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_gt.tz on storage Unit and input '(Pair 0 0)' + +assert_output $CONTRACT_PATH/assert_ge.tz Unit '(Pair 0 0)' Unit +assert_output $CONTRACT_PATH/assert_ge.tz Unit '(Pair 0 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_ge.tz on storage Unit and input '(Pair -1 0)' + +# ASSERT_CMP +assert_output $CONTRACT_PATH/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)' + +assert_output $CONTRACT_PATH/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)' + +assert_output $CONTRACT_PATH/assert_cmpneq.tz Unit '(Pair 0 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpneq.tz on storage Unit and input '(Pair -1 -1)' + +assert_output $CONTRACT_PATH/assert_cmplt.tz Unit '(Pair -1 0)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmplt.tz on storage Unit and input '(Pair 0 -1)' +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmplt.tz on storage Unit and input '(Pair 0 0)' + +assert_output $CONTRACT_PATH/assert_cmple.tz Unit '(Pair 0 0)' Unit +assert_output $CONTRACT_PATH/assert_cmple.tz Unit '(Pair -1 0)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmple.tz on storage Unit and input '(Pair 0 -1)' + +assert_output $CONTRACT_PATH/assert_cmpgt.tz Unit '(Pair 0 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpgt.tz on storage Unit and input '(Pair -1 0)' +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpgt.tz on storage Unit and input '(Pair 0 0)' + +assert_output $CONTRACT_PATH/assert_cmpge.tz Unit '(Pair 0 0)' Unit +assert_output $CONTRACT_PATH/assert_cmpge.tz Unit '(Pair 0 -1)' Unit +assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpge.tz on storage Unit and input '(Pair -1 0)' + +# IF_SOME +assert_output $CONTRACT_PATH/if_some.tz Unit '(Some "hello")' '"hello"' +assert_output $CONTRACT_PATH/if_some.tz Unit 'None' '""' + +# Tests the SET_CAR and SET_CDR instructions +assert_output $CONTRACT_PATH/set_car.tz '(Pair "hello" 0)' '"world"' '(Pair "world" 0)' +assert_output $CONTRACT_PATH/set_car.tz '(Pair "hello" 0)' '"abc"' '(Pair "abc" 0)' +assert_output $CONTRACT_PATH/set_car.tz '(Pair "hello" 0)' '""' '(Pair "" 0)' + +assert_output $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 0)' '1' '(Pair "hello" 1)' +assert_output $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 500)' '3' '(Pair "hello" 3)' +assert_output $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 7)' '100' '(Pair "hello" 100)' + +# Did the given key sign the string? (key is bootstrap1) assert_output $CONTRACT_PATH/check_signature.tz \ '(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "hello")' \ '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' True