pax_global_header00006660000000000000000000000064144217506710014521gustar00rootroot0000000000000052 comment=fae61520ccc87c5334b302025875fa2b4925c014 ppx_assert-0.16.0/000077500000000000000000000000001442175067100137755ustar00rootroot00000000000000ppx_assert-0.16.0/.gitignore000066400000000000000000000000411442175067100157600ustar00rootroot00000000000000_build *.install *.merlin _opam ppx_assert-0.16.0/CHANGES.md000066400000000000000000000040511442175067100153670ustar00rootroot00000000000000## v0.11 Use ppxlib instead of (now deprecated) ppx\_core, ppx\_driver and ppx\_type\_conv. ## 113.43.00 - use the new context-free API - Code created by ppx_assert used to contain the expansion of `[%here]`, which contains the number of preceding chars in the file, even though that value doesn't matter (only the line and column number matters). The consequence of this is noise when diffing .pp files, and since it's easy to avoid, let's do it. The change in the generated code looks like this: ~expect:(Some next) (next_clock_shift (find_exn "Europe/London") ~after) let expect_prev before prev = (fun ?(here= ``) -> fun ?message -> fun ?equal -> fun ~expect -> fun got -> -| let pos = -| { -| Lexing.pos_fname = "lib/core/src/zone.ml"; -| pos_lnum = 673; -| pos_cnum = 24276; -| pos_bol = 24257 -| } in +| let pos = "lib/core/src/zone.ml:673:19" in let sexpifier = sexp_of_option (function | (v0,v1) -> let v0 = Time_as_float.sexp_of_t v0 and v1 = Span.sexp_of_t v1 in Sexplib.Sexp.List `v0; v1`) in let comparator If you have many `%test_..`, the executable will contain the filename repeatedly whereas before perhaps the compiler would share it. We don't think it matters, especially given that not allocating the record probably saves some space and inline tests can be dropped at compile time. ## 113.24.00 - Update to follow evolution of `Ppx_core`. ppx_assert-0.16.0/CONTRIBUTING.md000066400000000000000000000044101442175067100162250ustar00rootroot00000000000000This repository contains open source software that is developed and maintained by [Jane Street][js]. Contributions to this project are welcome and should be submitted via GitHub pull requests. Signing contributions --------------------- We require that you sign your contributions. Your signature certifies that you wrote the patch or otherwise have the right to pass it on as an open-source patch. The rules are pretty simple: if you can certify the below (from [developercertificate.org][dco]): ``` Developer Certificate of Origin Version 1.1 Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 1 Letterman Drive Suite D4700 San Francisco, CA, 94129 Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. ``` Then you just add a line to every git commit message: ``` Signed-off-by: Joe Smith ``` Use your real name (sorry, no pseudonyms or anonymous contributions.) If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with git commit -s. [dco]: http://developercertificate.org/ [js]: https://opensource.janestreet.com/ ppx_assert-0.16.0/LICENSE.md000066400000000000000000000021461442175067100154040ustar00rootroot00000000000000The MIT License Copyright (c) 2015--2023 Jane Street Group, LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ppx_assert-0.16.0/Makefile000066400000000000000000000004031442175067100154320ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) default: dune build install: dune install $(INSTALL_ARGS) uninstall: dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: dune clean .PHONY: default install uninstall reinstall clean ppx_assert-0.16.0/README.md000066400000000000000000000052671442175067100152660ustar00rootroot00000000000000ppx\_assert =========== Extension nodes to compare value and raise useful errors if they differ. This ppx rewriter defines 3 extension nodes. `[%test_eq: typ]` in expressions -------------------------------- `[%test_eq: typ]` in expressions expands to a function of type: ```ocaml ?equal:(type -> type -> bool) -> ?here:Lexing.position list -> type -> type -> unit ``` i.e., it asserts the equality of its two anonymous arguments, using the provided equality or `[%compare: typ]` (sadly the type need to be comparable even if you provide an equality), and if they are not equal, an exception containing the value displayed by using `[%sexp_of: typ]` is thrown. The exception also contains the source code position of the extension node and the additional positions from the here parameter. The ?here parameter is meant for cases where you want additional locations, usually because the backtrace is lacking information. `[%test_result: typ]` in expressions ------------------------------------ `[%test_result: typ]` is very similar to `[%test_eq:typ]`. It has a slightly improved error message for the common case where rather than comparing two arbitrary values, you have one expected value, and one computed value. `[%test_result: typ]` expands to a function of type: ```ocaml ?here:Lexing.position list -> ?message:string -> ?equal:(type -> type -> bool) -> expect:typ -> typ -> unit ``` `[%test_pred: typ]` in expressions ---------------------------------- This one is the least useful. `[%test_pred: typ]` expands to a function of type: ```ocaml ?here:Lexing.position list -> ?message:string -> (type -> bool) -> type -> unit ``` It simply applies the given predicate to the given value, and if the predicate returns `false`, then an exception containing the value shown using `[%sexp_of: typ]` is thrown. Intended usage -------------- These assertions are very useful when testing. Compared to using `assert (x = y)`, errors display the values that are not equal. Also, there is no mechanism to remove these tests in production builds like `-noassert` does for `assert`. Compared to using the various `assert_bool` or `assert_string` functions you can find in various unit testing libraries, it works with any sexpable and comparable type for zero effort. For instance, tests commonly look like this: ```ocaml let%test_unit "List.length" = [%test_result: int] (List.length [1; 2]) ~expect:2 let%test_unit "List.tail" = [%test_result: int list] (List.tail [1; 2]) ~expect:[2] ``` However convenient these extensions are for testing, it is also possible to use these extensions even outside of test, in production code, for instance in a function that checks invariants, or when checking some form of precondition. ppx_assert-0.16.0/bench/000077500000000000000000000000001442175067100150545ustar00rootroot00000000000000ppx_assert-0.16.0/bench/dune000066400000000000000000000001621442175067100157310ustar00rootroot00000000000000(library (name ppx_assert_bench_lib) (libraries ppx_compare.runtime-lib) (preprocess (pps ppx_assert ppx_bench)))ppx_assert-0.16.0/bench/ppx_assert_bench.ml000066400000000000000000000006451442175067100207420ustar00rootroot00000000000000open Ppx_compare_lib.Builtin open Ppx_sexp_conv_lib open Ppx_sexp_conv_lib.Conv let () = Printexc.register_printer (fun exc -> match sexp_of_exn_opt exc with | None -> None | Some sexp -> Some (Sexp.to_string_hum ~indent:2 sexp)) let%bench "test_eq" = [%test_eq: int] 0 0 let%bench "test_pred" = [%test_pred: int] (fun i -> i = 0) 0 let%bench "test_result" = [%test_result: int] ~expect:0 0 ppx_assert-0.16.0/dune000066400000000000000000000000001442175067100146410ustar00rootroot00000000000000ppx_assert-0.16.0/dune-project000066400000000000000000000000201442175067100163070ustar00rootroot00000000000000(lang dune 1.10)ppx_assert-0.16.0/ppx_assert.opam000066400000000000000000000016641442175067100170520ustar00rootroot00000000000000opam-version: "2.0" version: "v0.16.0" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ppx_assert" bug-reports: "https://github.com/janestreet/ppx_assert/issues" dev-repo: "git+https://github.com/janestreet/ppx_assert.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_assert/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "4.14.0"} "base" {>= "v0.16" & < "v0.17"} "ppx_cold" {>= "v0.16" & < "v0.17"} "ppx_compare" {>= "v0.16" & < "v0.17"} "ppx_here" {>= "v0.16" & < "v0.17"} "ppx_sexp_conv" {>= "v0.16" & < "v0.17"} "dune" {>= "2.0.0"} "ppxlib" {>= "0.28.0"} ] available: arch != "arm32" & arch != "x86_32" synopsis: "Assert-like extension nodes that raise useful errors on failure" description: " Part of the Jane Street's PPX rewriters collection. " ppx_assert-0.16.0/runtime-lib/000077500000000000000000000000001442175067100162245ustar00rootroot00000000000000ppx_assert-0.16.0/runtime-lib/dune000066400000000000000000000002001442175067100170720ustar00rootroot00000000000000(library (name ppx_assert_lib) (public_name ppx_assert.runtime-lib) (libraries base) (preprocess (pps ppx_sexp_conv ppx_cold)))ppx_assert-0.16.0/runtime-lib/runtime.ml000066400000000000000000000057421442175067100202510ustar00rootroot00000000000000open Base type 'a test_pred = ?here:Lexing.position list -> ?message:string -> ('a -> bool) -> 'a -> unit type 'a test_eq = ?here:Lexing.position list -> ?message:string -> ?equal:('a -> 'a -> bool) -> 'a -> 'a -> unit type 'a test_result = ?here:Lexing.position list -> ?message:string -> ?equal:('a -> 'a -> bool) -> expect:'a -> 'a -> unit exception E of string * Sexp.t [@@deriving sexp] let exn_sexp_style ~message ~pos ~here ~tag body = let message = match message with | None -> tag | Some s -> s ^ ": " ^ tag in let sexp = Sexp.List ( body @ [ Sexp.List [ Sexp.Atom "Loc"; Sexp.Atom pos ] ] @ begin match here with | [] -> [] | _ -> [ Sexp.List [ Sexp.Atom "Stack" ; [%sexp_of: Source_code_position.t list] here ] ] end ) in (* Here and in other places we return exceptions, rather than directly raising, and instead raise at the latest moment possible, so backtrace don't include noise from these functions that construct exceptions. *) E (message, sexp) let [@cold] exn_test_pred ~message ~pos ~here ~sexpifier t = exn_sexp_style ~message ~pos ~here ~tag:"predicate failed" [ Sexp.List [Sexp.Atom "Value"; sexpifier t] ] let test_pred ~pos ~sexpifier ~here ?message predicate t = if not (predicate t) then raise (exn_test_pred ~message ~pos ~here ~sexpifier t) let r_diff : (from_:string -> to_:string -> unit) option ref = ref None let set_diff_function f = r_diff := f let [@cold] test_result_or_eq_failed ~sexpifier ~expect ~got = let got = sexpifier got in let expect = sexpifier expect in begin match !r_diff with | None -> () | Some diff -> let from_ = Sexp.to_string_hum expect in let to_ = Sexp.to_string_hum got in diff ~from_ ~to_ end; `Fail (expect, got) let test_result_or_eq ~sexpifier ~comparator ~equal ~expect ~got = let pass = match equal with | None -> comparator got expect = 0 | Some f -> f got expect in if pass then `Pass else test_result_or_eq_failed ~sexpifier ~expect ~got let [@cold] exn_test_eq ~message ~pos ~here ~t1 ~t2 = exn_sexp_style ~message ~pos ~here ~tag:"comparison failed" [ t1; Sexp.Atom "vs"; t2; ] let test_eq ~pos ~sexpifier ~comparator ~here ?message ?equal t1 t2 = match test_result_or_eq ~sexpifier ~comparator ~equal ~expect:t1 ~got:t2 with | `Pass -> () | `Fail (t1, t2) -> raise (exn_test_eq ~message ~pos ~here ~t1 ~t2) let [@cold] exn_test_result ~message ~pos ~here ~expect ~got = exn_sexp_style ~message ~pos ~here ~tag:"got unexpected result" [ Sexp.List [Sexp.Atom "expected"; expect]; Sexp.List [Sexp.Atom "got"; got]; ] let[@warning "-16"] test_result ~pos ~sexpifier ~comparator ~here ?message ?equal ~expect ~got = match test_result_or_eq ~sexpifier ~comparator ~equal ~expect ~got with | `Pass -> () | `Fail (expect, got) -> raise (exn_test_result ~message ~pos ~here ~expect ~got) ppx_assert-0.16.0/runtime-lib/runtime.mli000066400000000000000000000022401442175067100204100ustar00rootroot00000000000000open Base (** Types used in the generated code *) type 'a test_pred = ?here:Lexing.position list -> ?message:string -> ('a -> bool) -> 'a -> unit type 'a test_eq = ?here:Lexing.position list -> ?message:string -> ?equal:('a -> 'a -> bool) -> 'a -> 'a -> unit type 'a test_result = ?here:Lexing.position list -> ?message:string -> ?equal:('a -> 'a -> bool) -> expect:'a -> 'a -> unit (** Functions called by the generated code *) val test_pred : pos:string -> sexpifier:('a -> Sexp.t) -> here:Lexing.position list -> ?message:string -> ('a -> bool) -> 'a -> unit val test_eq : pos:string -> sexpifier:('a -> Sexp.t) -> comparator:('a -> 'a -> int) -> here:Lexing.position list -> ?message:string -> ?equal:('a -> 'a -> bool) -> 'a -> 'a -> unit val test_result : pos:string -> sexpifier:('a -> Sexp.t) -> comparator:('a -> 'a -> int) -> here:Lexing.position list -> ?message:string -> ?equal:('a -> 'a -> bool) -> expect:'a -> got:'a -> unit (** Called to set/unset the [diff] function, used by [test_result] *) val set_diff_function : (from_:string -> to_:string -> unit) option -> unit ppx_assert-0.16.0/src/000077500000000000000000000000001442175067100145645ustar00rootroot00000000000000ppx_assert-0.16.0/src/dune000066400000000000000000000003601442175067100154410ustar00rootroot00000000000000(library (name ppx_assert) (public_name ppx_assert) (ppx_runtime_libraries ppx_assert.runtime-lib) (kind ppx_rewriter) (libraries ppxlib ppx_sexp_conv.expander ppx_here.expander ppx_compare.expander) (preprocess (pps ppxlib.metaquot)))ppx_assert-0.16.0/src/ppx_assert.ml000066400000000000000000000042071442175067100173110ustar00rootroot00000000000000open Ppxlib let expand_test_pred ~loc:_ ~path:_ typ = let loc = { typ.ptyp_loc with loc_ghost = true } in [%expr fun ?(here= []) ?message predicate t -> let pos = [%e Ppx_here_expander.lift_position_as_string ~loc] in let sexpifier = [%e Ppx_sexp_conv_expander.Sexp_of.core_type typ] in Ppx_assert_lib.Runtime.test_pred ~pos ~sexpifier ~here ?message predicate t ] ;; let expand_test_eq ~loc:_ ~path:_ typ = let loc = { typ.ptyp_loc with loc_ghost = true } in [%expr fun ?(here= []) ?message ?equal t1 t2 -> let pos = [%e Ppx_here_expander.lift_position_as_string ~loc] in let sexpifier = [%e Ppx_sexp_conv_expander.Sexp_of.core_type typ] in let comparator = [%e Merlin_helpers.hide_expression (Ppx_compare_expander.Compare.core_type typ) ] in Ppx_assert_lib.Runtime.test_eq ~pos ~sexpifier ~comparator ~here ?message ?equal t1 t2 ] ;; let expand_test_result ~loc:_ ~path:_ typ = let loc = { typ.ptyp_loc with loc_ghost = true } in [%expr fun ?(here= []) ?message ?equal ~expect got -> let pos = [%e Ppx_here_expander.lift_position_as_string ~loc] in let sexpifier = [%e Ppx_sexp_conv_expander.Sexp_of.core_type typ] in let comparator = [%e Merlin_helpers.hide_expression (Ppx_compare_expander.Compare.core_type typ) ] in Ppx_assert_lib.Runtime.test_result ~pos ~sexpifier ~comparator ~here ?message ?equal ~expect ~got ] ;; let extensions = let declare name expand = [ Extension.declare name Extension.Context.expression Ast_pattern.(ptyp __) expand; Extension.declare name Extension.Context.core_type Ast_pattern.(ptyp __) (fun ~loc ~path:_ ty -> let loc = { loc with loc_ghost = true } in let open Ast_builder.Default in let ident = Located.lident ~loc ("Ppx_assert_lib.Runtime." ^ name) in ptyp_constr ~loc ident [ty]); ] in List.concat [ declare "test_pred" expand_test_pred ; declare "test_eq" expand_test_eq ; declare "test_result" expand_test_result ] ;; let () = Driver.register_transformation "assert" ~extensions ;; ppx_assert-0.16.0/src/ppx_assert.mli000066400000000000000000000000001442175067100174450ustar00rootroot00000000000000ppx_assert-0.16.0/test/000077500000000000000000000000001442175067100147545ustar00rootroot00000000000000ppx_assert-0.16.0/test/dune000066400000000000000000000002201442175067100156240ustar00rootroot00000000000000(library (name ppx_assert_test_lib) (libraries sexplib str) (preprocess (pps ppx_compare ppx_sexp_conv ppx_here ppx_assert ppx_inline_test)))ppx_assert-0.16.0/test/ppx_assert_test.ml000066400000000000000000000046011442175067100205360ustar00rootroot00000000000000open Ppx_compare_lib.Builtin open Ppx_sexp_conv_lib open Conv module Sexp = struct include Sexp let of_string = Sexplib.Sexp.of_string end let () = Printexc.register_printer (fun exc -> match sexp_of_exn_opt exc with | None -> None | Some sexp -> Some (Sexp.to_string_hum ~indent:2 sexp)) let re_pos = Str.regexp "[a-zA-Z0-9_/]*\\.ml:[0-9]*:[0-9]*" let hide_position_details str = Str.global_replace re_pos "F:L:C" str let test_exn exn str = let sexp_str = Sexp.of_string str in let sexp_exn = match sexp_of_exn_opt exn with | None -> assert false | Some sexp -> Sexp.of_string (hide_position_details (Sexp.to_string sexp)) in [%test_eq: Sexp.t] sexp_exn sexp_str let%test_unit _ = [%test_eq: int] 1 1 let%test _ = try [%test_eq: int * int] ~here:[[%here]] ~message:"int tuple" (5, 5) (5, 6); false with e -> test_exn e "(runtime.ml.E \"int tuple: comparison failed\" ((5 5) vs (5 6) (Loc F:L:C) (Stack (F:L:C))))"; true let%test_unit _ = [%test_result: int] (1 + 2) ~message:"size" ~expect:3 let%test _ = try [%test_result: int * int] ~here:[[%here]] (5, 5) ~expect:(5, 6); false with e -> test_exn e "(runtime.ml.E \"got unexpected result\" ((expected (5 6)) (got (5 5)) (Loc F:L:C) (Stack (F:L:C))))"; true let%test _ = try [%test_pred: float] ~message:"price" ((=) 3.) 5.; false with e -> test_exn e "(runtime.ml.E \"price: predicate failed\" ((Value 5) (Loc F:L:C)))"; true let%test_unit _ = [%test_eq: int] ~equal:(fun x y -> x mod 2 = y mod 2) 4 6 (* An example where the list of positions that <:test_eq< ... >> takes comes in handy, because the position of <:test_eq< ... >> itself is not very informative. *) let test_is_zero ~here x = [%test_eq: int] 0 x ~here:([%here] :: here) let test_odds n ~here = for i = 0 to n do let odd = 2 * i + 1 in test_is_zero ~here:([%here] :: here) (odd - odd) done let test_evens n ~here = for i = 0 to n do let even = 2 * i in test_is_zero ~here:([%here] :: here) (even - even) done let test_all n = test_odds n ~here:[[%here]]; test_evens n ~here:[[%here]] let%test_unit _ = test_all 10 let _ = ([%test_result: int] : [%test_result: int]) let _ = ([%test_eq: int] : [%test_eq: int]) let _ = ([%test_pred: int] : [%test_pred: int])