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

Michelson: make parsing tests compile again

Browse Source
This commit is contained in:
Benjamin Canou 2017-12-08 10:16:20 +01:00 committed by Benjamin Canou
parent fe04a872df
commit bf276fb017
4 changed files with 327 additions and 284 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lib_embedded_client_alpha/michelson_v1_parser.ml
View File

@ -91,3 +91,6 @@ let parse_expression ?check source =
let tokens, lexing_errors = Micheline_parser.tokenize source in let tokens, lexing_errors = Micheline_parser.tokenize source in
let ast, parsing_errors = Micheline_parser.parse_expression ?check tokens in let ast, parsing_errors = Micheline_parser.parse_expression ?check tokens in
expand_all source ast (lexing_errors @ parsing_errors) expand_all source ast (lexing_errors @ parsing_errors)
let expand_all ~source ~original =
expand_all source original []

1
lib_embedded_client_alpha/michelson_v1_parser.mli
View File

@ -29,3 +29,4 @@ type parsed =
val parse_toplevel : ?check:bool -> string -> parsed Micheline_parser.parsing_result val parse_toplevel : ?check:bool -> string -> parsed Micheline_parser.parsing_result
val parse_expression : ?check:bool -> string -> parsed Micheline_parser.parsing_result val parse_expression : ?check:bool -> string -> parsed Micheline_parser.parsing_result
val expand_all : source:string -> original:Micheline_parser.node -> parsed Micheline_parser.parsing_result

9
test/proto_alpha/jbuild
View File

