From 12fd778172cfdb1c22b6f5f580aab5e14cb532d7 Mon Sep 17 00:00:00 2001 From: Vincent Botbol Date: Thu, 14 Feb 2019 15:04:16 +0100 Subject: [PATCH] Test/Micheline: clean-up & refactor of the test suite --- src/lib_micheline/test/assert.ml | 52 ++- src/lib_micheline/test/dune | 47 +-- ...est_michelson_parser.ml => test_parser.ml} | 397 ++++++++---------- 3 files changed, 243 insertions(+), 253 deletions(-) rename src/lib_micheline/test/{test_michelson_parser.ml => test_parser.ml} (50%) diff --git a/src/lib_micheline/test/assert.ml b/src/lib_micheline/test/assert.ml index 314fba2f4..d979059a5 100644 --- a/src/lib_micheline/test/assert.ml +++ b/src/lib_micheline/test/assert.ml @@ -23,15 +23,49 @@ (* *) (*****************************************************************************) -let fail loc expected given msg = - Format.kasprintf Pervasives.failwith - "@[@[%s]@] - @[%s@ expected: %s@ got: %s@]" - loc msg expected given +let fail loc printer given expected msg = + failwith + "@[ On %s : %s@ @[Given:\t%a@]@ @[Expected:\t%a@]@]" + 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 = - if not (eq x y) then fail loc (print x) (print y) msg +let equal ~loc ?(eq=(=)) ?(printer=default_printer) ?(msg="") given expected = + 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 = - if (eq x y) then fail loc (print x) (print y) msg +let not_equal ~loc ?(eq=(=)) ?(printer=default_printer) ?(msg="") given expected = + 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 diff --git a/src/lib_micheline/test/dune b/src/lib_micheline/test/dune index c0d946f45..e4fc415a9 100644 --- a/src/lib_micheline/test/dune +++ b/src/lib_micheline/test/dune @@ -1,41 +1,28 @@ (executables - (names test_michelson_parser) - (libraries tezos-base - 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 + (names test_parser) + (libraries tezos-stdlib-unix + tezos-micheline alcotest-lwt) (flags (:standard -w -9-32 -safe-string - -open Tezos_base__TzPervasives - -open Tezos_micheline - -open Tezos_rpc_http - -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))) - + -open Tezos_base__TzPervasives + -open Tezos_micheline + -open Tezos_stdlib_unix))) (alias -(name buildtest) -(deps test_michelson_parser.exe)) + (name buildtest) + (deps test_parser.exe)) (alias -(name runtest_michelson_parser) -(action (run %{exe:test_michelson_parser.exe}))) + (name runtest_micheline_parser) + (action (run %{exe:test_parser.exe}))) (alias -(name runtest) -(deps (alias runtest_michelson_parser))) + (name runtest) + (deps (alias runtest_micheline_parser))) (alias -(name runtest_indent) -(deps (glob_files *.ml{,i})) -(action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps}))) + (name runtest_indent) + (deps (glob_files *.ml{,i})) + (action + (run bash + %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps}))) diff --git a/src/lib_micheline/test/test_michelson_parser.ml b/src/lib_micheline/test/test_parser.ml similarity index 50% rename from src/lib_micheline/test/test_michelson_parser.ml rename to src/lib_micheline/test/test_parser.ml index 6f63872ed..aaa9f07fe 100644 --- a/src/lib_micheline/test/test_michelson_parser.ml +++ b/src/lib_micheline/test/test_parser.ml @@ -27,179 +27,160 @@ (* Token value *) (****************************************************************************) -type test_result = - | Success - | 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 +let assert_tokenize ~loc given expected = + match Micheline_parser.tokenize given with | tokens, [] -> - let tokens = + let tokens_got = List.map (fun x -> x.Micheline_parser.token) tokens in - Assert.equal ~loc:__LOC__ tokens expected; - return Success - | _, _ -> return Fail + Assert.equal_tokens ~loc tokens_got expected + | _, _ -> failwith "%s - Cannot tokenize %s" loc given -let assert_not_tokenize_result source expected = - match Micheline_parser.tokenize source with +let assert_tokenize_error ~loc given expected = + match Micheline_parser.tokenize given with | tokens, [] -> - let tokens = + let tokens_got = List.map (fun x -> x.Micheline_parser.token) tokens in - Assert.not_equal ~loc:__LOC__ tokens expected; - return Fail - | _, _ -> return Success + Assert.not_equal_tokens ~loc tokens_got expected + | _, _ -> return_unit let test_tokenize_basic () = (* String *) - assert_success @@ assert_tokenize_result "\"abc\"" [ String "abc" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "\"abc\t\"" [ String "abc\t" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "\"abc\b\"" [ String "abc\b" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "\"abc\\n\"" [ String "abc\n" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "\"abc\\r\"" [ String "abc\r" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "\"abc\"" [ String "abc" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "\"abc\t\"" [ String "abc\t" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "\"abc\b\"" [ String "abc\b" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "\"abc\\n\"" [ String "abc\n" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "\"abc\\r\"" [ String "abc\r" ] >>=? fun () -> (*fail*) - assert_fail @@ assert_tokenize_result "\"abc\n\"" [ String "abc\n" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "\"abc\\\"" [ String "abc\\" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "\"abc\"" [ String "abc\n" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "\"abc\r\"" [ String "abc\r" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "abc\r" [ String "abc\r" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "\"abc\"\r" [ String "abc\r" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "\"abc" [ String "abc" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "abc\"" [ String "abc" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "\"\"\"" [ String "" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"abc\n\"" [ String "abc\n" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"abc\\\"" [ String "abc\\" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"abc\"" [ String "abc\n" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"abc\r\"" [ String "abc\r" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "abc\r" [ String "abc\r" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"abc\"\r" [ String "abc\r" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"abc" [ String "abc" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "abc\"" [ String "abc" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "\"\"\"" [ String "" ] >>=? fun () -> (* Bytes *) - assert_success @@ assert_tokenize_result "0xabc" [ Bytes "0xabc" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "0x" [ Bytes "0x" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "0x1" [ Bytes "0x1" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "0xabc" [ Bytes "0xabc" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "0x" [ Bytes "0x" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "0x1" [ Bytes "0x1" ] >>=? fun () -> (*FIXME why xabc is is not equal *) - assert_fail @@ assert_not_tokenize_result "xabc" [ Bytes "xabc" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "1xabc" [ Bytes "1xabc" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "1c" [ Bytes "1c" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "0c" [ Bytes "0c" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "0xx" [ Bytes "0xx" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "0b" [ Bytes "0b" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "0xg" [ Bytes "0xg" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "0X" [ Bytes "0X" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "1x" [ Bytes "1x" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "xabc" [ Bytes "xabc" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "1xabc" [ Bytes "1xabc" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "1c" [ Bytes "1c" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "0c" [ Bytes "0c" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "0xx" [ Bytes "0xx" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "0b" [ Bytes "0b" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "0xg" [ Bytes "0xg" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "0X" [ Bytes "0X" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "1x" [ Bytes "1x" ] >>=? fun () -> (* Int *) - assert_success @@ assert_tokenize_result "10" [ Int "10" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "0" [ Int "0" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "00" [ Int "00" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "001" [ Int "001" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "-0" [ Int "0" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "-1" [ Int "-1" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "1" [ Int "1" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "-10" [ Int "-10" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "10" [ Int "10" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "0" [ Int "0" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "00" [ Int "00" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "001" [ Int "001" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "-0" [ Int "0" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "-1" [ Int "-1" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "1" [ Int "1" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "-10" [ Int "-10" ] >>=? fun () -> (*FIXME it is not equal*) - assert_fail @@ assert_tokenize_result ".1000" [ Int ".1000" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "10_00" [ Int "10_00" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "1,000" [ Int "1,000" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "1000.000" [ Int "1000.000" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "-0" [ Int "-0" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "--0" [ Int "0" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "+0" [ Int "0" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "a" [ Int "a" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "0a" [ Int "0a" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ ".1000" [ Int ".1000" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "10_00" [ Int "10_00" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "1,000" [ Int "1,000" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "1000.000" [ Int "1000.000" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "-0" [ Int "-0" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "--0" [ Int "0" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "+0" [ Int "0" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "a" [ Int "a" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "0a" [ Int "0a" ] >>=? fun () -> (* Ident *) - assert_success @@ assert_tokenize_result "string" [ Ident "string" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "string" [ Ident "string" ] >>=? fun () -> (* Annotation *) - assert_success @@ assert_tokenize_result "@my_pair" [ Annot "@my_pair" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "@@my_pair" [ Annot "@@my_pair" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "$t" [ Annot "$t" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "&t" [ Annot "&t" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":t" [ Annot ":t" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":_" [ Annot ":_" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":0" [ Annot ":0" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":%" [ Annot ":%" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":%%" [ Annot ":%%" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":%@" [ Annot ":%@" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":%@_" [ Annot ":%@_" ] >>=? fun () -> - assert_success @@ assert_tokenize_result ":%@_0" [ Annot ":%@_0" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "%from" [ Annot "%from" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "%@from" [ Annot "%@from" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "%from_a" [ Annot "%from_a" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "%from.a" [ Annot "%from.a" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "%From.a" [ Annot "%From.a" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "%0From.a" [ Annot "%0From.a" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "?t" [ Annot "?t" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "@my_pair" [ Annot "@my_pair" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "@@my_pair" [ Annot "@@my_pair" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "$t" [ Annot "$t" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "&t" [ Annot "&t" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":t" [ Annot ":t" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":_" [ Annot ":_" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":0" [ Annot ":0" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":%" [ Annot ":%" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":%%" [ Annot ":%%" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":%@" [ Annot ":%@" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":%@_" [ Annot ":%@_" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ":%@_0" [ Annot ":%@_0" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "%from" [ Annot "%from" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "%@from" [ Annot "%@from" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "%from_a" [ Annot "%from_a" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "%from.a" [ Annot "%from.a" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "%From.a" [ Annot "%From.a" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "%0From.a" [ Annot "%0From.a" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "?t" [ Annot "?t" ] >>=? fun () -> (*fail*) - assert_fail @@ assert_not_tokenize_result "??t" [ Annot "??t" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "&&t" [ Annot "&&t" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "$$t" [ Annot "$$t" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result "_from" [ Annot "_from" ] >>=? fun () -> - assert_fail @@ assert_tokenize_result ".from" [ Annot ".from" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "??t" [ Annot "??t" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "&&t" [ Annot "&&t" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "$$t" [ Annot "$$t" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "_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 %@?*) - assert_fail @@ assert_not_tokenize_result "%:from" [ Annot "%:from" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "%:@from" [ Annot "%:@from" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "::t" [ Annot "::t" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "%:from" [ Annot "%:from" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "%:@from" [ Annot "%:@from" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "::t" [ Annot "::t" ] >>=? fun () -> (* Comment *) - assert_success @@ assert_tokenize_result "/*parse 1*/" [Comment "/*parse 1*/"] >>=? fun () -> - assert_success @@ assert_tokenize_result "/*/**/*/" [Comment "/*/**/*/"] >>=? fun () -> - assert_success @@ assert_tokenize_result + assert_tokenize ~loc:__LOC__ "/*\"/**/\"*/" [Comment "/*\"/**/\"*/"] >>=? fun () -> - assert_success @@ assert_tokenize_result "/* /* /* */ */ */" - [Comment "/* /* /* */ */ */"] >>=? fun () -> - assert_fail @@ assert_tokenize_result "/*parse 1" [Comment "/*parse 1"] >>=? fun () -> - assert_fail @@ assert_tokenize_result "parse 1*/" [Comment "parse 1*/"] >>=? fun () -> - assert_fail @@ assert_tokenize_result "/* */*/" [Comment "/* */*/"] >>=? fun () -> - assert_fail @@ assert_tokenize_result "/*/* */" [Comment "/*/* */"] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "/* /* /* */ */ */" [Comment "/* /* /* */ */ */"] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "/*parse 1" [Comment "/*parse 1"] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "parse 1*/" [Comment "parse 1*/"] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "/* */*/" [Comment "/* */*/"] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "/*/* */" [Comment "/*/* */"] >>=? fun () -> (* EOL *) - assert_success @@ assert_tokenize_result "#Access" [ Eol_comment "#Access" ] >>=? fun () -> - assert_success @@ assert_tokenize_result "##Access" [ Eol_comment "##Access" ] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "?Access" [ Eol_comment "?Access" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "#Access" [ Eol_comment "#Access" ] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "##Access" [ Eol_comment "##Access" ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "?Access" [ Eol_comment "?Access" ] >>=? fun () -> (* SKIP *) - assert_success @@ assert_tokenize_result ";" [Semi] >>=? fun () -> - assert_success @@ assert_tokenize_result "{" [Open_brace] >>=? fun () -> - assert_success @@ assert_tokenize_result "}" [Close_brace] >>=? fun () -> - assert_success @@ assert_tokenize_result "(" [Open_paren] >>=? fun () -> - assert_success @@ assert_tokenize_result ")" [Close_paren] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ";" [ Semi] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "{" [ Open_brace] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "}" [ Close_brace] >>=? fun () -> + assert_tokenize ~loc:__LOC__ "(" [ Open_paren] >>=? fun () -> + assert_tokenize ~loc:__LOC__ ")" [ Close_paren] >>=? fun () -> (*fail*) - assert_fail @@ assert_not_tokenize_result "{" [Semi] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result ";" [Open_brace] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "}" [Open_brace] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result "(" [Close_paren] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result ")" [Open_paren] + assert_tokenize_error ~loc:__LOC__ "{" [ Semi ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ ";" [ Open_brace ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "}" [ Open_brace ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ "(" [ Close_paren ] >>=? fun () -> + assert_tokenize_error ~loc:__LOC__ ")" [ Open_paren ] (*********************) -(* one line contract *) +(* One line contracts *) 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 () -> - assert_success @@ assert_tokenize_result "DIP {ADD}" + assert_tokenize ~loc:__LOC__ "DIP {ADD}" [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 () -> - assert_success @@ assert_tokenize_result "PUSH string \"abc\";" + assert_tokenize ~loc:__LOC__ "PUSH string \"abc\";" [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 () -> (*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 () -> - assert_success @@ assert_tokenize_result "(option int" + assert_tokenize ~loc:__LOC__ "(option int" [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 () -> - assert_success @@ assert_tokenize_result "(option int" + assert_tokenize ~loc:__LOC__ "(option int" [Open_paren; Ident "option"; Ident "int"] (*********************************) -(* Example of condition contract *) +(* Conditional contracts *) let test_condition_contract () = - assert_success @@ assert_tokenize_result + assert_tokenize ~loc:__LOC__ "parameter (or string (option int));\ storage unit;\ return string;\ @@ -223,104 +204,103 @@ let test_condition_contract () = Ident "UNIT"; Semi; Ident "SWAP"; Semi; Ident "PAIR"; Close_brace ] >>=? fun () -> (*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);" [Ident "parameter"; Open_paren; Ident "or"; Ident "string"; Open_paren; Ident "option"; Ident "int"; Close_paren; Semi] >>=? fun () -> - assert_success @@ assert_tokenize_result + assert_tokenize ~loc:__LOC__ "parameter (or)" [Ident "parameter"; Open_paren; Ident "or"; Close_paren] >>=? fun () -> - assert_fail @@ assert_not_tokenize_result + assert_tokenize_error ~loc:__LOC__ "parameter (or" [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 - | _, (_::_) -> return Fail + | _, (_::_) -> failwith "%s - Cannot tokenize %s" loc source | tokens, [] -> match Micheline_parser.parse_toplevel tokens with - | _, (_::_) -> return Fail + | _, (_::_) -> failwith "%s - Cannot parse_toplevel %s" loc source | ast, [] -> let ast = List.map Micheline.strip_locations ast in let expected = List.map Micheline.strip_locations expected in - Assert.equal ~loc:__LOC__ (List.length ast) (List.length expected) ; - List.iter2 (Assert.equal ~loc:__LOC__) ast expected; - return Success + Assert.equal ~loc (List.length ast) (List.length expected) >>=? fun () -> + iter2_p (Assert.equal ~loc) ast expected >>=? fun () -> + return_unit -let assert_not_parses source expected = +let assert_toplevel_parsing_error ~loc source expected = match Micheline_parser.tokenize source with - | _, (_::_) -> return Success + | _, (_::_) -> return_unit | tokens, [] -> match Micheline_parser.parse_toplevel tokens with - | _, (_::_) -> return Success + | _, (_::_) -> return_unit | ast, [] -> let ast = List.map Micheline.strip_locations ast in let expected = List.map Micheline.strip_locations expected in - Assert.equal ~loc:__LOC__ (List.length ast) (List.length expected) ; - List.iter2 (Assert.not_equal ~loc:__LOC__) ast expected; - return Fail + Assert.equal ~loc (List.length ast) (List.length expected) >>=? fun () -> + iter2_p (Assert.not_equal ~loc) ast expected let test_basic_parsing () = - assert_success @@ assert_parses "parameter unit;" + assert_toplevel_parsing ~loc:__LOC__ "parameter unit;" [Prim ((), "parameter", [Prim ((), "unit", [], [])], [])] >>=? fun () -> (* Sequence *) - assert_success @@ assert_parses "code {}" + assert_toplevel_parsing ~loc:__LOC__ "code {}" [Prim ((), "code", [ Seq ((), [])], [])] >>=? fun () -> (* Int *) - assert_success @@ assert_parses "PUSH int 100" + assert_toplevel_parsing ~loc:__LOC__ "PUSH int 100" [Prim ((), "PUSH", [Prim ((), "int", [], []); Int ((), Z.of_int 100)], [])] >>=? fun () -> (*FIXME: this case should fail *) - assert_success @@ assert_parses "PUSH string 100" + assert_toplevel_parsing ~loc:__LOC__ "PUSH string 100" [Prim ((), "PUSH", [Prim ((), "string", [], []); Int ((), Z.of_int 100)], [])] >>=? fun () -> - assert_success @@ assert_not_parses "PUSH int 100_000" + assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100_000" [Prim ((), "PUSH", [Prim ((), "string", [], []); Int ((), Z.of_int 100_000)], [])] >>=? fun () -> - assert_fail @@ assert_not_parses "PUSH int 100" + assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100" [Prim ((), "PUSH", [Prim ((), "int", [], []); Int ((), Z.of_int 1000)], [])] >>=? fun () -> - assert_fail @@ assert_not_parses "PUSH int 100" + assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100" [Prim ((), "PUSH", [Prim ((), "string", [], []); Int ((), Z.of_int 100)], [])] >>=? fun () -> - assert_fail @@ assert_not_parses "PUSH int \"100\"" + assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int \"100\"" [Prim ((), "PUSH", [Prim ((), "string", [], []); Int ((), Z.of_int 100)], [])] >>=? fun () -> (* String *) - assert_success @@ assert_parses "Pair False \"abc\"" + assert_toplevel_parsing ~loc:__LOC__ "Pair False \"abc\"" [Prim ( (), "Pair", [Prim ( (), "False", [], []); String ((), "abc")], [] )] >>=? fun () -> - assert_fail @@ assert_not_parses "Pair False \"ab\"" + assert_toplevel_parsing_error ~loc:__LOC__ "Pair False \"ab\"" [Prim ( (), "Pair", [Prim ( (), "False", [], []); String ((), "abc")], [] )] >>=? fun () -> - assert_fail @@ assert_parses "Pair False abc\"" + assert_toplevel_parsing_error ~loc:__LOC__ "Pair False abc\"" [Prim ( (), "Pair", [Prim ( @@ -328,14 +308,14 @@ let test_basic_parsing () = String ((), "abc")], [] )] >>=? fun () -> (* 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 () -> - 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 () -> - assert_success @@ assert_parses "IF_NONE {FAIL} {}" + assert_toplevel_parsing ~loc:__LOC__ "IF_NONE {FAIL} {}" [Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], [])]); 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 ((), "bool", [], [])], []); Prim ((), "Map", [Prim ((), "Item", @@ -345,24 +325,21 @@ let test_basic_parsing () = ], []) ] , [])] >>=? fun () -> - assert_success @@ assert_parses "LAMDA @name int int {}" + assert_toplevel_parsing ~loc:__LOC__ "LAMDA @name int int {}" [Prim ((), "LAMDA", [Prim ((), "int", [], []); Prim ((), "int", [], []); 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 ((), "DROP", [], [])])], [])] -(*********************************) -(* Example of condition contract *) - let test_condition_contract_parsing () = - assert_success @@ assert_parses "parameter unit;\ - return unit;\ - storage tez; #How much you have to send me \n\ - code {CDR; DUP;\ - AMOUNT; CMPLT;\ - IF {FAIL}}" + assert_toplevel_parsing ~loc:__LOC__ "parameter unit;\ + return unit;\ + storage tez; #How much you have to send me \n\ + code {CDR; DUP;\ + AMOUNT; CMPLT;\ + IF {FAIL}}" [Prim ((), "parameter", [ Prim ((), "unit", [],[])], []); Prim ((), "return", [Prim ((), "unit", [], [])], []); Prim ((), "storage", [Prim ((), "tez", [], [])], []); @@ -377,22 +354,20 @@ let test_condition_contract_parsing () = []) ] -(* Example of append list *) - let test_list_append_parsing () = - assert_success @@ assert_parses "parameter (pair (list int)(list int));\ - return (list int);\ - storage unit;\ - code { CAR; DUP; DIP{CDR}; CAR;\ - NIL int; SWAP;\ - LAMDA (pair int (list int))\ - (list int)\ - {DUP; CAR; DIP {CDR}; CONS};\ - REDUCE;\ - LAMDA (pair int (list int))\ - (list int)\ - {DUP; CAR; DIP{CDR}; CONS};\ - UNIT; SWAP; PAIR}" + assert_toplevel_parsing ~loc:__LOC__ "parameter (pair (list int)(list int));\ + return (list int);\ + storage unit;\ + code { CAR; DUP; DIP{CDR}; CAR;\ + NIL int; SWAP;\ + LAMDA (pair int (list int))\ + (list int)\ + {DUP; CAR; DIP {CDR}; CONS};\ + REDUCE;\ + LAMDA (pair int (list int))\ + (list int)\ + {DUP; CAR; DIP{CDR}; CONS};\ + UNIT; SWAP; PAIR}" [Prim ((), "parameter", [Prim ((), "pair", [Prim ((), "list", [Prim ((), "int", [], [])], []); @@ -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 - | _, (_ :: _) -> return Fail + | _, (_::_) -> failwith "%s - Cannot tokenize %s" loc source | tokens, [] -> match Micheline_parser.parse_expression tokens with - | _, (_ :: _) -> return Fail + | _, (_::_) -> failwith "%s - Cannot parse_expression %s" loc source | ast, [] -> let ast = Micheline.strip_locations ast in let expected = Micheline.strip_locations expected in - Assert.equal ~loc:__LOC__ ast expected; - return Success + Assert.equal ~loc ast expected let test_parses_expression () = (* String *) - assert_success @@ assert_parses_expression "Pair False \"abc\"" + assert_expression_parsing ~loc:__LOC__ "Pair False \"abc\"" (Prim ((), "Pair", [Prim ((), "False", [], []); String ((), "abc")], [])) >>=? fun () -> (* Int *) - assert_success @@ assert_parses_expression "Item 100" + assert_expression_parsing ~loc:__LOC__ "Item 100" (Prim ((), "Item", [Int ((), Z.of_int 100)], [])) >>=? fun () -> (* Sequence *) - assert_success @@ assert_parses_expression "{}" + assert_expression_parsing ~loc:__LOC__ "{}" (Seq ((), [])) (****************************************************************************) -(* Test *) -(****************************************************************************) -let tests = - [ - "tokenize", (fun _ -> test_tokenize_basic ()) ; - "test one line contract", (fun _ -> test_one_line_contract ()) ; - "test_condition_contract", (fun _ -> test_condition_contract ()) ; - "test_basic_parsing", (fun _ -> test_basic_parsing ()) ; - "test_condition_contract_parsing", - (fun _ -> test_condition_contract_parsing ()) ; - "test_list_append_parsing", - (fun _ -> test_list_append_parsing ()) ; - "test_parses_expression", - (fun _ -> test_parses_expression ()) ; - ] +let tests = [ + "tokenize", (fun _ -> test_tokenize_basic ()) ; + "test one line contract", (fun _ -> test_one_line_contract ()) ; + "test_condition_contract", (fun _ -> test_condition_contract ()) ; + "test_basic_parsing", (fun _ -> test_basic_parsing ()) ; + "test_condition_contract_parsing", (fun _ -> test_condition_contract_parsing ()) ; + "test_list_append_parsing", (fun _ -> test_list_append_parsing ()) ; + "test_parses_expression", (fun _ -> test_parses_expression ()) ; +] let wrap (n, f) = Alcotest_lwt.test_case n `Quick begin fun _ () -> f () >>= function | Ok () -> Lwt.return_unit - | Error error -> - Format.kasprintf Pervasives.failwith "%a" pp_print_error error + | Error err -> + Tezos_stdlib_unix.Logging_unix.close () >>= fun () -> + Lwt.fail_with (Format.asprintf "%a" pp_print_error err) end let () =