Test/Micheline: clean-up & refactor of the test suite

This commit is contained in:
Vincent Botbol 2019-02-14 15:04:16 +01:00 committed by Raphaël Proust
parent 2d0c98b2da
commit 12fd778172
3 changed files with 243 additions and 253 deletions

View File

@ -23,15 +23,49 @@
(* *) (* *)
(*****************************************************************************) (*****************************************************************************)
let fail loc expected given msg = let fail loc printer given expected msg =
Format.kasprintf Pervasives.failwith failwith
"@[@[%s]@] - @[%s@ expected: %s@ got: %s@]" "@[<v 2> On %s : %s@ @[Given:\t%a@]@ @[Expected:\t%a@]@]"
loc msg expected given loc msg printer given printer expected
let default_printer _ = "" let default_printer fmt _ = Format.fprintf fmt ""
let equal ~loc ?(eq=(=)) ?(print=default_printer) ?(msg="") x y = let equal ~loc ?(eq=(=)) ?(printer=default_printer) ?(msg="") given expected =
if not (eq x y) then fail loc (print x) (print y) msg if not (eq given expected) then
fail loc printer given expected msg
else
return_unit
let not_equal ~loc ?(eq=(=)) ?(print=default_printer) ?(msg="") x y = let not_equal ~loc ?(eq=(=)) ?(printer=default_printer) ?(msg="") given expected =
if (eq x y) then fail loc (print x) (print y) msg if eq given expected then
fail loc printer given expected msg
else
return_unit
let pp_tokens fmt tokens =
let token_value_printer fmt token_value =
Format.fprintf fmt "@[%s@]"
(let open Micheline_parser in
match token_value with
String s -> Format.sprintf "String %S" s
| Bytes s -> Format.sprintf "Bytes %S" s
| Int s -> Format.sprintf "Int %S" s
| Ident s -> Format.sprintf "Ident %S" s
| Annot s -> Format.sprintf "Annot %S" s
| Comment s -> Format.sprintf "Comment %S" s
| Eol_comment s -> Format.sprintf "Eol_comment %S" s
| Semi -> Format.sprintf "Semi"
| Open_paren -> Format.sprintf "Open_paren"
| Close_paren -> Format.sprintf "Close_paren"
| Open_brace -> Format.sprintf "Open_brace"
| Close_brace -> Format.sprintf "Close_brace"
) in
Format.fprintf fmt "%a"
(Format.pp_print_list token_value_printer)
tokens
let equal_tokens ~loc given expected =
equal ~loc ~eq:(=) ~printer:pp_tokens ~msg:"Tokens are not equal" given expected
let not_equal_tokens ~loc given expected =
not_equal ~loc ~eq:(=) ~printer:pp_tokens ~msg:"Tokens are equal" given expected

View File

