balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: tests for new parser and macro expander

Browse Source
This commit is contained in:
Milo Davis 2017-08-24 15:29:43 +02:00 committed by Benjamin Canou
parent f50a37e6f4
commit abee4a8e52
22 changed files with 649 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
src/client/embedded/alpha/michelson_macros.ml
View File

@ -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 ]

6
src/client/embedded/alpha/michelson_macros.mli
View File

@ -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

56
src/proto/alpha/docs/language.md
View File

@ -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
----------------------

4
test/contracts/assert.tz Normal file
View File

@ -0,0 +1,4 @@
parameter bool;
storage unit;
return unit;
code {CAR; ASSERT; UNIT; UNIT; PAIR}

4
test/contracts/assert_cmpeq.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; DUP; PAIR}

4
test/contracts/assert_cmpge.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; DUP; PAIR}

4
test/contracts/assert_cmpgt.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; DUP; PAIR}

4
test/contracts/assert_cmple.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; DUP; PAIR}

4
test/contracts/assert_cmplt.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; DUP; PAIR}

4
test/contracts/assert_cmpneq.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; DUP; PAIR}

4
test/contracts/assert_eq.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; DUP; PAIR}

4
test/contracts/assert_ge.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; DUP; PAIR}

4
test/contracts/assert_gt.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; DUP; PAIR}

4
test/contracts/assert_le.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; DUP; PAIR}

4
test/contracts/assert_lt.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; DUP; PAIR}

4
test/contracts/assert_neq.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (pair int int);
storage unit;
return unit;
code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; DUP; PAIR}

4
test/contracts/if_some.tz Normal file
View File

@ -0,0 +1,4 @@
parameter (option string);
return string;
storage unit;
code { CAR; IF_SOME {} {PUSH string ""}; UNIT; SWAP; PAIR}

4
test/contracts/set_car.tz Normal file
View File

@ -0,0 +1,4 @@
parameter string;
storage (pair string nat);
return (pair string nat);
code {DUP; CDR; DIP{CAR}; SET_CAR; DUP; PAIR};

4
test/contracts/set_cdr.tz Normal file
View File

@ -0,0 +1,4 @@
parameter nat;
storage (pair string nat);
return (pair string nat);
code {DUP; CDR; DIP{CAR}; SET_CDR; DUP; PAIR};

18
test/proto_alpha/Makefile
View File

@ -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

316
test/proto_alpha/test_michelson_parser.ml Normal file
View File

@ -0,0 +1,316 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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) ];

71
test/test_contracts.sh
View File

@ -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