@ -2,7 +2,7 @@
(executables (executables
((names (test_endorsement ((names (test_endorsement
;; test_michelson_parser test_michelson_parser
test_origination test_origination
test_transaction test_transaction
test_vote)) test_vote))
@ -23,7 +23,7 @@
(alias (alias
((name buildtest) ((name buildtest)
(deps (test_endorsement.exe (deps (test_endorsement.exe
;; test_michelson_parser.exe test_michelson_parser.exe
test_origination.exe test_origination.exe
test_transaction.exe test_transaction.exe
test_vote.exe)))) test_vote.exe))))
@ -34,6 +34,10 @@
(locks (/tcp-port/18100)) (locks (/tcp-port/18100))
(action (chdir ${ROOT} (run ${exe:test_endorsement.exe} ${bin:tezos-node}))))) (action (chdir ${ROOT} (run ${exe:test_endorsement.exe} ${bin:tezos-node})))))
(alias
((name runtest_michelson_parser)
(action (run ${exe:test_michelson_parser.exe}))))
(alias (alias
((name runtest_origination) ((name runtest_origination)
(deps (sandbox.json)) (deps (sandbox.json))
@ -55,6 +59,7 @@
(alias (alias
((name runtest) ((name runtest)
(deps ((alias runtest_endorsement) (deps ((alias runtest_endorsement)
(alias runtest_michelson_parser)
(alias runtest_origination) (alias runtest_origination)
(alias runtest_transaction) (alias runtest_transaction)
(alias runtest_vote))))) (alias runtest_vote)))))

332
test/proto_alpha/test_michelson_parser.ml
View File

@ -7,52 +7,62 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
open Tezos_context.Script
module Helpers = Proto_alpha_helpers module Helpers = Proto_alpha_helpers
module Assert = Helpers.Assert module Assert = Helpers.Assert
open Script_located_ir open Tezos_micheline
open Micheline
let zero_loc = { start=point_zero; let zero_loc = Micheline_parser.location_zero
stop=point_zero};;
let assert_identity f x = let prn expr =
Assert.equal expr |>
(f x) Micheline_printer.printable (fun s -> s) |>
x;; Format.asprintf "%a" Micheline_printer.print_expr
(* Test expansion *) let assert_expands original expanded =
Assert.equal (Michelson_macros.expand (Prim (zero_loc, "CAAR", [], None))) let { Michelson_v1_parser.expanded = expansion }, errors =
let source = prn (Micheline.strip_locations original) in
Michelson_v1_parser.expand_all ~source ~original in
let expanded = Micheline.strip_locations expanded in
let expansion = Michelson_v1_primitives.strings_of_prims expansion in
match errors with
| [] ->
Assert.equal ~prn expansion expanded ;
ok ()
| errors -> Error errors
let left_branch = Seq(zero_loc, [ Prim(zero_loc, "SWAP", [], None) ], None)
let right_branch = Seq(zero_loc, [ ], None)
let test_expansion () =
assert_expands (Prim (zero_loc, "CAAR", [], None))
(Seq (zero_loc, (Seq (zero_loc,
[(Prim (zero_loc, "CAR", [], None)); [(Prim (zero_loc, "CAR", [], None));
(Prim (zero_loc, "CAR", [], None)) ], (Prim (zero_loc, "CAR", [], None)) ],
None));; None)) >>? fun () ->
assert_expands (Prim (zero_loc, "CAAR", [], Some "annot"))
Assert.equal (Michelson_macros.expand (Prim (zero_loc, "CAAR", [], Some "annot")))
(Seq (zero_loc, (Seq (zero_loc,
[(Prim (zero_loc, "CAR", [], None)); [(Prim (zero_loc, "CAR", [], None));
(Prim (zero_loc, "CAR", [], Some "annot")) ], (Prim (zero_loc, "CAR", [], Some "annot")) ],
None));; None)) >>? fun () ->
let car = Prim (zero_loc, "CAR", [], Some "annot") in
assert_identity Michelson_macros.expand (Prim (zero_loc, "CAR", [], Some "annot"));; assert_expands car car >>? fun () ->
let arg = [ Seq (zero_loc, [ car ], None) ] in
assert_expands
let arg = [ Prim (zero_loc, "CAR", [], Some "annot") ] in (Prim (zero_loc, "DIP", arg, Some "new_annot"))
Assert.equal (Prim (zero_loc, "DIP", arg, Some "new_annot")) >>? fun () ->
(Michelson_macros.expand (Prim (zero_loc, "DIP", arg, Some "new_annot"))) assert_expands
(Prim (zero_loc, "DIP", arg, Some "new_annot")); (Prim (zero_loc, "DIIP", arg, None))
Assert.equal
(Michelson_macros.expand (Prim (zero_loc, "DIIP", arg, None)))
(Seq (zero_loc, (Seq (zero_loc,
[ Prim (zero_loc, "DIP", [ Prim (zero_loc, "DIP",
[ (Seq (zero_loc, [ (Seq (zero_loc,
[ Prim (zero_loc, "DIP", arg, None) ], [ Prim (zero_loc, "DIP", arg, None) ],
None)) ], None)) ],
None) ], None) ],
None)); None)) >>? fun () ->
Assert.equal assert_expands
(Michelson_macros.expand (Prim (zero_loc, "DIIIP", arg, None))) (Prim (zero_loc, "DIIIP", arg, None))
(Seq (zero_loc, (Seq (zero_loc,
[ Prim (zero_loc, "DIP", [ Prim (zero_loc, "DIP",
[ (Seq (zero_loc, [ (Seq (zero_loc,
@ -64,16 +74,14 @@ Assert.equal
None) ], None) ],
None)) ], None)) ],
None) ], None) ],
None));; None)) >>? fun () ->
assert_expands
Assert.equal (Prim (zero_loc, "DUUP", [], None))
(Michelson_macros.expand (Prim (zero_loc, "DUUP", [], None)))
(Seq (zero_loc, (Seq (zero_loc,
[ Prim (zero_loc, "DIP", [ Seq (zero_loc, [ Prim (zero_loc, "DUP", [], None) ], None) ], None) ; [ Prim (zero_loc, "DIP", [ Seq (zero_loc, [ Prim (zero_loc, "DUP", [], None) ], None) ], None) ;
Prim (zero_loc, "SWAP", [], None) ], None));; Prim (zero_loc, "SWAP", [], None) ], None)) >>? fun () ->
assert_expands
Assert.equal (Prim (zero_loc, "DUUUP", [], None))
(Michelson_macros.expand (Prim (zero_loc, "DUUUP", [], None)))
(Seq (zero_loc, (Seq (zero_loc,
[ Prim (zero_loc, "DIP", [ Prim (zero_loc, "DIP",
[ Seq (zero_loc, [ [ Seq (zero_loc, [
@ -83,86 +91,52 @@ Assert.equal
Prim (zero_loc, "SWAP", [], None) ], Prim (zero_loc, "SWAP", [], None) ],
None) ], None) ],
None) ; None) ;
Prim (zero_loc, "SWAP", [], None) ], None));; Prim (zero_loc, "SWAP", [], None) ], None)) >>? fun () ->
let assert_compare_macro prim_name compare_name = let assert_compare_macro prim_name compare_name =
Assert.equal assert_expands
(Michelson_macros.expand (Prim (zero_loc, prim_name, [], None))) (Prim (zero_loc, prim_name, [], None))
(Seq (zero_loc, (Seq (zero_loc,
[ Prim (zero_loc, "COMPARE", [], None) ; [ Prim (zero_loc, "COMPARE", [], None) ;
Prim (zero_loc, compare_name, [], None) ], None));; Prim (zero_loc, compare_name, [], None) ], None)) in
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 = let assert_compare_if_macro prim_name compare_name =
Assert.equal assert_expands
(Michelson_macros.expand (Prim (zero_loc, (Prim (zero_loc, prim_name,
prim_name,
[ left_branch ; right_branch ], [ left_branch ; right_branch ],
None))) None))
(Seq (zero_loc, [ Prim(zero_loc, "COMPARE", [], None); (Seq (zero_loc, [ Prim(zero_loc, "COMPARE", [], None);
Prim(zero_loc, compare_name, [], None); Prim(zero_loc, compare_name, [], None);
Prim (zero_loc, "IF", [ left_branch ; right_branch ], None) ], None)) in Prim (zero_loc, "IF", [ left_branch ; right_branch ], None) ], None)) in
assert_compare_macro "CMPEQ" "EQ" >>? fun () ->
assert_compare_macro "CMPEQ" "EQ"; assert_compare_macro "CMPNEQ" "NEQ" >>? fun () ->
assert_compare_macro "CMPNEQ" "NEQ"; assert_compare_macro "CMPLT" "LT" >>? fun () ->
assert_compare_macro "CMPLT" "LT"; assert_compare_macro "CMPLE" "LE" >>? fun () ->
assert_compare_macro "CMPLE" "LE"; assert_compare_macro "CMPGT" "GT" >>? fun () ->
assert_compare_macro "CMPGT" "GT"; assert_compare_macro "CMPGE" "GE" >>? fun () ->
assert_compare_macro "CMPGE" "GE"; assert_compare_if_macro "IFCMPEQ" "EQ" >>? fun () ->
assert_compare_if_macro "IFCMPNEQ" "NEQ" >>? fun () ->
assert_compare_if_macro "IFCMPEQ" "EQ"; assert_compare_if_macro "IFCMPLT" "LT" >>? fun () ->
assert_compare_if_macro "IFCMPNEQ" "NEQ"; assert_compare_if_macro "IFCMPLE" "LE" >>? fun () ->
assert_compare_if_macro "IFCMPLT" "LT"; assert_compare_if_macro "IFCMPGT" "GT" >>? fun () ->
assert_compare_if_macro "IFCMPLE" "LE"; assert_compare_if_macro "IFCMPGE" "GE" >>? fun () ->
assert_compare_if_macro "IFCMPGT" "GT"; assert_expands (Prim (zero_loc, "ASSERT_LEFT", [], None))
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, [ Prim (zero_loc, "IF_LEFT",
[ Seq (zero_loc, [ ], None) ; [ Seq (zero_loc, [ ], None) ;
Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ], Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ],
None) ], None)); None) ], None)) >>? fun () ->
Assert.equal (Michelson_macros.expand (Prim (zero_loc, "ASSERT_RIGHT", [], None))) assert_expands (Prim (zero_loc, "ASSERT_RIGHT", [], None))
(Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT",
[ Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ; [ Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ;
Seq (zero_loc, [ ], None) ], Seq (zero_loc, [ ], None) ],
None) ], None)); None) ], None)) >>? fun () ->
Assert.equal (Michelson_macros.expand (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch ], None))) assert_expands (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch ], None))
(Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", [ right_branch ; left_branch ], None) ], None)); (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", [ right_branch ; left_branch ], None) ], None)) >>? fun () ->
Assert.equal (Michelson_macros.expand (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch ], None))) assert_expands (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch ], None))
(Seq (zero_loc, [ Prim (zero_loc, "IF_NONE", [ right_branch ; left_branch ], None) ], None));; (Seq (zero_loc, [ Prim (zero_loc, "IF_NONE", [ right_branch ; left_branch ], None) ], None)) >>? fun () ->
assert_expands
(Prim (zero_loc, "PAIR", [], None))
assert_identity Michelson_macros.expand (Prim (zero_loc, "PAIR", [], None));; (Prim (zero_loc, "PAIR", [], None)) >>? fun () ->
assert_expands
let expand_unexpand x = (Prim (zero_loc, "PAAIR", [], None))
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, (Seq (zero_loc,
[Prim [Prim
(zero_loc, (zero_loc,
@ -171,9 +145,9 @@ Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIR", [], None)))
(zero_loc, "PAIR", [], None)], (zero_loc, "PAIR", [], None)],
None)], None)],
None)], None)],
None));; None)) >>? fun () ->
assert_expands
Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIAIR", [], None))) (Prim (zero_loc, "PAAIAIR", [], None))
(Seq (zero_loc, [Prim (Seq (zero_loc, [Prim
(zero_loc, (zero_loc,
"DIP", "DIP",
@ -187,60 +161,110 @@ Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIAIR", [], None)))
Prim Prim
(zero_loc, (zero_loc,
"PAIR", [], None)], "PAIR", [], None)],
None));; None))
open Michelson_parser;; let assert_unexpansion_consistent original =
let { Michelson_v1_parser.expanded }, errors =
let source = prn (Micheline.strip_locations original) in
Michelson_v1_parser.expand_all ~source ~original in
match errors with
| _ :: _ -> Error errors
| [] ->
let { Michelson_v1_parser.unexpanded } =
Michelson_v1_printer.unparse_expression expanded in
Assert.equal ~prn unexpanded (Micheline.strip_locations original) ;
ok ()
let get_tokens = let test_unexpansion_consistency () =
List.map (fun x -> x.token);; assert_unexpansion_consistent (Prim (zero_loc, "PAAAIAIR", [], None)) >>? fun () ->
assert_unexpansion_consistent
(Prim (zero_loc, "DIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], None) ], None) ], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "SET_CAR", [], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "SET_CDR", [], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "DUP", [], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "DUUP", [], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "DUUUP", [], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "DUUUUP", [], None)) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "DUUUUUP", [], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "int") assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_EQ", [], None)) >>? fun () ->
[ (Ident "int") ]; assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_NEQ", [], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "100") assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_LT", [], None)) >>? fun () ->
[ (Int "100") ]; assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_LE", [], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "(option int)") assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_GT", [], None)) >>? fun () ->
[ Open_paren ; Ident "option" ; Ident "int" ; Close_paren ]; assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_GE", [], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "DIP { ADD }") assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_NONE", [], None)) >>? fun () ->
[ Ident "DIP" ; Open_brace ; Ident "ADD" ; Close_brace ]; assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_SOME", [], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "\"hello\"") assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_LEFT", [], None)) >>? fun () ->
[ String "hello" ]; assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_RIGHT", [], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "parameter int;")
[ Ident "parameter" ; Ident "int" ; Semi ]; assert_unexpansion_consistent (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch], None)) >>? fun () ->
Assert.equal (get_tokens @@ tokenize @@ "PUSH string \"abcd\";") assert_unexpansion_consistent (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch], None))
[ Ident "PUSH" ; Ident "string" ; String "abcd" ; Semi ];
Assert.equal (get_tokens @@ tokenize @@ "DROP; SWAP") let test_lexing () =
[ Ident "DROP" ; Semi ; Ident "SWAP" ]; let open Micheline_parser in
Assert.equal (get_tokens @@ tokenize @@ "string") let assert_tokenize_result source expected =
match tokenize source with
| tokens, [] ->
let tokens =
List.map (fun x -> x.token) tokens in
Assert.equal tokens expected ;
ok ()
| _, errors -> Error errors in
assert_tokenize_result "int"
[ (Ident "int") ] >>? fun () ->
assert_tokenize_result "100"
[ (Int "100") ] >>? fun () ->
assert_tokenize_result "(option int)"
[ Open_paren ; Ident "option" ; Ident "int" ; Close_paren ] >>? fun () ->
assert_tokenize_result "DIP { ADD }"
[ Ident "DIP" ; Open_brace ; Ident "ADD" ; Close_brace ] >>? fun () ->
assert_tokenize_result "\"hello\""
[ String "hello" ] >>? fun () ->
assert_tokenize_result "parameter int;"
[ Ident "parameter" ; Ident "int" ; Semi ] >>? fun () ->
assert_tokenize_result "PUSH string \"abcd\";"
[ Ident "PUSH" ; Ident "string" ; String "abcd" ; Semi ] >>? fun () ->
assert_tokenize_result "DROP; SWAP"
[ Ident "DROP" ; Semi ; Ident "SWAP" ] >>? fun () ->
assert_tokenize_result "string"
[ Ident "string" ] [ Ident "string" ]
let test_parsing () =
let parse_expr_no_locs str = let assert_parses source expected =
List.map strip_locations let open Micheline_parser in
Michelson_parser.(parse_toplevel (tokenize str)) match tokenize source with
| _, (_ :: _ as errors) -> Error errors
let assert_parses str parsed = | tokens, [] ->
Assert.equal (parse_expr_no_locs str) parsed;; match Micheline_parser.parse_toplevel tokens with
| _, (_ :: _ as errors) -> Error errors
| ast, [] ->
let ast = List.map Micheline.strip_locations ast in
let expected = List.map Micheline.strip_locations expected in
Assert.equal (List.length ast) (List.length expected) ;
List.iter2 (Assert.equal ~prn) ast expected ;
ok () in
assert_parses "PUSH int 100" assert_parses "PUSH int 100"
[ (Prim ((), "PUSH", [ Prim ((), "int", [], None) ; [ (Prim ((), "PUSH", [ Prim ((), "int", [], None) ;
Int ((), "100") ], None)) ]; Int ((), "100") ], None)) ] >>? fun () ->
assert_parses "DROP" [ (Prim ((), "DROP", [], None)) ]; assert_parses "DROP" [ (Prim ((), "DROP", [], None)) ] >>? fun () ->
assert_parses "DIP{DROP}" assert_parses "DIP{DROP}"
[ Prim ((), "DIP", [ Seq((), [ Prim ((), "DROP", [], None) ], None) ], None) ]; [ Prim ((), "DIP", [ Seq((), [ Prim ((), "DROP", [], None) ], None) ], None) ] >>? fun () ->
assert_parses "LAMBDA int int {}" assert_parses "LAMBDA int int {}"
[ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ; [ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ;
Prim ((), "int", [], None) ; Prim ((), "int", [], None) ;
Seq ((), [ ], None) ], None) ]; Seq ((), [ ], None) ], None) ] >>? fun () ->
assert_parses "LAMBDA @name int int {}" assert_parses "LAMBDA @name int int {}"
[ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ; [ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ;
Prim ((), "int", [], None) ; Prim ((), "int", [], None) ;
Seq ((), [ ], None) ], Some "@name") ]; Seq ((), [ ], None) ], Some "@name") ] >>? fun () ->
assert_parses "NIL @annot string; # comment\n" assert_parses "NIL @annot string; # comment\n"
[ Prim ((), "NIL", [ Prim ((), "string", [], None) ], Some "@annot") ]; [ Prim ((), "NIL", [ Prim ((), "string", [], None) ], Some "@annot") ] >>? fun () ->
assert_parses "PUSH (pair bool string) (Pair False \"abc\")" assert_parses "PUSH (pair bool string) (Pair False \"abc\")"
[ Prim ((), "PUSH", [ Prim ((), "pair", [ Prim ((), "PUSH", [ Prim ((), "pair",
@ -248,7 +272,7 @@ assert_parses "PUSH (pair bool string) (Pair False \"abc\")"
Prim ((), "string", [], None) ], None) ; Prim ((), "string", [], None) ], None) ;
Prim ((), "Pair", Prim ((), "Pair",
[ Prim ((), "False", [], None) ; [ Prim ((), "False", [], None) ;
String ((), "abc")], None) ], None) ]; String ((), "abc")], None) ], None) ] >>? fun () ->
assert_parses "PUSH (list nat) (List 1 2 3)" assert_parses "PUSH (list nat) (List 1 2 3)"
[ Prim ((), "PUSH", [ Prim ((), "list", [ Prim ((), "PUSH", [ Prim ((), "list",
[ Prim ((), "nat", [], None) ], None) ; [ Prim ((), "nat", [], None) ], None) ;
@ -256,17 +280,17 @@ assert_parses "PUSH (list nat) (List 1 2 3)"
[ Int((), "1"); [ Int((), "1");
Int ((), "2"); Int ((), "2");
Int ((), "3")], Int ((), "3")],
None) ], None) ]; None) ], None) ] >>? fun () ->
assert_parses "PUSH (lambda nat nat) {}" assert_parses "PUSH (lambda nat nat) {}"
[ Prim ((), "PUSH", [ Prim ((), "lambda", [ Prim ((), "PUSH", [ Prim ((), "lambda",
[ Prim ((), "nat", [], None); [ Prim ((), "nat", [], None);
Prim ((), "nat", [], None)], None) ; Prim ((), "nat", [], None)], None) ;
Seq((), [], None)], Seq((), [], None)],
None) ]; None) ] >>? fun () ->
assert_parses "PUSH key \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\"" assert_parses "PUSH key \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\""
[ Prim ((), "PUSH", [ Prim ((), "key", [], None) ; [ Prim ((), "PUSH", [ Prim ((), "key", [], None) ;
String ((),"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ], String ((),"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ],
None) ]; None) ] >>? fun () ->
assert_parses "PUSH (map int bool) (Map (Item 100 False))" assert_parses "PUSH (map int bool) (Map (Item 100 False))"
[ Prim ((), "PUSH", [ Prim ((), "map", [ Prim ((), "PUSH", [ Prim ((), "map",
[ Prim((), "int", [], None); [ Prim((), "int", [], None);
@ -275,7 +299,7 @@ assert_parses "PUSH (map int bool) (Map (Item 100 False))"
[Prim ((), "Item", [Prim ((), "Item",
[Int ((), "100"); [Int ((), "100");
Prim ((), "False", [], None)], None)], None) ], Prim ((), "False", [], None)], None)], None) ],
None) ]; None) ] >>? fun () ->
assert_parses assert_parses
"parameter int; \ "parameter int; \
return int; \ return int; \
@ -284,7 +308,7 @@ storage unit; \
[ Prim ((), "parameter", [ Prim((), "int", [], None) ], None); [ Prim ((), "parameter", [ Prim((), "int", [], None) ], None);
Prim ((), "return", [ Prim((), "int", [], None) ], None); Prim ((), "return", [ Prim((), "int", [], None) ], None);
Prim ((), "storage", [ Prim((), "unit", [], None) ], None); Prim ((), "storage", [ Prim((), "unit", [], None) ], None);
Prim ((), "code", [ Seq((), [], None) ], None)]; Prim ((), "code", [ Seq((), [], None) ], None)] >>? fun () ->
assert_parses assert_parses
"parameter int; \ "parameter int; \
storage unit; \ storage unit; \
@ -299,16 +323,26 @@ assert_parses
Prim ((), "ADD", [], None) ; Prim ((), "ADD", [], None) ;
Prim ((), "UNIT", [], None) ; Prim ((), "UNIT", [], None) ;
Prim ((), "SWAP", [], None) ; Prim ((), "SWAP", [], None) ;
Prim ((), "PAIR", [], None)], None) ], None)]; Prim ((), "PAIR", [], None)], None) ], None)] >>? fun () ->
assert_parses assert_parses
"code {DUP @test; DROP}" "code {DUP @test; DROP}"
[ Prim ((), "code", [Seq ((), [ Prim ((), "DUP", [], Some "@test"); [ Prim ((), "code", [Seq ((), [ Prim ((), "DUP", [], Some "@test");
Prim ((), "DROP", [], None)], None)], None) ]; Prim ((), "DROP", [], None)], None)], None) ] >>? fun () ->
assert_parses assert_parses
"IF {CAR} {CDR}" "IF {CAR} {CDR}"
[ Prim ((), "IF", [ Seq ((), [ Prim ((), "CAR", [], None) ], None); [ Prim ((), "IF", [ Seq ((), [ Prim ((), "CAR", [], None) ], None);
Seq ((), [ Prim ((), "CDR", [], None) ], None) ], None) ]; Seq ((), [ Prim ((), "CDR", [], None) ], None) ], None) ] >>? fun () ->
assert_parses assert_parses
"IF_NONE {FAIL} {}" "IF_NONE {FAIL} {}"
[ Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], None) ], None); [ Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], None) ], None);
Seq ((), [ ], None) ], None) ]; Seq ((), [ ], None) ], None) ]
let tests = [
"lexing", (fun _ -> Lwt.return (test_lexing ())) ;
"parsing", (fun _ -> Lwt.return (test_parsing ())) ;
"expansion", (fun _ -> Lwt.return (test_expansion ())) ;
"consistency", (fun _ -> Lwt.return (test_unexpansion_consistency ())) ;
]
let () =
Test.run "michelson." tests