From b1b89ead4a18a5560d5124b6b690db94c0e2e4ad Mon Sep 17 00:00:00 2001 From: kxc-wraikny <115773797+kxc-wraikny@users.noreply.github.com> Date: Wed, 10 Jan 2024 18:12:09 +0900 Subject: [PATCH] Add test of Bindoj_runtime.Map_key (#408) * add qcheck-alcotest * add test of map_key * add more tests * add audit --- bindoj.opam | 1 + dune-project | 1 + src/lib_runtime/unit_test/dune | 8 ++ src/lib_runtime/unit_test/map_key.ml | 107 +++++++++++++++++++++++++++ 4 files changed, 117 insertions(+) create mode 100644 src/lib_runtime/unit_test/dune create mode 100644 src/lib_runtime/unit_test/map_key.ml diff --git a/bindoj.opam b/bindoj.opam index 7118e1f..151ac49 100644 --- a/bindoj.opam +++ b/bindoj.opam @@ -36,6 +36,7 @@ depends: [ "mdx" {with-test & >= "2.1.0"} "alcotest" {with-test} "qcheck" {with-test} + "qcheck-alcotest" {with-test} "prr" {>= "0.1.1"} "ppx_inline_test" {with-test} "lwt" {with-test} diff --git a/dune-project b/dune-project index 3977c04..7878327 100644 --- a/dune-project +++ b/dune-project @@ -41,6 +41,7 @@ (mdx (and :with-test (>= 2.1.0))) (alcotest :with-test) (qcheck :with-test) + (qcheck-alcotest :with-test) (prr (>= 0.1.1)) (ppx_inline_test :with-test) (lwt :with-test) diff --git a/src/lib_runtime/unit_test/dune b/src/lib_runtime/unit_test/dune new file mode 100644 index 0000000..ffb3fe3 --- /dev/null +++ b/src/lib_runtime/unit_test/dune @@ -0,0 +1,8 @@ +(tests + (names map_key) + (modules map_key) + (libraries + bindoj_runtime + kxclib_priv_test_lib kxclib + qcheck qcheck-alcotest alcotest) + (flags (:standard -open Kxclib))) diff --git a/src/lib_runtime/unit_test/map_key.ml b/src/lib_runtime/unit_test/map_key.ml new file mode 100644 index 0000000..6b1a5b3 --- /dev/null +++ b/src/lib_runtime/unit_test/map_key.ml @@ -0,0 +1,107 @@ +(* Copyright 2022-2023 Kotoi-Xie Consultancy, Inc. This file is a part of the + +==== Bindoj (https://kxc.dev/bindoj) ==== + +software project that is developed, maintained, and distributed by +Kotoi-Xie Consultancy, Inc. (https://kxc.inc) which is also known as KXC. + +Licensed under the Apache License, Version 2.0 (the "License"); you may not +use this file except in compliance with the License. You may obtain a copy +of the License at http://www.apache.org/licenses/LICENSE-2.0. Unless required +by applicable law or agreed to in writing, software distributed under the +License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS +OF ANY KIND, either express or implied. See the License for the specific +language governing permissions and limitations under the License. + *) +(* Acknowledgements --- AnchorZ Inc. --- The current/initial version or a +significant portion of this file is developed under the funding provided by +AnchorZ Inc. to satisfy its needs in its product development workflow. + *) +open Bindoj_runtime +open Alcotest + +let map_key_values = + let open Map_key in + [ + "#str:0:", Mk_string ""; + "#str:4:hoge", Mk_string "hoge"; + "#str:6:?2E?3F", Mk_string ".?"; + "#i53p:0", Mk_int53 (Int53p.of_int 0); + "#i53p:-1", Mk_int53 (Int53p.of_int (-1)); + "#i53p:42", Mk_int53 (Int53p.of_int 42); + "#tup:0[]", Mk_tuple []; + "#strenum:3:foo", Mk_string_enum "foo"; + "#dict:0{}", Mk_dictionary []; + "#dict:3{a=#str:2:42,b=#i53p:123,c=#tup:0[]}", Mk_dictionary [ + "a", Mk_string "42"; + "b", Mk_int53 (Int53p.of_int 123); + "c", Mk_tuple []; + ]; + ] |> (fun values -> + values @ ( + values |&>> (fun (expected, value) -> + [ (sprintf "#tup:1[%s]" expected), Mk_tuple [ value ]; + (sprintf "#tup:2[%s,%s]" expected expected), Mk_tuple [ value; value ]; + ]) + ) + @ [ (sprintf "#tup:%d[%s]" + (List.length values) + (values |&> fst |> String.concat ",")), + Mk_tuple (values |&> snd); + ]) + +let encode_map_key_alcotest = + test_case "is_valid_dictionary_key" `Quick (fun () -> + map_key_values + |!> (fun (expected, value) -> + check' string + ~msg:(sprintf "encoding_map_key (expected %s)" expected) + ~expected ~actual:(Map_key.encode_map_key value) + ) + ) + +let gen_valid = + QCheck2.Gen.(string_of & oneof [ + oneofl [ '_'; '-' ]; + char_range '0' '9'; + char_range 'a' 'z'; + char_range 'A' 'Z'; + ]) + +let gen_invalid = + QCheck2.Gen.(string_size ~gen:( + oneofl & String.to_list "~`!@#$%^&*()+={}[]|\\:;\"'<>?,,./" + ) (int_range 1 100)) + +let is_valid_dictionary_key_qcheck = + let open QCheck2 in + let gen = + Gen.(oneof [ + gen_valid |> map (fun s -> `succ, s); + gen_invalid |> map (fun s -> `fail, s); + map2 (fun s1 s2 -> `fail, (s1^s2)) gen_valid gen_invalid; + ]) + in + [ Test.make ~count:2000 ~name:"Map_key.is_valid_dictionary_key" gen + ~print:(!! (function + | `succ -> sprintf "succ(%s)" + | `fail -> sprintf "fail(%s)")) + (fun (kind, value) -> + Map_key.is_valid_dictionary_key value + = (match kind with `succ -> true | `fail -> false) + ); + ] + +let () = + let () = + Log0.verbose ~modul:__FILE__ "backend: %a" Runtime_info.pp_runtime_type + Runtime_info.current_runtime_type in + Printexc.record_backtrace true; + run "bindoj_runtime map_key tests" + [ "tests of Map_key with Alcotest", [ + encode_map_key_alcotest + ]; + "tests of Map_key with Qcheck", [ + is_valid_dictionary_key_qcheck + ] |&>> (List.map QCheck_alcotest.to_alcotest); + ]