@ -1,41 +1,28 @@
(executables (executables
(names test_michelson_parser) (names test_parser)
(libraries tezos-base (libraries tezos-stdlib-unix
tezos-rpc-http
tezos-shell-services
tezos-client-base
tezos-client-genesis
tezos-client-alpha
tezos-baking-alpha
tezos-client-base-unix
tezos-signer-backends
tezos-micheline tezos-micheline
alcotest-lwt) alcotest-lwt)
(flags (:standard -w -9-32 -safe-string (flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives -open Tezos_base__TzPervasives
-open Tezos_micheline -open Tezos_micheline
-open Tezos_rpc_http -open Tezos_stdlib_unix)))
-open Tezos_shell_services
-open Tezos_client_base
-open Tezos_client_genesis
-open Tezos_client_alpha
-open Tezos_baking_alpha
-open Tezos_client_base_unix)))
(alias (alias
(name buildtest) (name buildtest)
(deps test_michelson_parser.exe)) (deps test_parser.exe))
(alias (alias
(name runtest_michelson_parser) (name runtest_micheline_parser)
(action (run %{exe:test_michelson_parser.exe}))) (action (run %{exe:test_parser.exe})))
(alias (alias
(name runtest) (name runtest)
(deps (alias runtest_michelson_parser))) (deps (alias runtest_micheline_parser)))
(alias (alias
(name runtest_indent) (name runtest_indent)
(deps (glob_files *.ml{,i})) (deps (glob_files *.ml{,i}))
(action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps}))) (action
(run bash
%{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))

View File

@ -27,179 +27,160 @@
(* Token value *) (* Token value *)
(****************************************************************************) (****************************************************************************)
type test_result = let assert_tokenize ~loc given expected =
| Success match Micheline_parser.tokenize given with
| Fail
let assert_success f =
f >>=? function
| Success-> return ()
| Fail -> failwith "Fail : Bad result"
let assert_fail f =
f >>=? function
| Success -> failwith "Unexpected Success"
| _ -> return ()
let assert_tokenize_result source expected =
match Micheline_parser.tokenize source with
| tokens, [] -> | tokens, [] ->
let tokens = let tokens_got =
List.map (fun x -> x.Micheline_parser.token) tokens List.map (fun x -> x.Micheline_parser.token) tokens
in in
Assert.equal ~loc:__LOC__ tokens expected; Assert.equal_tokens ~loc tokens_got expected
return Success | _, _ -> failwith "%s - Cannot tokenize %s" loc given
| _, _ -> return Fail
let assert_not_tokenize_result source expected = let assert_tokenize_error ~loc given expected =
match Micheline_parser.tokenize source with match Micheline_parser.tokenize given with
| tokens, [] -> | tokens, [] ->
let tokens = let tokens_got =
List.map (fun x -> x.Micheline_parser.token) tokens List.map (fun x -> x.Micheline_parser.token) tokens
in in
Assert.not_equal ~loc:__LOC__ tokens expected; Assert.not_equal_tokens ~loc tokens_got expected
return Fail | _, _ -> return_unit
| _, _ -> return Success
let test_tokenize_basic () = let test_tokenize_basic () =
(* String *) (* String *)
assert_success @@ assert_tokenize_result "\"abc\"" [ String "abc" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "\"abc\"" [ String "abc" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "\"abc\t\"" [ String "abc\t" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "\"abc\t\"" [ String "abc\t" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "\"abc\b\"" [ String "abc\b" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "\"abc\b\"" [ String "abc\b" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "\"abc\\n\"" [ String "abc\n" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "\"abc\\n\"" [ String "abc\n" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "\"abc\\r\"" [ String "abc\r" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "\"abc\\r\"" [ String "abc\r" ] >>=? fun () ->
(*fail*) (*fail*)
assert_fail @@ assert_tokenize_result "\"abc\n\"" [ String "abc\n" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"abc\n\"" [ String "abc\n" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "\"abc\\\"" [ String "abc\\" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"abc\\\"" [ String "abc\\" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "\"abc\"" [ String "abc\n" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"abc\"" [ String "abc\n" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "\"abc\r\"" [ String "abc\r" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"abc\r\"" [ String "abc\r" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "abc\r" [ String "abc\r" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "abc\r" [ String "abc\r" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "\"abc\"\r" [ String "abc\r" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"abc\"\r" [ String "abc\r" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "\"abc" [ String "abc" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"abc" [ String "abc" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "abc\"" [ String "abc" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "abc\"" [ String "abc" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "\"\"\"" [ String "" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "\"\"\"" [ String "" ] >>=? fun () ->
(* Bytes *) (* Bytes *)
assert_success @@ assert_tokenize_result "0xabc" [ Bytes "0xabc" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "0xabc" [ Bytes "0xabc" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "0x" [ Bytes "0x" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "0x" [ Bytes "0x" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "0x1" [ Bytes "0x1" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "0x1" [ Bytes "0x1" ] >>=? fun () ->
(*FIXME why xabc is is not equal *) (*FIXME why xabc is is not equal *)
assert_fail @@ assert_not_tokenize_result "xabc" [ Bytes "xabc" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "xabc" [ Bytes "xabc" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "1xabc" [ Bytes "1xabc" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "1xabc" [ Bytes "1xabc" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "1c" [ Bytes "1c" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "1c" [ Bytes "1c" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "0c" [ Bytes "0c" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "0c" [ Bytes "0c" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "0xx" [ Bytes "0xx" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "0xx" [ Bytes "0xx" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "0b" [ Bytes "0b" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "0b" [ Bytes "0b" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "0xg" [ Bytes "0xg" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "0xg" [ Bytes "0xg" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "0X" [ Bytes "0X" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "0X" [ Bytes "0X" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "1x" [ Bytes "1x" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "1x" [ Bytes "1x" ] >>=? fun () ->
(* Int *) (* Int *)
assert_success @@ assert_tokenize_result "10" [ Int "10" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "10" [ Int "10" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "0" [ Int "0" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "0" [ Int "0" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "00" [ Int "00" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "00" [ Int "00" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "001" [ Int "001" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "001" [ Int "001" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "-0" [ Int "0" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "-0" [ Int "0" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "-1" [ Int "-1" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "-1" [ Int "-1" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "1" [ Int "1" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "1" [ Int "1" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "-10" [ Int "-10" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "-10" [ Int "-10" ] >>=? fun () ->
(*FIXME it is not equal*) (*FIXME it is not equal*)
assert_fail @@ assert_tokenize_result ".1000" [ Int ".1000" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ ".1000" [ Int ".1000" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "10_00" [ Int "10_00" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "10_00" [ Int "10_00" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "1,000" [ Int "1,000" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "1,000" [ Int "1,000" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "1000.000" [ Int "1000.000" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "1000.000" [ Int "1000.000" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "-0" [ Int "-0" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "-0" [ Int "-0" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "--0" [ Int "0" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "--0" [ Int "0" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "+0" [ Int "0" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "+0" [ Int "0" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "a" [ Int "a" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "a" [ Int "a" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "0a" [ Int "0a" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "0a" [ Int "0a" ] >>=? fun () ->
(* Ident *) (* Ident *)
assert_success @@ assert_tokenize_result "string" [ Ident "string" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "string" [ Ident "string" ] >>=? fun () ->
(* Annotation *) (* Annotation *)
assert_success @@ assert_tokenize_result "@my_pair" [ Annot "@my_pair" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "@my_pair" [ Annot "@my_pair" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "@@my_pair" [ Annot "@@my_pair" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "@@my_pair" [ Annot "@@my_pair" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "$t" [ Annot "$t" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "$t" [ Annot "$t" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "&t" [ Annot "&t" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "&t" [ Annot "&t" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":t" [ Annot ":t" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":t" [ Annot ":t" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":_" [ Annot ":_" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":_" [ Annot ":_" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":0" [ Annot ":0" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":0" [ Annot ":0" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":%" [ Annot ":%" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":%" [ Annot ":%" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":%%" [ Annot ":%%" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":%%" [ Annot ":%%" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":%@" [ Annot ":%@" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":%@" [ Annot ":%@" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":%@_" [ Annot ":%@_" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":%@_" [ Annot ":%@_" ] >>=? fun () ->
assert_success @@ assert_tokenize_result ":%@_0" [ Annot ":%@_0" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ ":%@_0" [ Annot ":%@_0" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "%from" [ Annot "%from" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "%from" [ Annot "%from" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "%@from" [ Annot "%@from" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "%@from" [ Annot "%@from" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "%from_a" [ Annot "%from_a" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "%from_a" [ Annot "%from_a" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "%from.a" [ Annot "%from.a" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "%from.a" [ Annot "%from.a" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "%From.a" [ Annot "%From.a" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "%From.a" [ Annot "%From.a" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "%0From.a" [ Annot "%0From.a" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "%0From.a" [ Annot "%0From.a" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "?t" [ Annot "?t" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "?t" [ Annot "?t" ] >>=? fun () ->
(*fail*) (*fail*)
assert_fail @@ assert_not_tokenize_result "??t" [ Annot "??t" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "??t" [ Annot "??t" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "&&t" [ Annot "&&t" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "&&t" [ Annot "&&t" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "$$t" [ Annot "$$t" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "$$t" [ Annot "$$t" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result "_from" [ Annot "_from" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "_from" [ Annot "_from" ] >>=? fun () ->
assert_fail @@ assert_tokenize_result ".from" [ Annot ".from" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ ".from" [ Annot ".from" ] >>=? fun () ->
(*FIXME: why these cases below are not equal? and fail and not the %@?*) (*FIXME: why these cases below are not equal? and fail and not the %@?*)
assert_fail @@ assert_not_tokenize_result "%:from" [ Annot "%:from" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "%:from" [ Annot "%:from" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "%:@from" [ Annot "%:@from" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "%:@from" [ Annot "%:@from" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "::t" [ Annot "::t" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "::t" [ Annot "::t" ] >>=? fun () ->
(* Comment *) (* Comment *)
assert_success @@ assert_tokenize_result "/*parse 1*/" [Comment "/*parse 1*/"] >>=? fun () -> assert_tokenize ~loc:__LOC__
assert_success @@ assert_tokenize_result "/*/**/*/" [Comment "/*/**/*/"] >>=? fun () ->
assert_success @@ assert_tokenize_result
"/*\"/**/\"*/" [Comment "/*\"/**/\"*/"] >>=? fun () -> "/*\"/**/\"*/" [Comment "/*\"/**/\"*/"] >>=? fun () ->
assert_success @@ assert_tokenize_result "/* /* /* */ */ */" assert_tokenize ~loc:__LOC__ "/* /* /* */ */ */" [Comment "/* /* /* */ */ */"] >>=? fun () ->
[Comment "/* /* /* */ */ */"] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "/*parse 1" [Comment "/*parse 1"] >>=? fun () ->
assert_fail @@ assert_tokenize_result "/*parse 1" [Comment "/*parse 1"] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "parse 1*/" [Comment "parse 1*/"] >>=? fun () ->
assert_fail @@ assert_tokenize_result "parse 1*/" [Comment "parse 1*/"] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "/* */*/" [Comment "/* */*/"] >>=? fun () ->
assert_fail @@ assert_tokenize_result "/* */*/" [Comment "/* */*/"] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "/*/* */" [Comment "/*/* */"] >>=? fun () ->
assert_fail @@ assert_tokenize_result "/*/* */" [Comment "/*/* */"] >>=? fun () ->
(* EOL *) (* EOL *)
assert_success @@ assert_tokenize_result "#Access" [ Eol_comment "#Access" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "#Access" [ Eol_comment "#Access" ] >>=? fun () ->
assert_success @@ assert_tokenize_result "##Access" [ Eol_comment "##Access" ] >>=? fun () -> assert_tokenize ~loc:__LOC__ "##Access" [ Eol_comment "##Access" ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "?Access" [ Eol_comment "?Access" ] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "?Access" [ Eol_comment "?Access" ] >>=? fun () ->
(* SKIP *) (* SKIP *)
assert_success @@ assert_tokenize_result ";" [Semi] >>=? fun () -> assert_tokenize ~loc:__LOC__ ";" [ Semi] >>=? fun () ->
assert_success @@ assert_tokenize_result "{" [Open_brace] >>=? fun () -> assert_tokenize ~loc:__LOC__ "{" [ Open_brace] >>=? fun () ->
assert_success @@ assert_tokenize_result "}" [Close_brace] >>=? fun () -> assert_tokenize ~loc:__LOC__ "}" [ Close_brace] >>=? fun () ->
assert_success @@ assert_tokenize_result "(" [Open_paren] >>=? fun () -> assert_tokenize ~loc:__LOC__ "(" [ Open_paren] >>=? fun () ->
assert_success @@ assert_tokenize_result ")" [Close_paren] >>=? fun () -> assert_tokenize ~loc:__LOC__ ")" [ Close_paren] >>=? fun () ->
(*fail*) (*fail*)
assert_fail @@ assert_not_tokenize_result "{" [Semi] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "{" [ Semi ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result ";" [Open_brace] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ ";" [ Open_brace ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "}" [Open_brace] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "}" [ Open_brace ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result "(" [Close_paren] >>=? fun () -> assert_tokenize_error ~loc:__LOC__ "(" [ Close_paren ] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result ")" [Open_paren] assert_tokenize_error ~loc:__LOC__ ")" [ Open_paren ]
(*********************) (*********************)
(* one line contract *) (* One line contracts *)
let test_one_line_contract () = let test_one_line_contract () =
assert_success @@ assert_tokenize_result "(option int)" assert_tokenize ~loc:__LOC__ "(option int)"
[Open_paren; Ident "option"; Ident "int"; Close_paren] >>=? fun () -> [Open_paren; Ident "option"; Ident "int"; Close_paren] >>=? fun () ->
assert_success @@ assert_tokenize_result "DIP {ADD}" assert_tokenize ~loc:__LOC__ "DIP {ADD}"
[Ident "DIP"; Open_brace; Ident "ADD"; Close_brace] >>=? fun () -> [Ident "DIP"; Open_brace; Ident "ADD"; Close_brace] >>=? fun () ->
assert_success @@ assert_tokenize_result "parameter int;" assert_tokenize ~loc:__LOC__ "parameter int;"
[Ident "parameter"; Ident "int"; Semi] >>=? fun () -> [Ident "parameter"; Ident "int"; Semi] >>=? fun () ->
assert_success @@ assert_tokenize_result "PUSH string \"abc\";" assert_tokenize ~loc:__LOC__ "PUSH string \"abc\";"
[Ident "PUSH"; Ident "string"; String "abc"; Semi] >>=? fun () -> [Ident "PUSH"; Ident "string"; String "abc"; Semi] >>=? fun () ->
assert_success @@ assert_tokenize_result "DROP; SWAP" assert_tokenize ~loc:__LOC__ "DROP; SWAP"
[Ident "DROP"; Semi; Ident "SWAP"] >>=? fun () -> [Ident "DROP"; Semi; Ident "SWAP"] >>=? fun () ->
(*FIXME: these cases do not fail? *) (*FIXME: these cases do not fail? *)
assert_success @@ assert_tokenize_result "DIP {ADD" assert_tokenize ~loc:__LOC__ "DIP {ADD"
[Ident "DIP"; Open_brace; Ident "ADD"] >>=? fun () -> [Ident "DIP"; Open_brace; Ident "ADD"] >>=? fun () ->
assert_success @@ assert_tokenize_result "(option int" assert_tokenize ~loc:__LOC__ "(option int"
[Open_paren; Ident "option"; Ident "int"] >>=? fun () -> [Open_paren; Ident "option"; Ident "int"] >>=? fun () ->
assert_success @@ assert_tokenize_result "parameter int}" assert_tokenize ~loc:__LOC__ "parameter int}"
[Ident "parameter"; Ident "int"; Close_brace] >>=? fun () -> [Ident "parameter"; Ident "int"; Close_brace] >>=? fun () ->
assert_success @@ assert_tokenize_result "(option int" assert_tokenize ~loc:__LOC__ "(option int"
[Open_paren; Ident "option"; Ident "int"] [Open_paren; Ident "option"; Ident "int"]
(*********************************) (*********************************)
(* Example of condition contract *) (* Conditional contracts *)
let test_condition_contract () = let test_condition_contract () =
assert_success @@ assert_tokenize_result assert_tokenize ~loc:__LOC__
"parameter (or string (option int));\ "parameter (or string (option int));\
storage unit;\ storage unit;\
return string;\ return string;\
@ -223,104 +204,103 @@ let test_condition_contract () =
Ident "UNIT"; Semi; Ident "SWAP"; Semi; Ident "PAIR"; Close_brace Ident "UNIT"; Semi; Ident "SWAP"; Semi; Ident "PAIR"; Close_brace
] >>=? fun () -> ] >>=? fun () ->
(*FIXME: this case should fail because it is missing the close_paren?*) (*FIXME: this case should fail because it is missing the close_paren?*)
assert_success @@ assert_tokenize_result assert_tokenize ~loc:__LOC__
"parameter (or string (option int);" "parameter (or string (option int);"
[Ident "parameter"; Open_paren; Ident "or"; Ident "string"; Open_paren; [Ident "parameter"; Open_paren; Ident "or"; Ident "string"; Open_paren;
Ident "option"; Ident "int"; Close_paren; Semi] >>=? fun () -> Ident "option"; Ident "int"; Close_paren; Semi] >>=? fun () ->
assert_success @@ assert_tokenize_result assert_tokenize ~loc:__LOC__
"parameter (or)" "parameter (or)"
[Ident "parameter"; Open_paren; Ident "or"; Close_paren] >>=? fun () -> [Ident "parameter"; Open_paren; Ident "or"; Close_paren] >>=? fun () ->
assert_fail @@ assert_not_tokenize_result assert_tokenize_error ~loc:__LOC__
"parameter (or" "parameter (or"
[Ident "parameter"; Open_paren; Ident "or"; Close_paren] [Ident "parameter"; Open_paren; Ident "or"; Close_paren]
(****************************************************************************) (****************************************************************************)
(* Test parse toplevel *) (* Top-level parsing tests *)
(****************************************************************************) (****************************************************************************)
let assert_parses source expected = let assert_toplevel_parsing ~loc source expected =
match Micheline_parser.tokenize source with match Micheline_parser.tokenize source with
| _, (_::_) -> return Fail | _, (_::_) -> failwith "%s - Cannot tokenize %s" loc source
| tokens, [] -> | tokens, [] ->
match Micheline_parser.parse_toplevel tokens with match Micheline_parser.parse_toplevel tokens with
| _, (_::_) -> return Fail | _, (_::_) -> failwith "%s - Cannot parse_toplevel %s" loc source
| ast, [] -> | ast, [] ->
let ast = List.map Micheline.strip_locations ast in let ast = List.map Micheline.strip_locations ast in
let expected = List.map Micheline.strip_locations expected in let expected = List.map Micheline.strip_locations expected in
Assert.equal ~loc:__LOC__ (List.length ast) (List.length expected) ; Assert.equal ~loc (List.length ast) (List.length expected) >>=? fun () ->
List.iter2 (Assert.equal ~loc:__LOC__) ast expected; iter2_p (Assert.equal ~loc) ast expected >>=? fun () ->
return Success return_unit
let assert_not_parses source expected = let assert_toplevel_parsing_error ~loc source expected =
match Micheline_parser.tokenize source with match Micheline_parser.tokenize source with
| _, (_::_) -> return Success | _, (_::_) -> return_unit
| tokens, [] -> | tokens, [] ->
match Micheline_parser.parse_toplevel tokens with match Micheline_parser.parse_toplevel tokens with
| _, (_::_) -> return Success | _, (_::_) -> return_unit
| ast, [] -> | ast, [] ->
let ast = List.map Micheline.strip_locations ast in let ast = List.map Micheline.strip_locations ast in
let expected = List.map Micheline.strip_locations expected in let expected = List.map Micheline.strip_locations expected in
Assert.equal ~loc:__LOC__ (List.length ast) (List.length expected) ; Assert.equal ~loc (List.length ast) (List.length expected) >>=? fun () ->
List.iter2 (Assert.not_equal ~loc:__LOC__) ast expected; iter2_p (Assert.not_equal ~loc) ast expected
return Fail
let test_basic_parsing () = let test_basic_parsing () =
assert_success @@ assert_parses "parameter unit;" assert_toplevel_parsing ~loc:__LOC__ "parameter unit;"
[Prim ((), "parameter", [Prim ((), "parameter",
[Prim ((), "unit", [], [])], [Prim ((), "unit", [], [])],
[])] >>=? fun () -> [])] >>=? fun () ->
(* Sequence *) (* Sequence *)
assert_success @@ assert_parses "code {}" assert_toplevel_parsing ~loc:__LOC__ "code {}"
[Prim ((), "code", [Prim ((), "code",
[ Seq ((), [])], [])] >>=? fun () -> [ Seq ((), [])], [])] >>=? fun () ->
(* Int *) (* Int *)
assert_success @@ assert_parses "PUSH int 100" assert_toplevel_parsing ~loc:__LOC__ "PUSH int 100"
[Prim ((), "PUSH", [Prim ((), "PUSH",
[Prim ((), "int", [], []); [Prim ((), "int", [], []);
Int ((), Z.of_int 100)], Int ((), Z.of_int 100)],
[])] >>=? fun () -> [])] >>=? fun () ->
(*FIXME: this case should fail *) (*FIXME: this case should fail *)
assert_success @@ assert_parses "PUSH string 100" assert_toplevel_parsing ~loc:__LOC__ "PUSH string 100"
[Prim ((), "PUSH", [Prim ((), "PUSH",
[Prim ((), "string", [], []); [Prim ((), "string", [], []);
Int ((), Z.of_int 100)], Int ((), Z.of_int 100)],
[])] >>=? fun () -> [])] >>=? fun () ->
assert_success @@ assert_not_parses "PUSH int 100_000" assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100_000"
[Prim ((), "PUSH", [Prim ((), "PUSH",
[Prim ((), "string", [], []); [Prim ((), "string", [], []);
Int ((), Z.of_int 100_000)], Int ((), Z.of_int 100_000)],
[])] >>=? fun () -> [])] >>=? fun () ->
assert_fail @@ assert_not_parses "PUSH int 100" assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100"
[Prim ((), "PUSH", [Prim ((), "PUSH",
[Prim ((), "int", [], []); [Prim ((), "int", [], []);
Int ((), Z.of_int 1000)], Int ((), Z.of_int 1000)],
[])] >>=? fun () -> [])] >>=? fun () ->
assert_fail @@ assert_not_parses "PUSH int 100" assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100"
[Prim ((), "PUSH", [Prim ((), "PUSH",
[Prim ((), "string", [], []); [Prim ((), "string", [], []);
Int ((), Z.of_int 100)], Int ((), Z.of_int 100)],
[])] >>=? fun () -> [])] >>=? fun () ->
assert_fail @@ assert_not_parses "PUSH int \"100\"" assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int \"100\""
[Prim ((), "PUSH", [Prim ((), "PUSH",
[Prim ((), "string", [], []); [Prim ((), "string", [], []);
Int ((), Z.of_int 100)], Int ((), Z.of_int 100)],
[])] >>=? fun () -> [])] >>=? fun () ->
(* String *) (* String *)
assert_success @@ assert_parses "Pair False \"abc\"" assert_toplevel_parsing ~loc:__LOC__ "Pair False \"abc\""
[Prim ( [Prim (
(), "Pair", (), "Pair",
[Prim ( [Prim (
(), "False", [], []); (), "False", [], []);
String ((), "abc")], [] String ((), "abc")], []
)] >>=? fun () -> )] >>=? fun () ->
assert_fail @@ assert_not_parses "Pair False \"ab\"" assert_toplevel_parsing_error ~loc:__LOC__ "Pair False \"ab\""
[Prim ( [Prim (
(), "Pair", (), "Pair",
[Prim ( [Prim (
(), "False", [], []); (), "False", [], []);
String ((), "abc")], [] String ((), "abc")], []
)] >>=? fun () -> )] >>=? fun () ->
assert_fail @@ assert_parses "Pair False abc\"" assert_toplevel_parsing_error ~loc:__LOC__ "Pair False abc\""
[Prim ( [Prim (
(), "Pair", (), "Pair",
[Prim ( [Prim (
@ -328,14 +308,14 @@ let test_basic_parsing () =
String ((), "abc")], [] String ((), "abc")], []
)] >>=? fun () -> )] >>=? fun () ->
(* annotations *) (* annotations *)
assert_success @@ assert_parses "NIL @annot string; #comment\n" assert_toplevel_parsing ~loc:__LOC__ "NIL @annot string; #comment\n"
[Prim ((), "NIL", [Prim ((), "string", [], [])], ["@annot"])] >>=? fun () -> [Prim ((), "NIL", [Prim ((), "string", [], [])], ["@annot"])] >>=? fun () ->
assert_fail @@ assert_not_parses "NIL @annot string; #comment\n" assert_toplevel_parsing_error ~loc:__LOC__ "NIL @annot string; #comment\n"
[Prim ((), "NIL", [Prim ((), "string", [], [])], [])] >>=? fun () -> [Prim ((), "NIL", [Prim ((), "string", [], [])], [])] >>=? fun () ->
assert_success @@ assert_parses "IF_NONE {FAIL} {}" assert_toplevel_parsing ~loc:__LOC__ "IF_NONE {FAIL} {}"
[Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], [])]); [Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], [])]);
Seq ((), [])], [])] >>=? fun () -> Seq ((), [])], [])] >>=? fun () ->
assert_success @@ assert_parses "PUSH (map int bool) (Map (Item 100 False))" assert_toplevel_parsing ~loc:__LOC__ "PUSH (map int bool) (Map (Item 100 False))"
[Prim ((), "PUSH", [Prim ((), "map", [Prim ((), "int", [], []); [Prim ((), "PUSH", [Prim ((), "map", [Prim ((), "int", [], []);
Prim ((), "bool", [], [])], []); Prim ((), "bool", [], [])], []);
Prim ((), "Map", [Prim ((), "Item", Prim ((), "Map", [Prim ((), "Item",
@ -345,19 +325,16 @@ let test_basic_parsing () =
], []) ], [])
] ]
, [])] >>=? fun () -> , [])] >>=? fun () ->
assert_success @@ assert_parses "LAMDA @name int int {}" assert_toplevel_parsing ~loc:__LOC__ "LAMDA @name int int {}"
[Prim ((), "LAMDA", [Prim ((), "int", [], []); [Prim ((), "LAMDA", [Prim ((), "int", [], []);
Prim ((), "int", [], []); Prim ((), "int", [], []);
Seq ((), [])], ["@name"])] >>=? fun () -> Seq ((), [])], ["@name"])] >>=? fun () ->
assert_success @@ assert_parses "code {DUP @test; DROP}" assert_toplevel_parsing ~loc:__LOC__ "code {DUP @test; DROP}"
[Prim ((), "code", [Seq ((), [Prim ((), "DUP", [], ["@test"]); [Prim ((), "code", [Seq ((), [Prim ((), "DUP", [], ["@test"]);
Prim ((), "DROP", [], [])])], [])] Prim ((), "DROP", [], [])])], [])]
(*********************************)
(* Example of condition contract *)
let test_condition_contract_parsing () = let test_condition_contract_parsing () =
assert_success @@ assert_parses "parameter unit;\ assert_toplevel_parsing ~loc:__LOC__ "parameter unit;\
return unit;\ return unit;\
storage tez; #How much you have to send me \n\ storage tez; #How much you have to send me \n\
code {CDR; DUP;\ code {CDR; DUP;\
@ -377,10 +354,8 @@ let test_condition_contract_parsing () =
[]) [])
] ]
(* Example of append list *)
let test_list_append_parsing () = let test_list_append_parsing () =
assert_success @@ assert_parses "parameter (pair (list int)(list int));\ assert_toplevel_parsing ~loc:__LOC__ "parameter (pair (list int)(list int));\
return (list int);\ return (list int);\
storage unit;\ storage unit;\
code { CAR; DUP; DIP{CDR}; CAR;\ code { CAR; DUP; DIP{CDR}; CAR;\
@ -438,57 +413,51 @@ let test_list_append_parsing () =
])], [])] ])], [])]
(****************************************************************************) (****************************************************************************)
(* Test parse expression *) (* Expression parsing tests *)
(****************************************************************************) (****************************************************************************)
let assert_parses_expression source expected = let assert_expression_parsing ~loc source expected =
match Micheline_parser.tokenize source with match Micheline_parser.tokenize source with
| _, (_ :: _) -> return Fail | _, (_::_) -> failwith "%s - Cannot tokenize %s" loc source
| tokens, [] -> | tokens, [] ->
match Micheline_parser.parse_expression tokens with match Micheline_parser.parse_expression tokens with
| _, (_ :: _) -> return Fail | _, (_::_) -> failwith "%s - Cannot parse_expression %s" loc source
| ast, [] -> | ast, [] ->
let ast = Micheline.strip_locations ast in let ast = Micheline.strip_locations ast in
let expected = Micheline.strip_locations expected in let expected = Micheline.strip_locations expected in
Assert.equal ~loc:__LOC__ ast expected; Assert.equal ~loc ast expected
return Success
let test_parses_expression () = let test_parses_expression () =
(* String *) (* String *)
assert_success @@ assert_parses_expression "Pair False \"abc\"" assert_expression_parsing ~loc:__LOC__ "Pair False \"abc\""
(Prim ((), "Pair", [Prim ((), "False", [], []); (Prim ((), "Pair", [Prim ((), "False", [], []);
String ((), "abc")], [])) >>=? fun () -> String ((), "abc")], [])) >>=? fun () ->
(* Int *) (* Int *)
assert_success @@ assert_parses_expression "Item 100" assert_expression_parsing ~loc:__LOC__ "Item 100"
(Prim ((), "Item", [Int ((), Z.of_int 100)], [])) >>=? fun () -> (Prim ((), "Item", [Int ((), Z.of_int 100)], [])) >>=? fun () ->
(* Sequence *) (* Sequence *)
assert_success @@ assert_parses_expression "{}" assert_expression_parsing ~loc:__LOC__ "{}"
(Seq ((), [])) (Seq ((), []))
(****************************************************************************) (****************************************************************************)
(* Test *)
(****************************************************************************)
let tests = let tests = [
[
"tokenize", (fun _ -> test_tokenize_basic ()) ; "tokenize", (fun _ -> test_tokenize_basic ()) ;
"test one line contract", (fun _ -> test_one_line_contract ()) ; "test one line contract", (fun _ -> test_one_line_contract ()) ;
"test_condition_contract", (fun _ -> test_condition_contract ()) ; "test_condition_contract", (fun _ -> test_condition_contract ()) ;
"test_basic_parsing", (fun _ -> test_basic_parsing ()) ; "test_basic_parsing", (fun _ -> test_basic_parsing ()) ;
"test_condition_contract_parsing", "test_condition_contract_parsing", (fun _ -> test_condition_contract_parsing ()) ;
(fun _ -> test_condition_contract_parsing ()) ; "test_list_append_parsing", (fun _ -> test_list_append_parsing ()) ;
"test_list_append_parsing", "test_parses_expression", (fun _ -> test_parses_expression ()) ;
(fun _ -> test_list_append_parsing ()) ; ]
"test_parses_expression",
(fun _ -> test_parses_expression ()) ;
]
let wrap (n, f) = let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () -> Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function f () >>= function
| Ok () -> Lwt.return_unit | Ok () -> Lwt.return_unit
| Error error -> | Error err ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error Tezos_stdlib_unix.Logging_unix.close () >>= fun () ->
Lwt.fail_with (Format.asprintf "%a" pp_print_error err)
end end
let () = let () =