pax_global_header00006660000000000000000000000064147032340170014513gustar00rootroot0000000000000052 comment=6bbabd513e70978a9903124dfbee2eab20b36c5d ppx_expect-0.17.2/000077500000000000000000000000001470323401700137615ustar00rootroot00000000000000ppx_expect-0.17.2/.gitignore000066400000000000000000000000411470323401700157440ustar00rootroot00000000000000_build *.install *.merlin _opam ppx_expect-0.17.2/.ocamlformat000066400000000000000000000000231470323401700162610ustar00rootroot00000000000000profile=janestreet ppx_expect-0.17.2/CHANGES.md000066400000000000000000000145421470323401700153610ustar00rootroot00000000000000## Release v0.17.0 * Enforce rules for the formatting of the strings in `[%expect]` blocks (their indentation level and the number of leading/trailing spaces) when `-expect-test-strict-indentation=true` is passed to the ppx driver. * Omit a redundant call to `Expect_test_config.run` (which was used just wrap a call to `flush` in the monadic environment). * Warn when one expect test is reached from another, even if the inner expect test would not be run (because of e.g. the `-tags` argument passed to the `inline_tests_runner`). * Flush output generated in C stubs so that it is captured together with output that originates in OCaml. * Support the shorthand syntax for extension points with string payloads (`{%expect||}`). * Print `Output i / n` in the separators printed between inconsistent outputs in an expect block reached multiple times. ## Release v0.16.0 * Made `[%expect]` blocks always have type `unit`. Removed the need for monadic flush operations. Expect tests inside concurrent frameworks like `Async` now expect output during testing to be synchronous, or manually flushed. `Async` has, for some time, used synchronous i/o for stdout and stderr when running expect tests. * Moved corrected-file generation to a library `Make_corrected_file`. This allows expect tests and other testing tools to share a method for writing out corrected files and printing out errors for corrections. ## Old pre-v0.15 changelogs (very likely stale and incomplete) ## git version - Make sure the code we generate can be typed without warning when `-principal` is passed to the compiler. ## v0.11 - Change `ppx_expect` so that when `-diff-cmd -` is passed, they write the .corrected file but don't diff it or exit with a non-zero exit code. This is to make expect tests work with jbuilder. Jbuilder uses a separate build tree, so the current behavior of `ppx_expect` doesn't work well with jbuilder, especially the in-place behavior. What is done instead in jbuilder is that after running the test runner, it checks whether a .corrected file was created. If yes, jbuilder does the diffing itself, and by default also replaces the source file by the correction.' - Regexp and glob matching in the output is now deprecated. This gets in the way of the "promote" workflow. People are instead encouraged to prefilter the output before displaying it. - Tell the build system via output metadata whether a file contains tests or not - Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver, ppx\_metaquot, ppx\_traverse and ppx\_type\_conv. ## v0.10 - In `[%expect]` expressions, disallowed backtraces, which can vary across compilation configurations (`X_LIBRARY_INLINING`, `flambda`, etc.) - Improved `ppx_expect` to support simultaneous runs of `inline_tests_runner` on the same file. - Added expect-test support for reaching a single `[%expect]` multiple times, where the test only fails if the output was distinct - For expect tests, relaxed the rule for `%expects` that are reached multiple times. Instead of requiring all outputs to be identical, require only that each output individually match the `%expect`. - In synchronous expect tests, `[%expect]` now captures stderr in addition to stdout. Previously, there was code that did this for Async expect tests. Now, stderr is captured in all expect tests. - Improved expect tests to get the current file when the test runs, rather than when it is registered. ## v0.9 ## 113.43.00 - Always flush Pervasives.stdout in the `ppx_expect` runtime. We already do this, but it was missing in one place. - Made the test framework resilient to user changing the current working directory during the test. - Print newlines in `"`-strings as real newlines, not `\n` - The expect test runtime breaks any executable that wants to work even if cwd doesn't exist, like fe does. Fix that. It also brings expect tests in line with what ppx\_inline\_test does, and removes the diff due to absolute paths I was seeing in the output of `./inline_tests_runner -log` in some other features. Concretely, here is what changes: - Use the new context-free API - Change the check in ppx\_expect to be a dynamic check. Instead of checking that expect tests appears only at toplevel, we test that they are run in the library they appear. This has several consquence: - ppx\_expect can use `Context_free` as well and doesn't require two extra passes - expect tests can appear inside let%test_module ## 113.33.01 - Add dependency on `re.emacs` ## 113.33.00 - Don't remove trailing semicolons when producing a correction. - Corrected `%expect`s with double quoted strings don't have the single space padding. - In the ppx\_expect runtime, flush stdout before redirecting it This is to avoid capturing leftover of the stdout buffer. - Make sure the expect-test runtime doesn't generate `%collector_never_triggered`, which is not accepted by ppx\_expect. Instead generate: `%expect {| DID NOT REACH THIS PROGRAM POINT |}` - Make expect tests pass the user description to the inline test runtime - Fix a race condition in the ppx\_expect runtime - Change ppx\_expect be more permissive when matching whitespace in actual output. See `ppx/ppx_expect/README.org` for details. Changes to the implementation of ppx\_expect (including some refactoring): - factorized the common bits between the runtime and ppx rewriter into one library expect_test_common - factorized different structures representing the same thing using polymorphism - communicate data structures between the ppx rewriter and runtime using a generated lifter instead of hand-written lifters - splitted the matching and correction writing code: the .corrected is now only created when needed instead of all the time - added a concrete syntax tree to represent both the actual output and expectation in non-exact mode. This allow to keep the user formatting as much as possible - made various bits more re-usable - Change the default style of multi-line expectation to: `%expect {| abc def |}` More generally, try to preserve the formatting a bit more when correcting from empty or single to multi-line. - Arrange things so that when `open Async.Std` is opened, `%expect ...` expressions are of type `unit Deferred.t` and flush stdout before capturing the output. ## 113.24.00 Initial release. ppx_expect-0.17.2/CONTRIBUTING.md000066400000000000000000000044101470323401700162110ustar00rootroot00000000000000This 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_expect-0.17.2/LICENSE.md000066400000000000000000000021461470323401700153700ustar00rootroot00000000000000The MIT License Copyright (c) 2015--2024 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_expect-0.17.2/Makefile000066400000000000000000000004031470323401700154160ustar00rootroot00000000000000INSTALL_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_expect-0.17.2/README.mdx000066400000000000000000000436331470323401700154410ustar00rootroot00000000000000expect-test - a Cram-like framework for OCaml ============================================= # Introduction Expect-test is a framework for writing tests in OCaml, similar to [Cram](https://bitheap.org/cram/). Expect-tests mimic the (now less idiomatic) [inline test](https://github.com/janestreet/ppx_inline_test) framework in providing a `let%expect_test` construct. The body of an expect-test can contain output-generating code, interleaved with `[%expect]` extension expressions to denote the expected output. When run, expect-tests pass iff the output [_matches_](#matching-behavior) the expected output. If a test fails, the `inline_tests_runner` outputs a diff and creates a file with the suffix ".corrected" containing the actual output. Here is an example expect-test in `foo.ml`: ```ocaml open! Core let%expect_test "addition" = printf "%d" (1 + 2); [%expect {| 4 |}] ;; ``` When the test runs, the `inline_tests_runner` creates `foo.ml.corrected` with contents: ```ocaml open! Core let%expect_test "addition" = printf "%d" (1 + 2); [%expect {| 3 |}] ;; ``` `inline_tests_runner` also outputs: ``` ------ foo.ml ++++++ foo.ml.corrected File "foo.ml", line 6, characters 0-1: |open! Core | |let%expect_test "addition" = | printf "%d" (1 + 2); -| [%expect {| 4 |}] +| [%expect {| 3 |}] |;; | ``` Diffs are shown in color if the `-use-color` flag is passed to the inline test runner executable. # Common usage Each `[%expect]` block matches all the output generated since the previous `[%expect]` block (or the beginning of the test). In this way, when multiple `[%expect]` blocks are interleaved with test code, they can help show which part of the test produced which output. The following test: ```ocaml let%expect_test "interleaved" = let l = [ "a"; "b"; "c" ] in printf "A list [l]\n"; printf "It has length %d\n" (List.length l); [%expect {| A list [l] |}]; List.iter l ~f:print_string; [%expect {| It has length 3 abc |}] ;; ``` is rewritten as ```ocaml let%expect_test "interleaved" = let l = [ "a"; "b"; "c" ] in printf "A list [l]\n"; printf "It has length %d\n" (List.length l); [%expect {| A list [l] It has length 3 |}]; List.iter l ~f:print_string; [%expect {| abc |}] ;; ``` When there is "trailing" output at the end of a `let%expect_test` (output that has yet to be matched by some `[%expect]` block), a new `[%expect]` block is appended to the test with the trailing output: ```ocaml let%expect_test "trailing output" = print_endline "Hello"; [%expect {| Hello |}]; print_endline "world" ;; ``` becomes: ```ocaml let%expect_test "trailing output" = print_endline "Hello"; [%expect {| Hello |}]; print_endline "world"; [%expect {| world |}] ;; ``` # Matching behavior You might have noticed that the contents of the `[%expect]` blocks are not _exactly_ the program output; in some of the examples above, they contain a different number of leading and trailing newlines, and are indented to match the code indentation. We say the contents of a block `[%expect str]` (where `str` is some string literal) _match_ the output at that block if the output, after we format it to standardize indentation and other whitespace, is identical to the contents of `str` after it has been similarly formatted . The formatting applied depends on the type of delimiter used in `str` (i.e. whether it a `"quoted string"` or a `{xxx| delimited string |xxx}`). To summarize: * Output containing only whitespace is formatted as `[%expect {| |}]` or `[%expect ""]`. * Output where only one line contains non-whitespace characters is formatted onto a single line, as `[%expect {| output |}]` or `[%expect "output"]`. * Output where multiple lines contain non-whitespace characters is formatted so that: - There is no trailing whitespace on lines with content. - The relative indentation of the lines is preserved. - In `{| delimited strings |}`, the least-indented line with content (the "left margin" of the output) is aligned to be two spaces past the indentation of the `[%expect]` block. - In `"quoted string"`, the least-indented line is indented by exactly one space (this plays the nicest with `ocamlformat`'s existing decisions about how to format string literals). - There is one empty line before and one empty line after the contents. Here is an example containing several cases of output that are subject to distinct formatting rules and how they appear in `[%expect]` and `[%expect_exact]` blocks:
Expand examples ```ocaml let%expect_test "matching behavior --- no content" = printf " "; [%expect {| |}]; printf " "; [%expect ""]; printf " "; [%expect_exact {| |}]; printf " "; [%expect_exact " "] ;; let%expect_test "matching behavior --- one line of content" = printf "\n This is one line\n\n"; [%expect {| This is one line |}]; printf "\n This is one line\n\n"; [%expect "This is one line"]; printf "\n This is one line\n\n"; [%expect_exact {| This is one line |}]; printf "\n This is one line\n\n"; [%expect_exact "\n This is one line\n\n"] ;; let%expect_test "matching behavior --- multiple lines of content" = printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect " \n\ \ Once upon a midnight dreary,\n\ \ while I pondered, weak and weary,\n\ \ Over many a quaint and curious\n\ \ volume of forgotten lore\n\ \ "]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect_exact {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect_exact "\n\ Once upon a midnight dreary,\n\ \ while I pondered, weak and weary,\n\ Over many a quaint and curious\n\ \ volume of forgotten lore "] ;; ```
Expect-test is by default permissive about this formatting, so that a `[%expect]` block that is correct modulo formatting is accepted. However, passing `-expect-test-strict-indentation=true` to the ppx driver makes the test runner issue corrections for blocks that do not satisfy the indentation rules. For example, the following: ```ocaml let%expect_test "bad formatting" = printf "a\n b"; [%expect {| a b |}] ;; ``` is corrected to: ```ocaml let%expect_test "bad formatting" = printf "a\n b"; [%expect {| a b |}] ;; ``` (to add the required indentation and trailing newline) # Reachability ## Expects reached from multiple places A `[%expect]` extension can be encountered multiple times if it is in e.g. a functor or a function: ```ocaml let%expect_test "function" = let f output = print_string output; [%expect {| hello world |}] in f "hello world"; f "hello world" ;; ``` The test passes if the `[%expect]` block matches the output each time it is encountered, as described in the section on [matching behavior](#matching-behavior). If the outputs are not consistent, then the corrected file contains a report of all of the outputs that were captured, in the order that they were captured at runtime. For example, calling `f` in the snippet above with inconsistent arguments will produce: ```ocaml let%expect_test "function" = let f output = print_string output; [%expect {| (* expect_test: Test ran multiple times with different test outputs *) ============================ Output 1 / 4 ============================ hello world ============================ Output 2 / 4 ============================ goodbye world ============================ Output 3 / 4 ============================ once upon a midnight dreary ============================ Output 4 / 4 ============================ hello world |}] in f "hello world"; f "goodbye world"; f "once upon\na midnight dreary"; f "hello world" ;; ``` ## Unreached expects Every `[%expect]` and `[%expect_exact]` block in a `let%expect_test` must be reached at least once if that test is ever run. Failure for control flow to reach a block is _not_ treated like recording empty output at a block. The extension expression `[%expect.unreachable]` is used to indicate that some part of an expect test shouldn't be reached; if control flow reaches that point anyway, the corrected file replaces the `[%expect.unreachable]` with a plain old expect containing the output collected until that point. Conversely, if control flow never reaches some `[%expect]` block, that block is turned into a `[%expect.unreachable]`. For example: ```ocaml let%expect_test "unreachable" = let interesting_bool = 3 > 5 in printf "%b\n" interesting_bool; if interesting_bool then [%expect {| true |}] else ( printf "don't reach\n"; [%expect.unreachable]) ;; ``` becomes: ```ocaml let%expect_test "unreachable" = let interesting_bool = 3 > 5 in printf "%b\n" interesting_bool; if interesting_bool then [%expect.unreachable] else ( printf "don't reach\n"; [%expect {| false don't reach |}]) ;; ``` Note that, for an expect block that is sometimes reachable and sometimes not, that block passes if the output captured at that block matches every time the block is encountered. For example, the following test passes: ```ocaml module Test (B : sig val interesting_opt : int option end) = struct let%expect_test "sometimes reachable" = match B.interesting_opt with | Some x -> printf "%d\n" x; [%expect {| 5 |}] | None -> [%expect {| |}] ;; end module _ = Test (struct let interesting_opt = Some 5 end) module _ = Test (struct let interesting_opt = None end) module _ = Test (struct let interesting_opt = Some 5 end) ``` # Exceptions When an exception is raised by the body of an expect-test, the `inline_test_runner` shows it (and, if relevant, any output generated by the test that had not yet been captured) in a `[@@expect.uncaught_exn]` attribute attached to the corresponding `let%expect_test`. `[%expect]` blocks in the test are treated according to the usual rules: those reached before the exception is raised capture output as usual, and those that "would have" been reached after are marked as unreachable: ```ocaml let%expect_test "exception" = Printexc.record_backtrace false; printf "start!"; [%expect {| |}]; let sum = 2 + 2 in if sum <> 3 then ( printf "%d" sum; failwith "nope"); printf "done!"; [%expect {| done! |}] ;; ``` becomes: ```ocaml let%expect_test "exception" = Printexc.record_backtrace false; printf "start!"; [%expect {| start! |}]; let sum = 2 + 2 in if sum <> 3 then ( printf "%d" sum; failwith "nope"); printf "done!"; [%expect.unreachable] [@@expect.uncaught_exn {| (Failure nope) Trailing output --------------- 4 |}] ;; ``` Unlike `[%expect]` blocks, which might be reached on some runs of a test and not others, a test with an `[@@expect.uncaught_exn]` attribute _must_ raise every time it is run. Changing the `None` branch of the functorized test from [before](#unreached-expects) to raise gives: ```ocaml module Test' (B : sig val interesting_opt : int option end) = struct let%expect_test "sometimes raises" = match B.interesting_opt with | Some x -> printf "%d\n" x; [%expect {| 5 |}] | None -> failwith "got none!" [@@expect.uncaught_exn {| (* expect_test: Test ran multiple times with different uncaught exceptions *) =============================== Output 1 / 3 ================================ =============================== Output 2 / 3 ================================ (Failure "got none!") =============================== Output 3 / 3 ================================ |}] ;; end module _ = Test' (struct let interesting_opt = Some 5 end) module _ = Test' (struct let interesting_opt = None end) module _ = Test' (struct let interesting_opt = Some 5 end) ``` # Output capture The extension point `[%expect.output]` evaluates to a `string` with the output that would have been captured had an `[%expect]` node been there instead. One idiom for testing non-deterministic output is to capture the output using `[%expect.output]` and post-process it: ```ocaml (* Suppose we want to test code that attaches a timestamp to everything it prints *) let print_message s = printf "%s: %s\n" (Time_float.to_string_utc (Time_float.now ())) s let%expect_test "output capture" = (* A simple way to clean up the non-determinism is to 'X' all digits *) let censor_digits s = String.map s ~f:(fun c -> if Char.is_digit c then 'X' else c) in print_message "Hello"; [%expect.output] |> censor_digits |> print_endline; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: Hello |}]; print_message "world"; [%expect.output] |> censor_digits |> print_endline; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: world |}] ;; ``` Other uses of `[%expect.output]` include: * Sorting lines of output printed in nondeterministic order. * Passing output that is known to be a sexp to `t_of_sexp` and performing tests on the resulting structure. * Performing some sort of additional validation on the output before printing it to a normal `[%expect]` block. # Configuration Expect-test exposes hooks for configuring how the bodies of expect tests are run, which can be used to set up and tear down test environments, sanitize output, or embed `[%expect]` expressions in a monadic computation, like a `Deferred.t`. Each `let%expect_test` reads these configurations from the module named `Expect_test_config` in the scope of that let binding. The default module in scope defines no-op hooks that the user can override. To do so, first include the existing `Expect_test_config`, then override a subset of the following interface: ```ocaml module type Expect_test_config = sig (** The type of the expression on the RHS of a [let%expect_test] binding is [unit IO.t] *) module IO : sig type 'a t val return : 'a -> 'a t end (** Run an IO operation until completion *) val run : (unit -> unit IO.t) -> unit (** [sanitize] can be used to map all output strings, e.g. for cleansing. *) val sanitize : string -> string (** This module type actually contains other definitions, but they are for internal testing of [ppx_expect] only. *) end ``` For example, `Async` exports an `Expect_test_config` equivalent to: ```ocaml skip module Expect_test_config = struct include Expect_test_config module IO = Async_kernel.Deferred let run f = Async_unix.Thread_safe.block_on_async_exn f end ``` If we want to consistently apply the same sanitization to all of the output in our expect test, like we did in the timestamp example above, we can override `Expect_test_config.sanitize`. This cleans up the testing code and removes the need to use `[%expect.output]`. ```ocaml (* Suppose we want to test code that attaches a timestamp to everything it prints *) let print_message s = printf "%s: %s\n" (Time_float.to_string_utc (Time_float.now ())) s module Expect_test_config = struct include Expect_test_config (* A simple way to clean up the non-determinism is to 'X' all digits *) let sanitize s = String.map s ~f:(fun c -> if Char.is_digit c then 'X' else c) end let%expect_test "sanitization" = print_message "Hello"; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: Hello |}]; print_message "world"; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: world |}] ;; ``` # Build system integration Follow the same rules as for [ppx_inline_test](https://github.com/janestreet/ppx_inline_test?tab=readme-ov-file#building-and-running-the-tests-outside-of-jane-street-with-dune). ppx_expect-0.17.2/config/000077500000000000000000000000001470323401700152265ustar00rootroot00000000000000ppx_expect-0.17.2/config/dune000066400000000000000000000003061470323401700161030ustar00rootroot00000000000000(library (name expect_test_config) (public_name ppx_expect.config) (synopsis "Default runtime configuration for ppx_expect") (libraries expect_test_config_types) (preprocess no_preprocessing)) ppx_expect-0.17.2/config/expect_test_config.ml000066400000000000000000000002031470323401700214270ustar00rootroot00000000000000module IO = struct type 'a t = 'a let return x = x end let sanitize s = s let run f = f () let upon_unreleasable_issue = `CR ppx_expect-0.17.2/config/expect_test_config.mli000066400000000000000000000000721470323401700216040ustar00rootroot00000000000000include Expect_test_config_types.S with type 'a IO.t = 'a ppx_expect-0.17.2/config/types/000077500000000000000000000000001470323401700163725ustar00rootroot00000000000000ppx_expect-0.17.2/config/types/dune000066400000000000000000000002711470323401700172500ustar00rootroot00000000000000(library (name expect_test_config_types) (public_name ppx_expect.config_types) (synopsis "Runtime configuration options for ppx_expect") (libraries) (preprocess no_preprocessing)) ppx_expect-0.17.2/config/types/expect_test_config_types.ml000066400000000000000000000014141470323401700240240ustar00rootroot00000000000000(** Configuration for running expect tests *) module Upon_unreleasable_issue = struct type t = [ `CR (** Leaves a CR, so that features cannot be released. *) | `Warning_for_collector_testing (** Only for ppx_expect testing; do not use. *) ] end module type S = sig module IO : sig type 'a t val return : 'a -> 'a t end (** Run an IO operation until completion *) val run : (unit -> unit IO.t) -> unit (** [sanitize] can be used to map all output strings, e.g. for cleansing. *) val sanitize : string -> string (** [upon_unreleasable_issue] specifies how to deal with output that should not be released even if it is accepted (e.g. backtraces). The default is [`CR]. *) val upon_unreleasable_issue : Upon_unreleasable_issue.t end ppx_expect-0.17.2/developer_guide.txt000066400000000000000000000031061470323401700176640ustar00rootroot00000000000000PPX EXPECT ========== This directory contains the logic used by [ppx_expect] to: - Expand [let%expect_test], [[%expect]], etc. extension points in files containing expect tests - Report the results of these tests to the inline testing harness at runtime - Rewrite failing tests as [.corrected] files The layout of the subdirectories is summarized below: ppx/ppx_expect └── config: [Expect_test_config], containing default values for │ │ overridable user-facing test configurations │ └── types: [Expect_test_config_types], which defines the interface │ for [Expect_test_config] └── evaluator: The [ppx_expect_evaluator] executable that jenga │ expects to exist when running tests; it is in fact │ unnecessary and therefore empty in this rewrite, and we │ hope to delete it soon └── runtime: [Ppx_expect_runtime], containing the logic used to │ evaluate expect tests at runtime └── src: [Ppx_expect], the ppx rewriter that replaces [ppx_expect] │ extensions with the appropriate logic from │ [Ppx_expect_runtime] └── test: [Ppx_expect_test], containing examples of passing expect │ tests that stress different facets of the testing framework, │ taken from the old [ppx_expect] framework └── example: [Expect_test_examples], with small examples └── no-output-patterns: [Ppx_expect_test_no_output_patterns], additional tests used by the old [ppx_expect] framework ppx_expect-0.17.2/dune000066400000000000000000000000001470323401700146250ustar00rootroot00000000000000ppx_expect-0.17.2/dune-project000066400000000000000000000000211470323401700162740ustar00rootroot00000000000000(lang dune 3.11) ppx_expect-0.17.2/evaluator/000077500000000000000000000000001470323401700157635ustar00rootroot00000000000000ppx_expect-0.17.2/evaluator/dune000066400000000000000000000002211470323401700166340ustar00rootroot00000000000000(library (name ppx_expect_evaluator) (public_name ppx_expect.evaluator) (libraries) (preprocess no_preprocessing) (library_flags -linkall)) ppx_expect-0.17.2/evaluator/ppx_expect_evaluator.ml000066400000000000000000000000141470323401700225510ustar00rootroot00000000000000(* empty *) ppx_expect-0.17.2/evaluator/ppx_expect_evaluator.mli000066400000000000000000000000141470323401700227220ustar00rootroot00000000000000(* empty *) ppx_expect-0.17.2/make-corrected-file/000077500000000000000000000000001470323401700175635ustar00rootroot00000000000000ppx_expect-0.17.2/make-corrected-file/dune000066400000000000000000000002351470323401700204410ustar00rootroot00000000000000(library (name make_corrected_file) (public_name ppx_expect.make_corrected_file) (libraries base ppxlib.print_diff stdio) (preprocess no_preprocessing)) ppx_expect-0.17.2/make-corrected-file/import.ml000066400000000000000000000000001470323401700214150ustar00rootroot00000000000000ppx_expect-0.17.2/make-corrected-file/make_corrected_file.ml000066400000000000000000000044611470323401700240700ustar00rootroot00000000000000open! Base open! Import let chop_if_exists ~ancestor ~from:path = String.chop_prefix_if_exists path ~prefix:(ancestor ^ "/") ;; let f ?(use_dot_patdiff = false) ?corrected_path ?(use_color = false) ?diff_command ?diff_path_prefix ~next_contents ~path () = let prev_contents = if Stdlib.Sys.file_exists path then Stdio.In_channel.with_file path ~f:Stdio.In_channel.input_all else "" in match String.( = ) prev_contents next_contents with | true -> (* It's possible for stale .corrected files to linger and ideally we would delete them here, but this probably isn't worth fixing since it's mooted by dune, which puts its build products in a separate directory. If we do add deletion at some point in the future, we should make sure it doesn't cause problems for clients who call [f] and then perform deletion on their own. *) Ok () | false -> let default_corrected_path = path ^ ".corrected" in let corrected_path = Option.value corrected_path ~default:default_corrected_path in Stdio.Out_channel.write_all corrected_path ~data:next_contents; let extra_patdiff_args = let default_configs = match use_dot_patdiff && Option.is_none (Sys.getenv "TESTING_FRAMEWORK") with | true -> [] | false -> [ "-default" ] in let cwd = Stdlib.Sys.getcwd () in (* diff_path_prefix is useful to transform output paths to make it easier for the consumer (e.g. editor) to locate the files with diffs. One particular example this helps is the "test-this-file" rules generated by emacs/vscode in jenga/start/jbuild, where the rule and the test are in different directories. *) let prefix = match diff_path_prefix with | Some prefix -> String.rstrip ~drop:(Char.equal '/') prefix ^ "/" | None -> "" in let alt_old = [ "-alt-old"; prefix ^ chop_if_exists ~ancestor:cwd ~from:path ] in let alt_new = [ "-alt-new"; prefix ^ chop_if_exists ~ancestor:cwd ~from:default_corrected_path ] in [ default_configs; alt_old; alt_new ] |> List.concat in Ppxlib_print_diff.print ?diff_command ~use_color ~extra_patdiff_args ~file1:path ~file2:corrected_path (); Error (Error.of_string "Changes found.") ;; ppx_expect-0.17.2/make-corrected-file/make_corrected_file.mli000066400000000000000000000016351470323401700242410ustar00rootroot00000000000000open! Base (** [f ~next_contents ~path ()] compares the contents of [path] against [next_contents]. If the contents are unchanged, [f] returns [Ok ()]. If they are changed, it writes [next_contents] to [corrected_path], emits a build error, and returns [Error _]. The caller should exit nonzero (possibly by raising the returned error) to indicate to the build that an error occurred. If it doesn't, the build system may not recognize that a corrected file has been generated and needs to be moved out of a sandbox. The optional arguments support "expert" use cases. Most clients do not need them. *) val f : ?use_dot_patdiff:bool (** default: [false] *) -> ?corrected_path:string (** default: [path ^ ".corrected"] *) -> ?use_color:bool (** default: [false] *) -> ?diff_command:string -> ?diff_path_prefix:string -> next_contents:string -> path:string -> unit -> unit Or_error.t ppx_expect-0.17.2/ppx_expect.opam000066400000000000000000000016501470323401700170200ustar00rootroot00000000000000opam-version: "2.0" version: "v0.17.2" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ppx_expect" bug-reports: "https://github.com/janestreet/ppx_expect/issues" dev-repo: "git+https://github.com/janestreet/ppx_expect.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_expect/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "5.1.0"} "base" {>= "v0.17" & < "v0.18"} "ppx_here" {>= "v0.17" & < "v0.18"} "ppx_inline_test" {>= "v0.17" & < "v0.18"} "stdio" {>= "v0.17" & < "v0.18"} "dune" {>= "3.11.0"} "ppxlib" {>= "0.28.0"} ] available: arch != "arm32" & arch != "x86_32" conflicts: [ "js_of_ocaml-compiler" {< "5.8"} ] synopsis: "Cram like framework for OCaml" description: " Part of the Jane Street's PPX rewriters collection. " ppx_expect-0.17.2/runtime/000077500000000000000000000000001470323401700154445ustar00rootroot00000000000000ppx_expect-0.17.2/runtime/current_file.ml000066400000000000000000000026651470323401700204700ustar00rootroot00000000000000open! Base let current = ref None let set ~filename_rel_to_project_root = match !current with | None -> current := Some filename_rel_to_project_root | Some current -> raise_s (Sexp.message "Expect_test_collector.set: there is already an active file" [ "old_file", sexp_of_string current ; "new_file", sexp_of_string filename_rel_to_project_root ]) ;; let unset () = match !current with | Some _ -> current := None | None -> raise_s (Sexp.message "Expect_test_collector.unset: there is no active file" []) ;; let get () = match !current with | Some fn -> fn | None -> raise_s (Sexp.message "Expect_test_collector.get: there is no active file" []) ;; let initial_dir = let dir_or_error = Or_error.try_with ~backtrace:true Stdlib.Sys.getcwd in lazy (Or_error.ok_exn dir_or_error) ;; let absolute_path file = if Stdlib.Filename.is_relative file then Stdlib.Filename.concat (Lazy.force initial_dir) file else file ;; let verify_that_file_is_current_exn ~line_number ~filename_rel_to_project_root = let registering_tests_for = get () in if not (String.equal filename_rel_to_project_root registering_tests_for) then Printf.ksprintf failwith "Trying to run an expect test from the wrong file.\n\ - test declared at %s:%d\n\ - trying to run it from %s\n" filename_rel_to_project_root line_number registering_tests_for else () ;; ppx_expect-0.17.2/runtime/current_file.mli000066400000000000000000000015631470323401700206350ustar00rootroot00000000000000open! Base (** We dynamically keep track of the "currently executing" file to make sure tests are not being run from outside the file in which they are defined. *) val set : filename_rel_to_project_root:string -> unit val unset : unit -> unit val get : unit -> string (** The absolute path of the working directory when the executable was first run. Forcing the [Lazy.t] raises if the initial call to [Stdlib.Sys.getcwd] raised. *) val initial_dir : string Lazy.t (** Given a path relative to the initial working directory, returns an absolute path. Raises if the initial call to [Stdlib.Sys.getcwd] raised. *) val absolute_path : string -> string (** Verifies that [filename_rel_to_project_root] was the last file set as [current]. Raises if not. *) val verify_that_file_is_current_exn : line_number:int -> filename_rel_to_project_root:string -> unit ppx_expect-0.17.2/runtime/dune000066400000000000000000000004661470323401700163300ustar00rootroot00000000000000(library (foreign_stubs (language c) (names ppx_expect_runtime_stubs)) (name ppx_expect_runtime) (public_name ppx_expect.runtime) (libraries base stdio ppx_inline_test.runtime-lib make_corrected_file expect_test_config) (js_of_ocaml (javascript_files runtime.js)) (preprocess no_preprocessing)) ppx_expect-0.17.2/runtime/expectation.ml000066400000000000000000000234571470323401700203340ustar00rootroot00000000000000open! Base open Types include Expectation_intf.Definitions module Insert_loc = struct include Insert_loc let loc = function | Overwrite { whole_node; payload = _ } -> whole_node | Insert { loc; body_loc = _ } -> loc ;; end let with_behavior { position ; behavior = _ ; payload_type ; on_incorrect_output ; inconsistent_outputs_message } behavior = { position; behavior; payload_type; on_incorrect_output; inconsistent_outputs_message } ;; let formatter (type behavior) ~(expect_node_formatting : Expect_node_formatting.t) ({ position ; behavior ; payload_type ; on_incorrect_output = T on_incorrect_output ; inconsistent_outputs_message = _ } : behavior t) = let count_leading_spaces line = line |> String.to_list |> List.take_while ~f:(Char.( = ) ' ') |> List.length in Output.Formatter.create @@ match payload_type with | Exact -> Fn.id | Pretty -> fun str -> let lines = (* In pretty payloads, we normalize all newlines to ['\n']. [[%expect_exact ""]] can be used in cases where a user wants to inspect the whitespace produced by their output more closely. *) let stripped = str |> String.split_lines |> List.map ~f:(String.rstrip ~drop:Char.is_whitespace) |> List.drop_while ~f:String.is_empty |> List.rev |> List.drop_while ~f:String.is_empty |> List.rev in let indent_and_contents = List.map stripped ~f:(fun line -> (* The legacy behavior is to only count the longest prefix of actual spaces ([' ']) for indentation, but to strip all whitespace (including, e.g., ['\t']). Note that this means [" \t contents"] is counted as having contents ["contents"] and indentation [1]. *) count_leading_spaces line, String.strip line) in match indent_and_contents |> List.filter_map ~f:(function | _indent, "" -> None | indent, _ -> Some indent) |> List.min_elt ~compare:Int.compare with | None -> [] | Some min_indent -> List.map indent_and_contents ~f:(fun (indent, line) -> Int.max 0 (indent - min_indent), line) in let (T tag) = match (behavior : _ Behavior.t) with | Expect { payload = { tag; contents = _ }; _ } -> tag | Unreachable _ -> String_node_format.Delimiter.default in (match lines, expect_node_formatting.always_on_own_line with | [], _ -> (* An empty body should either be [{| |}] or [""] *) (match tag with | Tag _ -> " " | Quote -> "") | [ (_indent, line) ], false -> (* A single line should either be [{| line |}] or ["line"] *) (match tag with | Tag _ -> String.concat [ " "; line; " " ] | Quote -> line) | lines, _ -> let location_indent = expect_node_formatting.indent (* The contents are always indented two spaces past the left edge of the extension point *) + match position with | Overwrite { whole_node = { start_bol; start_pos; end_pos = _ }; payload = _ } -> (* If we are overwriting an extension point, we should take its left edge *) start_pos - start_bol | Insert { body_loc = { start_bol; start_pos; end_pos = _ }; loc = _ } -> (* If we are inserting a new extension point, we should compute its left edged from the left edge of the [let%expect_test] node *) start_pos - start_bol + (match on_incorrect_output.kind with | Extension -> expect_node_formatting.indent | Attribute -> 0) in let spaces n = String.make n ' ' in let first_line, indentation, last_line = match tag with | Quote -> (* Since ocamlformat will split the string onto lines and indent them for us, we shouldn't insert literal whitespace to indent the string. *) " ", 1, " " | Tag _ -> "", location_indent, spaces location_indent in let lines = List.map lines ~f:(function | _indent, "" -> "" | line_indent, line -> spaces (indentation + line_indent) ^ line) in [ [ first_line ]; lines; [ last_line ] ] |> List.concat |> String.concat ~sep:"\n") ;; let extension_syntax extension_name ~payload_loc ~node_loc = let contains (outer : Compact_loc.t) ~(inner : Compact_loc.t) = outer.start_pos <= inner.start_pos && outer.end_pos >= inner.end_pos in match payload_loc with | Some payload_loc when contains payload_loc ~inner:node_loc -> (* An extension point whose payload location contains the location of the entire extension point is using the "shorthand" syntax. *) (T { name = extension_name; kind = Extension; hand = Shorthand } : String_node_format.Shape.t) | _ -> T { name = extension_name; kind = Extension; hand = Longhand } ;; let possibly_relax_strictness ~(formatting_flexibility : Expect_node_formatting.Flexibility.t) (t : [ `Expect ] t) = match formatting_flexibility with | Exactly_formatted -> t | Flexible_modulo expect_node_formatting -> let fmt = formatter ~expect_node_formatting t in let (Expect { payload = { contents; tag }; on_unreachable; reachability }) = t.behavior in (match Output.reconcile ~expected_output:contents ~test_output:(Output.Formatter.apply fmt contents) with | Pass -> t | Fail contents -> let payload = Output.to_formatted_payload ~tag contents in with_behavior t (Expect { payload; on_unreachable; reachability })) ;; let expected_string_and_payload_loc = function | Some (a, b) -> a, Some b | None -> Output.Payload.default "", None ;; let expect ~formatting_flexibility ~node_loc ~located_payload = let payload, payload_loc = expected_string_and_payload_loc located_payload in { position = Overwrite { whole_node = node_loc; payload = payload_loc } ; behavior = Expect { payload; on_unreachable = Replace_with_unreachable; reachability = Can_reach } ; payload_type = Pretty ; on_incorrect_output = extension_syntax "expect" ~payload_loc ~node_loc ; inconsistent_outputs_message = "test output" } |> possibly_relax_strictness ~formatting_flexibility ;; let expect_exact ~formatting_flexibility ~node_loc ~located_payload = let payload, payload_loc = expected_string_and_payload_loc located_payload in { position = Overwrite { whole_node = node_loc; payload = payload_loc } ; behavior = Expect { payload; on_unreachable = Replace_with_unreachable; reachability = Can_reach } ; payload_type = Exact ; on_incorrect_output = extension_syntax "expect_exact" ~payload_loc ~node_loc ; inconsistent_outputs_message = "test output" } |> possibly_relax_strictness ~formatting_flexibility ;; let expect_unreachable ~node_loc = { position = Overwrite { whole_node = node_loc; payload = None } ; behavior = Unreachable { reachability_of_corrected = Can_reach } ; payload_type = Pretty ; on_incorrect_output = T { name = "expect"; kind = Extension; hand = Longhand } ; inconsistent_outputs_message = "test output" } ;; let expect_uncaught_exn ~formatting_flexibility ~node_loc ~located_payload = let payload, payload_loc = expected_string_and_payload_loc located_payload in { position = Overwrite { whole_node = node_loc; payload = payload_loc } ; behavior = Expect { payload; on_unreachable = Delete; reachability = Must_reach } ; payload_type = Pretty ; on_incorrect_output = T { name = "expect.uncaught_exn"; kind = Attribute; hand = Longhand } ; inconsistent_outputs_message = "uncaught exception" } |> possibly_relax_strictness ~formatting_flexibility ;; let expect_trailing ~insert_loc = { position = Insert insert_loc ; behavior = Expect { payload = Output.Payload.default " " ; on_unreachable = Silent ; reachability = Can_reach } ; payload_type = Pretty ; on_incorrect_output = T { name = "expect"; kind = Extension; hand = Longhand } ; inconsistent_outputs_message = "trailing output" } ;; let expect_no_uncaught_exn ~insert_loc = { position = Insert insert_loc ; behavior = Unreachable { reachability_of_corrected = Must_reach } ; payload_type = Pretty ; on_incorrect_output = T { name = "expect.uncaught_exn"; kind = Attribute; hand = Longhand } ; inconsistent_outputs_message = "uncaught exception" } ;; module For_apply_style = struct let format_payload mk_node = Staged.stage @@ fun ~expect_node_formatting ~payload_loc ~node_loc tag contents -> let node = mk_node ~formatting_flexibility:(Exactly_formatted : Expect_node_formatting.Flexibility.t) ~node_loc ~located_payload:(Some (({ tag; contents } : Output.Payload.t), payload_loc)) in let formatted_contents = Output.Formatter.apply (formatter ~expect_node_formatting node) contents in match Output.reconcile ~expected_output:contents ~test_output:formatted_contents with | Pass -> None | Fail contents -> let source_code_string = match node.on_incorrect_output with | T { hand = Longhand; _ } -> Output.to_formatted_payload ~tag contents |> Output.Payload.to_source_code_string | T { hand = Shorthand; _ } as node_shape -> Output.to_source_code_string ~expect_node_formatting ~node_shape ~tag contents in Some source_code_string ;; let format_expect_payload = format_payload expect |> Staged.unstage let format_uncaught_exn_payload = format_payload expect_uncaught_exn |> Staged.unstage end ppx_expect-0.17.2/runtime/expectation.mli000066400000000000000000000000451470323401700204710ustar00rootroot00000000000000include Expectation_intf.Expectation ppx_expect-0.17.2/runtime/expectation_intf.ml000066400000000000000000000143321470323401700213440ustar00rootroot00000000000000open! Base open Types module Definitions = struct module Insert_loc = struct (** Whether this expectation is tied to an AST node already present in the source, and the location information needed to determine where to insert corrections for this expectation *) type t = | Overwrite of { whole_node : Compact_loc.t ; payload : Compact_loc.t option } (** An expectation parsed from the test file and which should be overwritten by corrections. Corrections to just the payload should overwrite just the [payload] location, if present. If no [payload] location is present, or for corrections that change the entire node (e.g. a change from [[%expect _]] to [[%expect.unreachable]]), overwrite the [whole_node] loc. *) | Insert of Virtual_loc.t (** An expectation not parsed from the file that should be inserted into [Virtual_loc.loc] and is associated with a test whose body is at [Virtual_loc.body_loc] *) end module Behavior_type = struct (** The type of expect node *) type t = [ `Expect | `Unreachable ] end module Expect_reachability = struct (** Whether an expect node expresses an assertion that control flow passes through it every time a test is run *) type t = | Can_reach (** Test passes even if node is only reached on *some* executions of a test *) | Must_reach (** Test fails unless node is reached by *all* executions of a test *) end module On_unreachable = struct (** What should be done if this expectation is never reached in the test execution *) type t = | Silent (** Do nothing *) | Delete (** Delete this expectation from the source file *) | Replace_with_unreachable (** Replace this expectation with a [[%expect.unreachable]] node *) end module Behavior = struct (** A ['behavior_type t] describes how to handle a test node when running tests and writing corrections. ['behavior_type] determines the types of rewrites that are possible at this node. It is either [`Expect] (indicating that both corrections for unexpected output and rewrites for unreachability are possible) or [`Unreachable] (indicating that only corrections for unexpected output are possible). *) type _ t = | Expect : { payload : Output.Payload.t ; on_unreachable : On_unreachable.t ; reachability : Expect_reachability.t } -> [ `Expect ] t | Unreachable : { reachability_of_corrected : Expect_reachability.t (** The reachability of the node inserted if this unreachable node is unexpectedly reached *) } -> [ `Unreachable ] t end (** A [('behavior_type) t] carries information about how to run tests for a specific expect node and rewrite it in the source file if there are corrections. The ['behavior_type] type variable has the same meanings as in ['behavior_type Behavior.t]. *) type 'behavior_type t = { position : Insert_loc.t ; behavior : 'behavior_type Behavior.t ; payload_type : Output.Type.t ; on_incorrect_output : String_node_format.Shape.t (** The name and syntax style of the extension point or attribute used to write corrections when receiving "incorrect" output for this test node. For each [t], there is only one such node. For example, if an [{%expect_exact||}] node is reached with incorrect output, it is always corrected to a different [{%expect_exact||}] node, and an [[%expect.unreachable]] that is reached is always corrected to an [[%expect]] node. Note that for a node that should be reachable, the correction when it is found to be unreachable is instead governed by [on_unreachable] in the [Expect] constructor of [behavior]. *) ; inconsistent_outputs_message : string } end module type Expectation = sig include module type of struct include Definitions end module Insert_loc : sig include module type of struct include Insert_loc end val loc : Insert_loc.t -> Compact_loc.t end val with_behavior : 'old_behavior t -> 'new_behavior Behavior.t -> 'new_behavior t (** [formatter ~expect_node_formatting t] returns the [Output.Formatter.t] that formats test output according to the type ([exact] or [pretty]) of [t], using information about the location and payload of [t] for formatting. *) val formatter : expect_node_formatting:Expect_node_formatting.t -> _ t -> Output.Formatter.t (** [[%expect _]] *) val expect : formatting_flexibility:Expect_node_formatting.Flexibility.t -> node_loc:Compact_loc.t -> located_payload:(Output.Payload.t * Compact_loc.t) option -> [ `Expect ] t (** [[%expect_exact _]] *) val expect_exact : formatting_flexibility:Expect_node_formatting.Flexibility.t -> node_loc:Compact_loc.t -> located_payload:(Output.Payload.t * Compact_loc.t) option -> [ `Expect ] t (** [[%expect.unreachable]] *) val expect_unreachable : node_loc:Compact_loc.t -> [ `Unreachable ] t (** [[@@expect.uncaught_exn _]] *) val expect_uncaught_exn : formatting_flexibility:Expect_node_formatting.Flexibility.t -> node_loc:Compact_loc.t -> located_payload:(Output.Payload.t * Compact_loc.t) option -> [ `Expect ] t (** Runtime representation of the implicit [[%expect {||}]] at the end of every expect test. *) val expect_trailing : insert_loc:Virtual_loc.t -> [ `Expect ] t (** Runtime representation of the assertion that a test does not produce uncaught exceptions, which a user implicitly makes by omitting an [[@@expect.uncaught_exn _]] attribute. *) val expect_no_uncaught_exn : insert_loc:Virtual_loc.t -> [ `Unreachable ] t module For_apply_style : sig type format_payload := expect_node_formatting:Expect_node_formatting.t -> payload_loc:Compact_loc.t -> node_loc:Compact_loc.t -> String_node_format.Delimiter.t -> string -> string option val format_expect_payload : format_payload val format_uncaught_exn_payload : format_payload end end ppx_expect-0.17.2/runtime/output.ml000066400000000000000000000060461470323401700173440ustar00rootroot00000000000000open! Base open Types module Type = struct type t = | Exact | Pretty end module Reconciled = struct type t = string let compare = compare_string end module Formatted = struct type t = string end module Formatter = struct type t = string -> Formatted.t let create format = format let apply format str = format str end module Test_result = struct type t = | Pass | Fail of Reconciled.t let compare a b = match a, b with | Pass, Pass -> 0 | Pass, _ -> -1 | _, Pass -> 1 | Fail a, Fail b -> Reconciled.compare a b ;; end module Payload = struct type t = { contents : string ; tag : String_node_format.Delimiter.t } let default contents = { contents; tag = String_node_format.Delimiter.default } let to_source_code_string { contents; tag } = let escape_lines test_output = test_output |> String.split ~on:'\n' |> List.map ~f:String.escaped |> String.concat ~sep:"\n" in match tag with | T (Tag tag) -> Printf.sprintf "{%s|%s|%s}" tag contents tag | T Quote -> Printf.sprintf {|"%s"|} (escape_lines contents) ;; end let reconcile ~expected_output ~test_output : Test_result.t = if String.equal expected_output test_output then Pass else Fail test_output ;; let fail error_output : Test_result.t = Fail error_output let fix_delimiter_conflicts (type handedness) ~contents ~(delimiter : handedness String_node_format.Delimiter.unpacked) : handedness String_node_format.Delimiter.unpacked = let rec fix_tag_conflicts ~contents ~tag = let tag_conflicts_with fstr = String.is_substring ~substring:(Printf.sprintf fstr tag) contents in if tag_conflicts_with "{%s|" || tag_conflicts_with "|%s}" then fix_tag_conflicts ~contents ~tag:(tag ^ "xxx") else tag in match delimiter with | Quote -> Quote | Tag tag -> Tag (fix_tag_conflicts ~contents ~tag) ;; let to_formatted_payload ~tag:(T delimiter : String_node_format.Delimiter.t) contents : Payload.t = { contents; tag = T (fix_delimiter_conflicts ~contents ~delimiter) } ;; let to_source_code_string ~(expect_node_formatting : Expect_node_formatting.t) ~node_shape:(T shape : String_node_format.Shape.t) ~(tag : String_node_format.Delimiter.t) contents = let delimiter = fix_delimiter_conflicts ~contents ~delimiter:(String_node_format.Delimiter.handed tag shape.hand) in let payload : Payload.t = { contents; tag = T delimiter } in match shape.hand with | Longhand -> let prefix = match shape.kind with | Extension -> expect_node_formatting.extension_sigil | Attribute -> expect_node_formatting.attribute_sigil in Printf.sprintf "[%s%s %s]" prefix shape.name (Payload.to_source_code_string payload) | Shorthand -> let prefix = match shape.kind with | Extension -> expect_node_formatting.extension_sigil in (match delimiter with | Tag "" -> Printf.sprintf "{%s%s|%s|}" prefix shape.name contents | Tag tag -> Printf.sprintf "{%s%s %s|%s|%s}" prefix shape.name tag contents tag) ;; ppx_expect-0.17.2/runtime/output.mli000066400000000000000000000064711470323401700175170ustar00rootroot00000000000000open! Base open Types module Type : sig (** How the output expected at a node interacts with whitespace. *) type t = | Exact (** Matches the captured output exactly, including whitespace. *) | Pretty (** Matches a version of the captured output that has been formatted according to standard rules about indentation and other whitespace. *) end (** Captured output that has been formatted according to the rules of the [Type.t] of its corresponding node. *) module Formatted : T (** Captured test output, possibly from multiple tests, after it has been formatted and compared to the original contents of the node; the contents that will be written to the node in the corrected file. *) module Reconciled : T module Formatter : sig (** A [Formatter.t] describes how to convert captured [string] output into a [Formatted.t]. *) type t (** Given a function that applies the desired format to a [string] representing captured output, create a [Formatter.t]. *) val create : (string -> string) -> t (** Apply a [Formatter.t] to a [string] representing captured output to produce a [Formatted.t]. *) val apply : t -> string -> Formatted.t end module Test_result : sig (** The outcome produced by a single expect node when it is reached. [Pass] if the real output matches the expected output, otherwise [Fail s], where [s] is the real output. *) type t = private | Pass | Fail of Reconciled.t val compare : t -> t -> int end module Payload : sig (** Payloads given as arguments to expectation AST nodes. *) type t = { contents : string (** The contents of the payload; the output expected at some node, as a raw [string] exactly as they were parsed from the source file. *) ; tag : String_node_format.Delimiter.t (** The delimiters used in the payload. *) } (** Add the default tags to a payload. *) val default : string -> t (** The source-code representation of a payload. *) val to_source_code_string : t -> string end (** Returns [Pass] if [test_output] is considered to match [expected_output]; otherwise returns [Fail test_output]. *) val reconcile : expected_output:string -> test_output:Formatted.t -> Test_result.t (** Given some [Formatted.t] output that always indicates test failure (e.g., an inconsistent outputs message), produces a failing test result with the corresponding "reconciled" output. *) val fail : Formatted.t -> Test_result.t (** The new payload represented by a reconciled expectation. If [tag] is not compatible with the new payload contents (for example, the tag represents a [{x| delimited string |x}] and the new contents contain ["|x}"]), the tag is adjusted so the resulting payload can be parsed. *) val to_formatted_payload : tag:String_node_format.Delimiter.t -> Reconciled.t -> Payload.t (** The source-code representation of a reconciled expect node. If [tag] is not compatible with the new payload contents (for example, the tag represents a [{x| delimited string |x}] and the new contents contain ["|x}"]), the tag is adjusted so the resulting payload can be parsed. *) val to_source_code_string : expect_node_formatting:Expect_node_formatting.t -> node_shape:String_node_format.Shape.t -> tag:String_node_format.Delimiter.t -> Reconciled.t -> string ppx_expect-0.17.2/runtime/ppx_expect_runtime.ml000066400000000000000000000134301470323401700217210ustar00rootroot00000000000000open! Base (** This library provides the runtime representation of expect tests and much of the logic for running them. The [Test_block] module defines the runtime representation of the whole [let%expect_test] block. It exports a [Make] functor that is used in generated code to produce a module from the locally bound [Expect_test_config]. [run_suite] from the resulting module takes in remaining information about the expect test, including inline test configurations, information about the contained expectations, and a callback containing the body of the test. The [~expectations] argument to [run_suite] is an assoc list mapping unique ids to [Test_node.t]s. A [Test_node.t] stores the representation of a single [[%expect]] test AST node and collects the results of tests that reach this node. In the body of the test, the [[%expect]] AST nodes are replaced by calls to [run_test], with the appropriate id passed as an argument. For an example, consider a file that contains just the simple [let%expect_test] below: {[ let%expect_test _ = print_string "Hello"; [%expect {| Hello |}]; print_string "world"; [%expect_exact {x|world|x}] ;; ]} It will expand to code that looks something like this: {[ (* This statement is added to the top of each rewritten file; it is used to make sure tests are only run from the files in which they are declared. *) let () = Ppx_expect_runtime.Current_file.set ~filename_rel_to_project_root:"foo/bar/test/test.ml" (* Each test expands into something that looks approximately like this. Some of the arguments to [Ppx_expect_test_block.run_suite] are elided for clarity. *) let () = (* Prepare to read test output using the settings from [Expect_test_config] *) let module Ppx_expect_test_block = Ppx_expect_runtime.Make_test_block(Expect_test_config) in Ppx_expect_test_block.run_suite (* The name of the file in which the test is defined. This lets the runtime check that the filename set here at ppx-time matches the one that is set by the block above at runtime. If the test were defined in a functor and that functor invoked from another file, the filenames would not match. *) ~filename_rel_to_project_root:"foo/bar/test/test.ml" (* The ids that should be used when registering the trailing output test and the uncaught exception tests. They are minted at ppx time because that is the time that it is easiest to guarantee their uniqueness. *) ~trailing_test_id:(Ppx_expect_runtime.Expectation_id.of_int 2) ~exn_test_id:(Ppx_expect_runtime.Expectation_id.of_int 3) (* An assoc list mapping ids to representations of expect nodes that appear in this test. Later, when encountering expect nodes, information about them is looked up in this table. *) ~expectations:(([(Ppx_expect_runtime.Expectation_id.of_int 1, Ppx_expect_runtime.Test_node.Create.expect_exact { contents = "world"; tag = (Tag "x") } { start_bol = ...; start_pos = ...; end_pos = ... }); (Ppx_expect_runtime.Expectation_id.of_int 0, Ppx_expect_runtime.Test_node.Create.expect { contents = " Hello "; tag = (Tag "") } { start_bol = ...; start_pos = ...; end_pos = ... })]) ) (* The body of the let binding is passed as a callback. *) (fun () -> print_string "Hello"; (* Tests are run by passing in the id of the encountered test node. *) Ppx_expect_test_block.run_test ~test_id:(Ppx_expect_runtime.Expectation_id.of_int 0); print_string "world"; Ppx_expect_test_block.run_test ~test_id:(Ppx_expect_runtime.Expectation_id.of_int 1)) (* This statement is added to the end of each file so that the expect test runtime knows the file is finished executing and a new one can be set as current. *) let () = Ppx_expect_runtime.Current_file.unset () ]} *) (* Register the reachability check and corrected file writing as an evaluator with [Ppx_inline_test_lib] *) let () = Ppx_inline_test_lib.add_evaluator ~f:(fun () -> Stdlib.Sys.chdir (Lazy.force Current_file.initial_dir); Test_node.Global_results_table.process_each_file ~f:(fun ~filename ~test_nodes ~postprocess -> Write_corrected_file.f test_nodes ~use_color:(Ppx_inline_test_lib.use_color ()) ~in_place:(Ppx_inline_test_lib.in_place ()) ~diff_command:(Ppx_inline_test_lib.diff_command ()) ~diff_path_prefix:(Ppx_inline_test_lib.diff_path_prefix ()) ~with_:postprocess ~filename) |> Ppx_inline_test_lib.Test_result.combine_all) ;; (* Alert of mid-test runtime failure. *) let () = Stdlib.at_exit Test_block.at_exit (* Exported definitions *) module Expect_node_formatting = Types.Expect_node_formatting module Compact_loc = Types.Compact_loc module Expectation_id = Types.Expectation_id module Delimiter = Types.String_node_format.Delimiter module Payload = Output.Payload module Current_file : sig val set : filename_rel_to_project_root:string -> unit val unset : unit -> unit end = Current_file module Test_node = struct type t = Test_node.t module Create = Test_node.Create module For_mlt = Test_node.For_mlt end module Write_corrected_file = Write_corrected_file module Make_test_block = Test_block.Make module For_external = Test_block.For_external module For_apply_style = Expectation.For_apply_style ppx_expect-0.17.2/runtime/ppx_expect_runtime_stubs.c000066400000000000000000000067331470323401700227630ustar00rootroot00000000000000#include #include #include #include #ifndef _MSC_VER #include #endif /* #include */ /* The definition of channel should be kept in sync with upstream ocaml */ /* Start of duplicated code from caml/io.h */ #ifndef IO_BUFFER_SIZE #define IO_BUFFER_SIZE 65536 #endif #if defined(_WIN32) typedef __int64 file_offset; #elif defined(HAS_OFF_T) #include typedef off_t file_offset; #else typedef long file_offset; #endif struct channel { int fd; /* Unix file descriptor */ file_offset offset; /* Absolute position of fd in the file */ char *end; /* Physical end of the buffer */ char *curr; /* Current position in the buffer */ char *max; /* Logical end of the buffer (for input) */ void *mutex; /* Placeholder for mutex (for systhreads) */ struct channel *next, *prev; /* Double chaining of channels (flush_all) */ int revealed; /* For Cash only */ int old_revealed; /* For Cash only */ int refcount; /* For flush_all and for Cash */ int flags; /* Bitfield */ char buff[IO_BUFFER_SIZE]; /* The buffer itself */ char *name; /* Optional name (to report fd leaks) */ }; #define Channel(v) (*((struct channel **)(Data_custom_val(v)))) /* End of duplicated code from caml/io.h */ /* Start of duplicated code from caml/sys.h */ #define NO_ARG Val_int(0) CAMLextern void caml_sys_error(value); /* End of duplicated code from caml/sys.h */ static int ppx_expect_runtime_saved_stdout; static int ppx_expect_runtime_saved_stderr; CAMLprim value ppx_expect_runtime_before_test(value voutput, value vstdout, value vstderr) { struct channel *output = Channel(voutput); struct channel *cstdout = Channel(vstdout); struct channel *cstderr = Channel(vstderr); int fd, ret; fd = dup(cstdout->fd); if (fd == -1) caml_sys_error(NO_ARG); ppx_expect_runtime_saved_stdout = fd; fd = dup(cstderr->fd); if (fd == -1) caml_sys_error(NO_ARG); ppx_expect_runtime_saved_stderr = fd; ret = dup2(output->fd, cstdout->fd); if (ret == -1) caml_sys_error(NO_ARG); ret = dup2(output->fd, cstderr->fd); if (ret == -1) caml_sys_error(NO_ARG); return Val_unit; } CAMLprim value ppx_expect_runtime_after_test(value vstdout, value vstderr) { struct channel *cstdout = Channel(vstdout); struct channel *cstderr = Channel(vstderr); int ret; ret = dup2(ppx_expect_runtime_saved_stdout, cstdout->fd); if (ret == -1) caml_sys_error(NO_ARG); ret = dup2(ppx_expect_runtime_saved_stderr, cstderr->fd); if (ret == -1) caml_sys_error(NO_ARG); ret = close(ppx_expect_runtime_saved_stdout); if (ret == -1) caml_sys_error(NO_ARG); ret = close(ppx_expect_runtime_saved_stderr); if (ret == -1) caml_sys_error(NO_ARG); return Val_unit; } CAMLprim value ppx_expect_runtime_out_channel_position(value vchan) { struct channel *chan = Channel(vchan); file_offset ret; caml_enter_blocking_section(); ret = lseek(chan->fd, 0, SEEK_CUR); caml_leave_blocking_section(); if (ret == -1) caml_sys_error(NO_ARG); if (ret > Max_long) caml_failwith("ppx_expect_runtime_out_channel_position: overflow"); return Val_long(ret); } CAMLprim value ppx_expect_runtime_flush_stubs_streams(value vunit) { fflush(stdout); fflush(stderr); return vunit; } ppx_expect-0.17.2/runtime/runtime.js000066400000000000000000000023431470323401700174670ustar00rootroot00000000000000//Provides: ppx_expect_runtime_saved_stdout var ppx_expect_runtime_saved_stdout //Provides: ppx_expect_runtime_saved_stderr var ppx_expect_runtime_saved_stderr //Provides: ppx_expect_runtime_before_test //Requires: caml_ml_channel_redirect //Requires: ppx_expect_runtime_saved_stderr, ppx_expect_runtime_saved_stdout function ppx_expect_runtime_before_test (voutput, vstdout, vstderr){ ppx_expect_runtime_saved_stderr = caml_ml_channel_redirect(vstderr, voutput); ppx_expect_runtime_saved_stdout = caml_ml_channel_redirect(vstdout, voutput); return 0; } //Provides: ppx_expect_runtime_after_test //Requires: caml_ml_channel_restore //Requires: ppx_expect_runtime_saved_stderr, ppx_expect_runtime_saved_stdout function ppx_expect_runtime_after_test (vstdout, vstderr){ caml_ml_channel_restore(vstdout,ppx_expect_runtime_saved_stdout); caml_ml_channel_restore(vstderr,ppx_expect_runtime_saved_stderr); return 0; } //Provides: ppx_expect_runtime_out_channel_position //Requires: caml_ml_channel_get function ppx_expect_runtime_out_channel_position(chan){ var info = caml_ml_channel_get(chan); return info.offset } //Provides: ppx_expect_runtime_flush_stubs_streams function ppx_expect_runtime_flush_stubs_streams(vunit){ return 0 } ppx_expect-0.17.2/runtime/test_block.ml000066400000000000000000000332711470323401700201350ustar00rootroot00000000000000open! Base open Types (* [Shared] and [Configured] primarily contain boilerplate involving the FFI and printing [CR]s. The interesting logic is in [Make]. *) module Shared : sig type t val src_filename : t -> string val output_file : t -> string val failure_ref : t -> bool ref val set_up_block : string -> t val read_test_output_unsanitized : t -> string val flush : unit -> unit val clean_up_block : t -> unit end = struct type t = { src_filename : string ; output_file : string ; fail : bool ref ; test_output_reader : Stdlib.in_channel ; test_output_writer : Stdlib.out_channel ; old_offset : int ref } let src_filename { src_filename; _ } = src_filename let output_file { output_file; _ } = output_file let failure_ref { fail; _ } = fail external redirect_stdout : output:Stdlib.out_channel -> stdout:Stdlib.out_channel -> stderr:Stdlib.out_channel -> unit = "ppx_expect_runtime_before_test" external restore_stdout : stdout:Stdlib.out_channel -> stderr:Stdlib.out_channel -> unit = "ppx_expect_runtime_after_test" external pos_out : Stdlib.out_channel -> int = "ppx_expect_runtime_out_channel_position" external flush_stubs : unit -> unit = "ppx_expect_runtime_flush_stubs_streams" (* Save std file descriptors, open a temp file for test output, and reroute stdout and stderr there. *) let set_up_block src_filename = let output_file = Current_file.absolute_path (Stdlib.Filename.temp_file "expect-test" "output") in let test_output_writer = Stdlib.open_out_gen [ Open_wronly; Open_creat; Open_binary ] 0o644 output_file in let test_output_reader = Stdlib.open_in_bin output_file in redirect_stdout ~output:test_output_writer ~stdout:Stdlib.stdout ~stderr:Stdlib.stderr; { src_filename ; output_file ; test_output_reader ; test_output_writer ; old_offset = ref 0 ; fail = ref false } ;; (* Close the temp file and restore stdout and stderr. *) let clean_up_block { output_file; test_output_reader; test_output_writer; _ } = Stdlib.close_in test_output_reader; restore_stdout ~stdout:Stdlib.stdout ~stderr:Stdlib.stderr; Stdlib.close_out test_output_writer; Stdlib.Sys.remove output_file ;; let flush () = Stdlib.Format.pp_print_flush Stdlib.Format.std_formatter (); Stdlib.Format.pp_print_flush Stdlib.Format.err_formatter (); Stdlib.flush Stdlib.stdout; Stdlib.flush Stdlib.stderr; flush_stubs () ;; let read_test_output_unsanitized { test_output_reader; old_offset; _ } = let new_offset = flush (); pos_out Stdlib.stdout in let len = new_offset - !old_offset in old_offset := new_offset; Stdlib.really_input_string test_output_reader len ;; end module Configured (C : Expect_test_config_types.S) = struct let cr_prefix = match C.upon_unreleasable_issue with | `CR -> "CR " | `Warning_for_collector_testing -> "" ;; let cr_for_backtrace = Printf.sprintf {|(* %sexpect_test_collector: This test expectation appears to contain a backtrace. This is strongly discouraged as backtraces are fragile. Please change this test to not include a backtrace. *)|} cr_prefix ;; let cr_for_multiple_outputs ~output_name ~outputs = let cr_body = Printf.sprintf "Test ran multiple times with different %ss" output_name in let cr = Printf.sprintf "(* %sexpect_test: %s *)" cr_prefix cr_body in let num_outputs = List.length outputs in let header index = let header = Printf.sprintf "=== Output %d / %d ===" (index + 1) num_outputs in let pad_length = String.length cr - String.length header in if pad_length <= 0 then header else ( let lpad = String.make (pad_length / 2) '=' in let rpad = String.make (pad_length - (pad_length / 2)) '=' in Printf.sprintf "%s%s%s" lpad header rpad) in let outputs_with_headers = List.concat_mapi outputs ~f:(fun index output -> [ header index; output ]) in String.concat (cr :: outputs_with_headers) ~sep:"\n" ;; let sanitize = C.sanitize let check_for_backtraces s = if List.exists ~f:(fun substring -> String.is_substring ~substring s) [ "Raised at "; "Called from "; "Raised by primitive operation " ] then cr_for_backtrace ^ "\n\n" ^ s else s ;; let dump_backtrace possible_exn = match C.run possible_exn with | exception exn -> let bt = Stdlib.Printexc.get_raw_backtrace () in let exn_string = try Exn.to_string exn with | _ -> let name = Stdlib.Obj.Extension_constructor.of_val exn |> Stdlib.Obj.Extension_constructor.name in Printf.sprintf "(\"%s(Cannot print more details, Exn.to_string failed)\")" name in Some (match Stdlib.Printexc.raw_backtrace_to_string bt with | "" -> exn_string | bt -> String.concat ~sep:"\n" [ cr_for_backtrace; exn_string; bt ]) | _ -> None ;; end (* The expect test currently being executed and some info we print if the program crashes in the middle of a test. *) module Current_test : sig type t = { line_number : int ; basename : string ; location : Compact_loc.t ; test_block : Shared.t } val set : t -> unit val unset : unit -> unit val is_running : unit -> bool val current_test : unit -> Shared.t option val current_test_exn : unit -> Shared.t val iter : f:(t -> unit) -> unit val assert_no_test_running : basename:string -> line_number:int -> unit end = struct type t = { line_number : int ; basename : string ; location : Compact_loc.t ; test_block : Shared.t } let test_is_running : t option ref = ref None let set t = test_is_running := Some t let unset () = test_is_running := None let is_running () = Option.is_some !test_is_running let current_test () = Option.map !test_is_running ~f:(fun { test_block; _ } -> test_block) ;; let current_test_exn () = Option.value_exn (current_test ()) let iter ~f = Option.iter !test_is_running ~f let assert_no_test_running ~basename ~line_number = iter ~f: (fun { line_number = outer_line_number ; basename = outer_basename ; location = _ ; test_block = _ } -> let sexp_here ~basename ~line_number : Sexp.t = List [ List [ Atom "file"; sexp_of_string basename ] ; List [ Atom "line"; sexp_of_int line_number ] ] in raise_s (Sexp.message "Expect_test_runtime: reached one [let%expect_test] from another. Nesting \ expect\n\ tests is prohibited." [ ( "outer_test" , sexp_here ~basename:outer_basename ~line_number:outer_line_number ) ; "inner_test", sexp_here ~basename ~line_number ])) ;; end (* The main testing functions of a test block, which depend on configurations. *) module Make (C : Expect_test_config_types.S) = struct module Configured = Configured (C) let read_test_output_no_backtrace_check () = Current_test.current_test_exn () |> Shared.read_test_output_unsanitized |> Configured.sanitize ;; let read_test_output_sanitized_and_checked () = read_test_output_no_backtrace_check () |> Configured.check_for_backtraces ;; let run_test_inner ~test_id ~test_output_raw t = Test_node.record_result ~expect_node_formatting:Expect_node_formatting.default ~failure_ref:(Shared.failure_ref t) ~test_output_raw (Test_node.Global_results_table.find_test ~absolute_filename:(Shared.src_filename t) ~test_id) ;; let run_test ~test_id = Current_test.current_test_exn () |> run_test_inner ~test_id ~test_output_raw:(read_test_output_sanitized_and_checked ()) ;; let run_suite ~filename_rel_to_project_root ~line_number ~(location : Compact_loc.t) ~(trailing_loc : Compact_loc.t) ~(body_loc : Compact_loc.t) ~formatting_flexibility ~expected_exn ~trailing_test_id ~exn_test_id ~description ~tags ~inline_test_config ~expectations f = let ({ start_bol; start_pos; end_pos } : Compact_loc.t) = location in let basename = Stdlib.Filename.basename filename_rel_to_project_root in (* Even if the current tag set indicates this test should be dropped, check that it wasn't reached from another expect test *) Current_test.assert_no_test_running ~basename ~line_number; Ppx_inline_test_lib.test ~config:inline_test_config ~descr:(lazy (Option.value description ~default:"")) ~tags ~filename:basename ~line_number ~start_pos:(start_pos - start_bol) ~end_pos:(end_pos - start_bol) (fun () -> (* Check that the test is being run from the file in which it was defined *) Current_file.verify_that_file_is_current_exn ~line_number ~filename_rel_to_project_root; let absolute_filename = Current_file.absolute_path basename in (* Create the tests for trailing output and uncaught exceptions *) let expectations = let trailing_test = Expectation.expect_trailing ~insert_loc: { loc = { trailing_loc with end_pos = trailing_loc.start_pos }; body_loc } |> Test_node.of_expectation in let exn_test = match expected_exn with | Some _ -> Expectation.expect_uncaught_exn ~formatting_flexibility ~located_payload:expected_exn ~node_loc:trailing_loc |> Test_node.of_expectation | None -> Expectation.expect_no_uncaught_exn ~insert_loc:{ loc = trailing_loc; body_loc } |> Test_node.of_expectation in (exn_test_id, exn_test) :: (trailing_test_id, trailing_test) :: expectations in (* Add the tests to the global table and reset their [reached_this_run] flags *) let expectations = Test_node.Global_results_table.initialize_and_register_tests ~absolute_filename expectations (fun ~original_file_contents ts -> List.concat_map ts ~f: (Test_node.For_mlt.to_diffs ~cr_for_multiple_outputs:Configured.cr_for_multiple_outputs ~expect_node_formatting:Expect_node_formatting.default ~original_file_contents)) in (* To avoid capturing not-yet flushed data of the stdout/stderr buffers. *) Shared.flush (); (* Redirect stdout/stderr *) let test_block = Shared.set_up_block absolute_filename in (* Run the test *) Current_test.set { line_number; basename; location; test_block }; let test_exn = Configured.dump_backtrace (fun () -> (* Ignore output that was printed before the test started *) let (_ : string) = Shared.read_test_output_unsanitized test_block in f ()) in (* Run the trailing output and uncaught exn test *) let test_output, test_to_run = let trailing_output = let trailing_raw = read_test_output_sanitized_and_checked () in match String.strip trailing_raw with | "" -> None | _ -> Some trailing_raw in match test_exn with | None -> Option.value trailing_output ~default:"", trailing_test_id | Some test_exn -> let test_output = match trailing_output with | None -> test_exn | Some trailing_output -> String.concat ~sep:"\n" [ test_exn; "Trailing output"; "---------------"; trailing_output ] in test_output, exn_test_id in run_test_inner test_block ~test_output_raw:test_output ~test_id:test_to_run; (* Perform the per-test reachability check *) List.iter expectations ~f:(fun (_, test_node) -> Test_node.record_end_of_run test_node); (* Restore stdout/stderr *) Shared.clean_up_block test_block; Current_test.unset (); (* Report that this test passed, because we report expect test failures by a different mechanism. *) true) ;; end let at_exit () = Current_test.iter ~f: (fun { line_number ; basename ; location = { start_bol; start_pos; end_pos } ; test_block } -> Shared.flush (); let fin = Stdlib.open_in_bin (Shared.output_file test_block) in let all_out = Stdlib.really_input_string fin (Stdlib.in_channel_length fin) in Shared.clean_up_block test_block; Stdlib.Printf.eprintf "File %S, line %d, characters %d-%d:\n\ Error: program exited while expect test was running!\n\ Output captured so far:\n\ %s\n\ %!" basename line_number (start_pos - start_bol) (end_pos - start_bol) all_out) ;; module For_external = struct let read_current_test_output_exn ~here = match Current_test.current_test () with | Some test_block -> test_block |> Shared.read_test_output_unsanitized |> Expect_test_config.sanitize | None -> failwith (Printf.sprintf "Ppx_expect_runtime.read_current_test_output_exn called while there are no \ tests running at %s" (Source_code_position.to_string here)) ;; let am_running_expect_test = Current_test.is_running let default_cr_for_multiple_outputs = let module Configured = Configured (Expect_test_config) in Configured.cr_for_multiple_outputs ;; end ppx_expect-0.17.2/runtime/test_block.mli000066400000000000000000000107571470323401700203120ustar00rootroot00000000000000open! Base open Types (** Functor for building the runtime representation of a [let%expect_test] block *) module Make (C : Expect_test_config_types.S) : sig (** Read test output, passing it through the configured sanitization function but not checking for backtraces. Equivalent to [[%expect.output]]. Consuming read. *) val read_test_output_no_backtrace_check : unit -> string (** Given a test id: - Look up the [Test_node.t] with that id - Perform a consuming read of current test output, performing sanitization and checking for backtraces - Compare the consumed output with the output expected by the associated [Test_node.t] - Record the test outcome in the associated [Test_node.t] - If the test failed, set the current [Test_block]'s [fail] ref to [true] (so that the test harness will be informed of a failure at the conclusion of this [let%expect_test] block) *) val run_test : test_id:Expectation_id.t -> unit (** Execute a single [let%expect_test] block through [Ppx_inline_test_lib.test]. - Assert that the test is defined in the currently-executing file. - Generate two implicit [Test_node.t]s representing trailing output (expectation that there is none) and uncaught exception (expectation that there is none if [expected_exn = None], or else that the test raises with [expected_exn]). - Add the explicit [Test_node.t]s in [expectations] (those actually present in the test body), as well as the two implicit [Test_node.t]s described above, into the global table of [Test_node.t]s. - Run the callback and the tests for trailing output and uncaught exceptions, accumulating the results of each reached "expectation" inside the corresponding [Test_node.t]. - After the callback finishes, if any of the expectations do not match, inform the inline testing harness that the test has "failed". *) val run_suite : filename_rel_to_project_root:string (** File in which the test is defined *) -> line_number:int (** Line number of the start of the test *) -> location:Compact_loc.t (** Range of characters of the entire test; printed if program exits unexpectedly *) -> trailing_loc:Compact_loc.t (** Where to insert the [[%expect]] for trailing output *) -> body_loc:Compact_loc.t (** Range of characters of the RHS of the [let%expect_test] binding. *) -> formatting_flexibility:Expect_node_formatting.Flexibility.t (** The formatting flexibility to use for the uncaught exn test. *) -> expected_exn:(Output.Payload.t * Compact_loc.t) option (** Contents of the [[@@expect.uncaught_exn]] node, if any. *) -> trailing_test_id:Expectation_id.t (** ID to use for the test checking that there is no trailing output. *) -> exn_test_id:Expectation_id.t (** ID to use for the test checking for uncaught exns. *) -> description:string option (** The string on the LHS of the [let%expect_test] binding, if any; passed to [Ppx_inline_test_lib]. *) -> tags:string list (** Test tags from the LHS of the [let%expect_test] binding; passed to [Ppx_inline_test_lib]. *) -> inline_test_config:Ppx_inline_test_lib.config -> expectations:(Expectation_id.t, Test_node.t) List.Assoc.t (** An assoc list from unique IDs to [Test_node.t]s. These tests are registered in a global map for reachability checks. [Test_node.t]s are subsequently handled by their ID. *) -> (unit -> unit C.IO.t) (** A callback representing the RHS of the [let%expect_test] binding. *) -> unit end module For_external : sig (** Functions for other libraries to interact with expect tests. *) (** If there is an expect test running, perform a consuming read of the current output and return it without any sanitization or backtrace-checking. Note that this is different from the behavior of [[%expect.output]], which does perform sanitization. If there is no test running, raise an error that includes [here]. *) val read_current_test_output_exn : here:Source_code_position.t -> string val am_running_expect_test : unit -> bool val default_cr_for_multiple_outputs : output_name:string -> outputs:string list -> string end (** Action to perform when exiting from a program that runs expect tests. Alerts of runtime failure if the program exited while executing an expect test. *) val at_exit : unit -> unit ppx_expect-0.17.2/runtime/test_node.ml000066400000000000000000000320471470323401700177700ustar00rootroot00000000000000open! Base open Types module Correction = struct type t = | New_payload : [< Expectation.Behavior_type.t ] Expectation.t * Output.Reconciled.t -> t | Unreachable : [ `Expect ] Expectation.t -> t (** [Some (loc, patch)] if [correction] warrants inserting [patch] into the rewritten file at [loc], [None] if no change is needed from [correction]. *) let to_patch_opt ~(expect_node_formatting : Expect_node_formatting.t) correction = match correction with | New_payload ( { position ; behavior ; on_incorrect_output = T on_incorrect_output ; inconsistent_outputs_message = _ ; payload_type = _ } , test_output ) -> let whitespace = match position with | Insert { body_loc = { start_pos; start_bol; _ }; _ } -> (* [let_offset] is the space until the layer of indentation of the [let%expect_test] binding. *) let let_offset = start_pos - start_bol in (* The contents of the expect node are indented an additional two spaces past the node itself. *) let indent = let_offset + match on_incorrect_output.kind with | Extension -> expect_node_formatting.indent | Attribute -> 0 in let whitespace = "\n" ^ String.make indent ' ' in whitespace | Overwrite _ -> "" in let tag = match behavior with | Expect { payload = { tag; _ }; on_unreachable = _; reachability = _ } -> tag | Unreachable _ -> String_node_format.Delimiter.default in let loc, correction = match position, on_incorrect_output with | ( Overwrite { payload = Some payload_loc; whole_node = _ } , { kind = Extension; hand = Longhand; name = _ } ) -> let correction = Output.to_formatted_payload ~tag test_output |> Output.Payload.to_source_code_string in payload_loc, correction | (Overwrite { payload = _; whole_node = loc } | Insert { loc; body_loc = _ }), _ -> ( loc , Output.to_source_code_string ~expect_node_formatting ~node_shape:(T on_incorrect_output) ~tag test_output ) in Some (loc, whitespace ^ correction) | Unreachable { behavior = Expect { on_unreachable; payload = _; reachability = _ } ; on_incorrect_output = T on_incorrect_output ; position ; inconsistent_outputs_message = _ ; payload_type = _ } -> let loc = Expectation.Insert_loc.loc position in (match on_unreachable with | Silent -> None | Delete -> Some (loc, "") | Replace_with_unreachable -> let prefix = match on_incorrect_output.kind with | Extension -> expect_node_formatting.extension_sigil | Attribute -> expect_node_formatting.attribute_sigil in Some (loc, Printf.sprintf "[%sexpect.unreachable]" prefix)) ;; let to_diffs ~expect_node_formatting ~original_file_contents correction = let safe_byte_get string i = if i >= 0 && i < String.length string then Some (String.get string i) else None in match to_patch_opt ~expect_node_formatting correction with | None -> [] | Some (loc, diff) -> let ({ start_bol; start_pos; end_pos } : Compact_loc.t) = loc in let main_correction = [ loc, diff ] in (* Additional corrections necessary for producing correct formatting *) let additional_corrections = (* If deleting an [[@@expect.uncaught_exn]] attribute would leave an empty line, delete that line. *) let remove_empty_line_from_deleted_uncaught_exn = match correction with | Unreachable { on_incorrect_output = T { kind = Attribute; _ }; _ } -> (match ( safe_byte_get original_file_contents (start_pos - 1) , safe_byte_get original_file_contents end_pos ) with | Some '\n', (None | Some '\n') -> Some ( { Compact_loc.start_pos = start_pos - 1 ; end_pos = start_pos ; start_bol } , "" ) | _ -> None) | _ -> None in (* Include the semicolon needed at the end of the body for a trailing [[%expect]] extension point. *) let add_semicolon_before_trailing_expect = match correction with | New_payload ( { on_incorrect_output = T { kind = Extension; _ } ; position = Insert { body_loc; _ } ; _ } , _ ) -> Some ({ body_loc with start_pos = body_loc.end_pos }, ";") | _ -> None in List.concat_map ~f:Option.to_list [ remove_empty_line_from_deleted_uncaught_exn ; add_semicolon_before_trailing_expect ] in additional_corrections @ main_correction ;; end type one_output = { result : Output.Test_result.t ; raw : string } type one_run = | Reached_with_output of one_output | Did_not_reach type 'behavior inner = | Test : { expectation : ([< Expectation.Behavior_type.t ] as 'behavior) Expectation.t ; results : one_run Queue.t ; mutable reached_this_run : bool } -> 'behavior inner type t = T : 'behavior inner -> t let to_correction ~expect_node_formatting ~cr_for_multiple_outputs (T (Test { expectation; results; reached_this_run = _ })) : Correction.t option = let results_list = Queue.to_list results in let unreached_list, outputs_list = List.partition_map results_list ~f:(function | Did_not_reach -> First () | Reached_with_output output -> Second output) in let distinct_outputs = (* Allow distinct raw outputs as long as their formatted [result]s are considered equivalent according to [Payload_type]. *) List.dedup_and_sort ~compare: (Comparable.lift ~f:(fun { result; _ } -> result) Output.Test_result.compare) outputs_list in let was_reached = List.is_empty unreached_list in let reachability_behavior = match expectation.behavior with | Expect { reachability; payload = _; on_unreachable = _ } -> reachability | Unreachable { reachability_of_corrected } -> reachability_of_corrected in let correction_for_single_result : Output.Test_result.t -> Correction.t option = function | Pass -> None | Fail received -> Some (New_payload (expectation, received)) in match distinct_outputs, (was_reached, reachability_behavior) with | [], (_, _) -> (* The test was never reached *) (match expectation.behavior with | Unreachable _ -> None | Expect _ as behavior -> (* Error if an expect test was not reached *) Some (Unreachable (Expectation.with_behavior expectation behavior))) | [ { result; _ } ], (true, _ | _, Can_reach) -> (* The test only produced one unique result and: - The test never failed to be reached OR - The test sometimes failed to be reached, but the test is marked as [Can_reach] (or rewrites to one marked as [Can_reach]) so that's OK *) correction_for_single_result result | _ :: _ :: _, _ | _, (false, Must_reach) -> (* The test results were inconsistent because: - The test was reached multiple times with different outputs OR - The test was sometimes reached and sometimes not, but the test rewrites to a test marked as [Must_reach] *) let outputs = results_list |> List.map ~f:(function | Reached_with_output { raw; _ } -> raw | Did_not_reach -> Printf.sprintf "" expectation.inconsistent_outputs_message) in cr_for_multiple_outputs ~output_name:expectation.inconsistent_outputs_message ~outputs |> Output.Formatter.apply (Expectation.formatter ~expect_node_formatting expectation) |> Output.fail |> correction_for_single_result ;; let record_and_return_result (type behavior) ~expect_node_formatting ~failure_ref ~test_output_raw (Test ({ expectation; results; reached_this_run = _ } as t) : behavior inner) = let test_output = Output.Formatter.apply (Expectation.formatter ~expect_node_formatting expectation) test_output_raw in let (result : Output.Test_result.t), (tag : String_node_format.Delimiter.t) = match expectation.behavior with | Unreachable _ -> Output.fail test_output, T (Tag "") | Expect { payload = { contents; tag }; on_unreachable = _; reachability = _ } -> Output.reconcile ~expected_output:contents ~test_output, tag in (match result with | Fail _ -> failure_ref := true | Pass -> ()); Queue.enqueue results (Reached_with_output { result; raw = test_output_raw }); t.reached_this_run <- true; result, tag ;; let of_expectation expectation = T (Test { expectation; results = Queue.create (); reached_this_run = false }) ;; let record_end_of_run t = let (T (Test { expectation = _; results; reached_this_run })) = t in if not reached_this_run then Queue.enqueue results Did_not_reach ;; let record_result ~expect_node_formatting ~failure_ref ~test_output_raw (T inner) = ignore (record_and_return_result ~expect_node_formatting ~failure_ref ~test_output_raw inner : Output.Test_result.t * String_node_format.Delimiter.t) ;; module Global_results_table = struct type node = t type postprocess = node list Write_corrected_file.Patch_with_file_contents.t type file = { expectations : node Hashtbl.M(Expectation_id).t ; postprocess : postprocess } let global_results_table : file Hashtbl.M(String).t = Hashtbl.create (module String) let find_test ~absolute_filename ~(test_id : Expectation_id.t) = Hashtbl.find global_results_table absolute_filename |> Option.bind ~f:(fun { expectations; _ } -> Hashtbl.find expectations test_id) |> Option.value_exn ~error: (Error.of_string (Printf.sprintf "Internal expect test bug: could not find test\nFile: %s\nID: %d" absolute_filename (Expectation_id.to_int_exn test_id))) ;; let initialize_and_register_tests ~absolute_filename tests postprocess = let tests_as_in_table = Queue.create () in Hashtbl.update global_results_table absolute_filename ~f:(fun file -> let file = Option.value file ~default:{ expectations = Hashtbl.create (module Expectation_id); postprocess } in let tests = Hashtbl.of_alist_exn (module Expectation_id) tests in Hashtbl.merge_into ~src:tests ~dst:file.expectations ~f:(fun ~key:test_id new_test existing_test -> let (T (Test t) as test) = Option.value existing_test ~default:new_test in t.reached_this_run <- false; Queue.enqueue tests_as_in_table (test_id, test); Set_to test); file); Queue.to_list tests_as_in_table ;; let process_each_file ~f = global_results_table |> Hashtbl.to_alist |> List.sort ~compare:(Comparable.lift ~f:fst String.compare) |> List.map ~f:(fun (filename, { expectations; postprocess }) -> let test_nodes = Hashtbl.data expectations in f ~filename ~test_nodes ~postprocess) ;; end module Create = struct let expect ~formatting_flexibility ~node_loc ~located_payload = of_expectation (Expectation.expect ~formatting_flexibility ~node_loc ~located_payload) ;; let expect_exact ~formatting_flexibility ~node_loc ~located_payload = of_expectation (Expectation.expect_exact ~formatting_flexibility ~node_loc ~located_payload) ;; let expect_unreachable ~node_loc = of_expectation (Expectation.expect_unreachable ~node_loc) ;; end module For_mlt = struct let loc (T (Test { expectation = { position; _ }; results = _; reached_this_run = _ })) = Expectation.Insert_loc.loc position ;; let expectation_of_t (T (Test { expectation; results = _; reached_this_run = _ })) = match expectation.behavior with | Expect { payload = { contents; tag = _ }; on_unreachable = _; reachability = _ } -> Some contents | Unreachable _ -> None ;; let record_and_return_number_of_lines_in_correction ~expect_node_formatting ~failure_ref ~test_output_raw (T (Test inner)) = match record_and_return_result ~expect_node_formatting ~failure_ref ~test_output_raw (Test inner) with | Fail contents, tag -> let correction = Output.to_formatted_payload ~tag contents |> Output.Payload.to_source_code_string in Some (String.count ~f:(Char.equal '\n') correction + 1) | Pass, _ -> None ;; let to_diffs ~cr_for_multiple_outputs ~expect_node_formatting ~original_file_contents t = match to_correction ~expect_node_formatting ~cr_for_multiple_outputs t with | None -> [] | Some correction -> Correction.to_diffs correction ~expect_node_formatting ~original_file_contents ;; end ppx_expect-0.17.2/runtime/test_node.mli000066400000000000000000000117301470323401700201350ustar00rootroot00000000000000open! Base open Types (** Accumulator of test results for one expect node *) type t module Create : sig (** Functions for creating [t]s corresponding to each of the test nodes that can be parsed out of extension points in a [let%expect_test]. Each of these creators accepts the location of the entire AST node associated with the e.g. [[%expect]] test. *) (** [[%expect _]] *) val expect : formatting_flexibility:Expect_node_formatting.Flexibility.t (** If tests should be flexible about formatting rules, the formatting rules that define this flexibility *) -> node_loc:Compact_loc.t (** Location of the [[%expect _]] node *) -> located_payload:(Output.Payload.t * Compact_loc.t) option (** The string payload and its location, if there is one *) -> t (** [[%expect_exact _]] *) val expect_exact : formatting_flexibility:Expect_node_formatting.Flexibility.t (** If tests should be flexible about formatting rules, the formatting rules that define this flexibility *) -> node_loc:Compact_loc.t (** Location of the [[%expect_exact _]] node *) -> located_payload:(Output.Payload.t * Compact_loc.t) option (** The string payload and its location, if there is one *) -> t (** [[%expect.unreachable]] *) val expect_unreachable : node_loc:Compact_loc.t (** Location of the [[%expect.unreachable]] node *) -> t end (** Functions exported for use in other modules of the expect test runtime. *) val of_expectation : [< Expectation.Behavior_type.t ] Expectation.t -> t (** Updates reachedness information for [t]. *) val record_end_of_run : t -> unit (** Records the result of receiving output [test_output_raw] at [t], using [expect_node_formatting] to format the correction if necessary. If the output results in a correction, sets [failure_ref := true]. We use a [bool ref] argument instead of a [bool] return value to decrease the chance that failures in tests are accidentally dropped and make it more likely that they are correctly reported to e.g. the inline test runner harness. *) val record_result : expect_node_formatting:Expect_node_formatting.t -> failure_ref:bool ref -> test_output_raw:string -> t -> unit module Global_results_table : sig type node := t type postprocess := node list Write_corrected_file.Patch_with_file_contents.t (** Given an assoc list mapping [Expectation_id.t]s to fresh [Test_node.t]s, the [absolute_filename] of the file whence these tests originate, and the [postprocess] closure to run after all tests in that file finish: 1. Store the [postprocess] closure for [absolute_filename] 2. Add each test to the global tests registry if no test with that id has been registered for [absolute_filename] 3. For each test id, reset [reached_this_run] for that test 4. Return an assoc list from [Expectation_id.t]s to the [Test_node.t]s that will actually be used during testing; for each test, this is the same [Test_node.t] that was passed in if that test has not yet been registered, and otherwise the [Test_node.t] that was already in the table *) val initialize_and_register_tests : absolute_filename:string -> (Expectation_id.t, node) List.Assoc.t -> postprocess -> (Expectation_id.t, node) List.Assoc.t val find_test : absolute_filename:string -> test_id:Expectation_id.t -> node val process_each_file : f:(filename:string -> test_nodes:node list -> postprocess:postprocess -> 'a) -> 'a list end module For_mlt : sig (** Functions exported for use in toplevel expect tests *) (** The string that this test node "expects" if it is an [[%expect]] or [[%expect_exact]] node. [None] if it is an [[%expect.unreachable]]. *) val expectation_of_t : t -> string option (** Records the test result of receiving the raw test output [test_output_raw]. If the test "fails" (the output is not considered to match the expectation), sets [failure_ref := true] and returns the number of lines that will be spanned by inserted correction. If the test "passes", does not update [failure_ref] and returns [None]. *) val record_and_return_number_of_lines_in_correction : expect_node_formatting:Expect_node_formatting.t -> failure_ref:bool ref -> test_output_raw:string -> t -> int option (** The location of the AST extension node associated with this test. *) val loc : t -> Compact_loc.t (** Retrieves the corrections that need to be made to the original source file based on the test results collected in this test node so far. Returns a list of pairs containing the location of the character range to overwrite and the string to write at that location. *) val to_diffs : cr_for_multiple_outputs:(output_name:string -> outputs:string list -> string) -> expect_node_formatting:Expect_node_formatting.t -> original_file_contents:string -> t -> (Compact_loc.t * string) list end ppx_expect-0.17.2/runtime/types.ml000066400000000000000000000044311470323401700171440ustar00rootroot00000000000000open! Base module Compact_loc = struct type t = { start_bol : int ; start_pos : int ; end_pos : int } let equal a b = a.start_bol = b.start_bol && a.start_pos = b.start_pos && a.end_pos = b.end_pos ;; let compare_character_range = Comparable.lexicographic [ Comparable.lift compare_int ~f:(fun t -> t.start_pos) ; Comparable.lift compare_int ~f:(fun t -> t.end_pos) ] ;; end module Expect_node_formatting = struct type t = { indent : int ; always_on_own_line : bool ; extension_sigil : string ; attribute_sigil : string } let default = { indent = 2 ; always_on_own_line = false ; extension_sigil = "%" ; attribute_sigil = "@@" } ;; module Flexibility = struct type nonrec t = | Flexible_modulo of t | Exactly_formatted end end module Virtual_loc = struct type t = { loc : Compact_loc.t ; body_loc : Compact_loc.t } end module Expectation_id = struct include Int let mint = let counter = ref 0 in fun () -> let id = !counter in counter := id + 1; id ;; end module String_node_format = struct type longhand = Longhand type shorthand = Shorthand module Hand = struct type _ t = | Longhand : longhand t | Shorthand : shorthand t end module Kind = struct type _ t = | Attribute : longhand t | Extension : _ t end module Shape = struct type 'hand unpacked = { name : string ; hand : 'hand Hand.t ; kind : 'hand Kind.t } type t = T : _ unpacked -> t [@@unboxed] end module Delimiter = struct type _ unpacked = | Quote : longhand unpacked | Tag : string -> _ unpacked type t = T : _ unpacked -> t [@@unboxed] let default = T (Tag "") let longhand = function | T ((Quote | Tag _) as unpacked) -> unpacked ;; let shorthand = function | T (Tag _ as unpacked) -> unpacked | T Quote -> Tag "" ;; let handed : type a. t -> a Hand.t -> a unpacked = fun t hand -> match hand with | Longhand -> longhand t | Shorthand -> shorthand t ;; end type 'a unpacked = { shape : 'a Shape.unpacked ; delimiter : 'a Delimiter.unpacked } type t = T : _ unpacked -> t [@@unboxed] end ppx_expect-0.17.2/runtime/types.mli000066400000000000000000000140621470323401700173160ustar00rootroot00000000000000open! Base module Expect_node_formatting : sig (** Configurations for the formatting of rewritten expect nodes and attributes. The values in [default] are used by [ppx_expect], but different values can be used by other clients of the expect test runtime. *) type t = { indent : int (** The number of spaces that the bodies of [[%expect]] nodes are indented with respect to the left edge of the extension point and that trailing [[%expect]] nodes are indented with respect to the enclosing [let%expect] *) ; always_on_own_line : bool (** Whether the output of [[%expect]] nodes should always be formatted so it gets its own lines, even if it is only one line long. If this option is true, one-line expectations will be printed like {v [%expect {| foo |}] v} rather than like {v [%expect {| foo |}] v} *) ; extension_sigil : string (** The sigil that should be printed to signal the start of an extension point. By default, this is ["%"], though in toplevel tests it changes to ["%%"]. *) ; attribute_sigil : string (** The sigil that should be printed to signal the start of an attribute. By default, this is ["@@"]. *) } (** The default formatting configuration used in expect tests. *) val default : t module Flexibility : sig type expect_node_formatting := t type t = | Flexible_modulo of expect_node_formatting | Exactly_formatted end end module Compact_loc : sig (** A range of characters in a source file. Notably, [Compact_loc.t] does not store the name of the file itself; it only represents the range of characters. Consider this diagram, where the characters [/[a-b]/] represent the included range, and the characters [/[.0]/] represent the surrounding text: {v ....... 0.........a----- ------------ -----b ......... v} Then [start_bol] is the position of [0], [start_pos] of [a], and [end_pos] of [b]. This record corresponds to a [Ppxlib.Location.t] restricted to just the [loc_start.pos_cbol], [loc_start.pos_cnum], and [loc_end.pos_cnum] fields. *) type t = { start_bol : int (** Index of the first character of the first line in the range. *) ; start_pos : int (** Index of the first character in the range. *) ; end_pos : int (** Index of the last character in the range. *) } (** [Compact_loc.t] satisfies the natural definition of equality. We write it by hand only to minimize external dependencies. *) val equal : t -> t -> bool (** Compares the range of characters spanned by a [Compact_loc.t]. Ranges that start earlier are considered smaller. For ranges that start at the same position, ranges that end earlier are considered smaller. *) val compare_character_range : t -> t -> int end module Virtual_loc : sig (** Information that should be taken into account when inserting and formatting "virtual" test nodes that do not appear in the original file, like [[@@expect.uncaught_exn]] nodes and [[%expect]] nodes with the trailing output of a test. *) type t = { loc : Compact_loc.t (** The location where the expect node should be inserted on failure *) ; body_loc : Compact_loc.t (** The location spanning from the beginning of the [let%expect_test] binding to the end of the expression in the body of the test. *) } end module Expectation_id : sig (** An identifier for a test node. Each test node that was parsed from an extension point or attribute ([[%expect]], [[%expect_exact]], [[%expect.unreachable]], or [[%expect.uncaught_exn]]) or that might be added into the corrected file (e.g. a [[%expect]] for trailing output) is associated with a unique [t]. *) type t include Intable.S with type t := t include Hashable.Key with type t := t (** Create a new [t]. Calls to [mint] will give distinct ids, but uniqueness is not guaranteed if [of_int_exn] is used to create an id. *) val mint : unit -> t end module String_node_format : sig (** The syntactic format of attributes and extension points carrying string payloads. *) (** Phantom type for longhand syntax: [[%foo {||}]] or [[@foo {||}]]. *) type longhand = Longhand (** Phantom type for shorthand syntax: [{%foo||}]. *) type shorthand = Shorthand module Hand : sig (** "Handedness" of syntax: longhand or shorthand, as described above. **) type _ t = | Longhand : longhand t | Shorthand : shorthand t end module Kind : sig (** Kind of node: attribute or extension. There is no shorthand for attributes with string payloads, so attributes can only be longhand here. *) type _ t = | Attribute : longhand t | Extension : _ t end module Shape : sig (** Shape of a string node: its name (e.g. "expect"), handedness, and node kind. This is preserved when rewriting the node. *) type 'hand unpacked = { name : string ; hand : 'hand Hand.t ; kind : 'hand Kind.t } type t = T : _ unpacked -> t [@@unboxed] end module Delimiter : sig (** Delimiter around string constant. *) type _ unpacked = | Quote : longhand unpacked (** Quoted strings, e.g. ["foo"]. *) | Tag : string -> _ unpacked (** Tagged strings, e.g. [{tag|foo|tag}]. *) type t = T : _ unpacked -> t [@@unboxed] (** Default delimiter: [T (Tag "")]. *) val default : t (** If given [Quoted] and [Shorthand], produces [Tag ""]. In any other case, produces the given delimiter. *) val handed : t -> 'a Hand.t -> 'a unpacked end (** Format of a string node: its shape, and a compatible delimiter. We preserve its shape across rewrites, but may have to change its delimiter. For example, if [{bar|foo|bar}] needs to match ["bar"], we must replace its tag. *) type 'a unpacked = { shape : 'a Shape.unpacked ; delimiter : 'a Delimiter.unpacked } type t = T : _ unpacked -> t [@@unboxed] end ppx_expect-0.17.2/runtime/write_corrected_file.ml000066400000000000000000000074501470323401700221670ustar00rootroot00000000000000open! Base open Types module Patch_with_file_contents = struct type 'a t = original_file_contents:string -> 'a -> (Compact_loc.t * string) list end let rewrite_corrections ~original_file_contents ~corrections = (* Ensure that we encounter the corrections in order as we build up the file. *) let corrections = List.sort ~compare:(Comparable.lift Compact_loc.compare_character_range ~f:fst) corrections in let l_pos, strs = List.fold_map corrections ~init:0 ~f:(fun l_pos ({ start_pos; end_pos; start_bol = _ }, correction) -> let code_chunk = String.sub original_file_contents ~pos:l_pos ~len:(start_pos - l_pos) in end_pos, [ code_chunk; correction ]) in let result = List.concat strs |> String.concat in let rest = String.subo original_file_contents ~pos:l_pos in result ^ rest ;; let f ~use_color ~in_place ~diff_command ~diff_path_prefix ~filename ~with_ corrections : Ppx_inline_test_lib.Test_result.t = let dot_corrected = filename ^ ".corrected" in let original_file_contents = let in_channel = Stdlib.open_in_bin filename in let contents = Stdlib.really_input_string in_channel (Stdlib.in_channel_length in_channel) in Stdlib.close_in in_channel; contents in let remove file = if Stdlib.Sys.file_exists file then Stdlib.Sys.remove file in let corrections = with_ ~original_file_contents corrections in let next_contents = rewrite_corrections ~original_file_contents ~corrections in match in_place with | true -> if not (String.equal original_file_contents next_contents) then Stdio.Out_channel.write_all filename ~data:next_contents; remove dot_corrected; Success | false -> (match diff_command with | Some "-" (* Just write the .corrected file - do not output a diff. *) -> Stdio.Out_channel.write_all dot_corrected ~data:next_contents; Success | _ -> (* By invoking [Make_corrected_file.f] with a fresh temporary file, we avoid the following possible race between inline_test_runners A and B: 1. A runs test T1 and generates next contents C1. 2. B runs test T2 and generates next contents C2. 3. A writes C1 to the .corrected file. 4. B writes C2 to the .corrected file. 5. A diffs the .corrected file against the original file and reports the result. It thinks it is reporting the diff produced by T1, but is in fact reporting the diff produced by T2. The key aspect of using temporary files is that even if in the above scenario the final contents of the .corrected file are C2, the diff reported by A comes from its tmp file and will still be the diff produced by T1. *) let tmp_corrected = Stdlib.Filename.temp_file (Stdlib.Filename.basename filename) ".corrected.tmp" ~temp_dir:(Stdlib.Filename.dirname filename) in (match Make_corrected_file.f ~use_color ?diff_command ?diff_path_prefix ~corrected_path:tmp_corrected ~next_contents ~path:filename () with | Ok _ -> (* Even though this execution of the expect test ran without making corrections, we should delete any old [.corrected] files that are left over from previous builds. In particular, hydra relies on this behavior for flaky tests; if the test fails the first time and passes the second, the second run should make sure the [.corrected] file is not lingering in the sandbox. *) remove dot_corrected; remove tmp_corrected; Success | Error _ -> Stdlib.Sys.rename tmp_corrected dot_corrected; Failure)) ;; ppx_expect-0.17.2/runtime/write_corrected_file.mli000066400000000000000000000012701470323401700223320ustar00rootroot00000000000000open! Base open Types (** The callback expected by [f], which should convert the input to patches and is allowed to access the contents of the original file while doing so. *) module Patch_with_file_contents : sig type 'a t = original_file_contents:string -> 'a -> (Compact_loc.t * string) list end (** Build a list of diffs to a file using [with_], then apply them to the file contents and write a [.corrected] file. Exported for use by toplevel tests. *) val f : use_color:bool -> in_place:bool -> diff_command:string option -> diff_path_prefix:string option -> filename:string -> with_:'a Patch_with_file_contents.t -> 'a -> Ppx_inline_test_lib.Test_result.t ppx_expect-0.17.2/src/000077500000000000000000000000001470323401700145505ustar00rootroot00000000000000ppx_expect-0.17.2/src/dune000066400000000000000000000005671470323401700154360ustar00rootroot00000000000000(library (name ppx_expect) (public_name ppx_expect) (kind ppx_rewriter) (libraries base ppxlib ppx_expect_runtime ppx_inline_test ppx_inline_test.libname ppx_here.expander) (ppx_runtime_libraries ppx_expect.runtime ppx_expect.config) (preprocess (pps ppxlib.metaquot)) (inline_tests.backend (runner_libraries ppx_expect.evaluator) (extends ppx_inline_test))) ppx_expect-0.17.2/src/ppx_expect.ml000066400000000000000000000254051470323401700172670ustar00rootroot00000000000000open! Base open Ppxlib open Ast_builder.Default open Ppx_expect_runtime let strict_indent = ref false module Expr = struct let option ~loc expression_of_a = function | Some x -> [%expr Some [%e expression_of_a ~loc x]] | None -> [%expr None] ;; let pair ~loc expression_of_a expression_of_b (a, b) = [%expr [%e expression_of_a ~loc a], [%e expression_of_b ~loc b]] ;; let delimiter ~loc (delimiter : Delimiter.t) = [%expr ([%e match delimiter with | T Quote -> [%expr T Quote] | T (Tag tag) -> [%expr T (Tag [%e estring ~loc tag])]] : Ppx_expect_runtime.Delimiter.t)] ;; let id ~loc id = [%expr Ppx_expect_runtime.Expectation_id.of_int_exn [%e eint ~loc (Expectation_id.to_int_exn id)]] ;; let compact_loc ~loc ({ start_bol; start_pos; end_pos } : Compact_loc.t) = [%expr { start_bol = [%e eint ~loc start_bol] ; start_pos = [%e eint ~loc start_pos] ; end_pos = [%e eint ~loc end_pos] }] ;; let payload ~loc ({ contents; tag } : Payload.t) = [%expr { contents = [%e estring ~loc contents]; tag = [%e delimiter ~loc tag] }] ;; let id_expr_alist ~loc alist = List.map alist ~f:(fun (expect_id, expr) -> [%expr [%e id ~loc expect_id], [%e expr]]) |> elist ~loc ;; let flexibility_of_strictness ~loc = if !strict_indent then [%expr Ppx_expect_runtime.Expect_node_formatting.Flexibility.Exactly_formatted] else [%expr Ppx_expect_runtime.Expect_node_formatting.Flexibility.Flexible_modulo Ppx_expect_runtime.Expect_node_formatting.default] ;; end let compact_loc_of_ppxlib_location { loc_start; loc_end; loc_ghost = _ } : Compact_loc.t = { start_bol = loc_start.pos_bol ; start_pos = loc_start.pos_cnum ; end_pos = loc_end.pos_cnum } ;; module Expectation_node = struct type expect_node_info = { located_payload : (Payload.t * Compact_loc.t) option ; node_loc : Compact_loc.t } type t = | Expect of expect_node_info | Expect_exact of expect_node_info | Expect_unreachable of Compact_loc.t let to_expr ~loc t = let qualify_name node_name = pexp_ident ~loc (Located.lident ~loc ("Ppx_expect_runtime.Test_node.Create." ^ node_name)) in let make_expect_node node_name { located_payload; node_loc } = [%expr [%e qualify_name node_name] ~formatting_flexibility:[%e Expr.flexibility_of_strictness ~loc] ~located_payload: [%e Expr.(option ~loc (pair payload compact_loc)) located_payload] ~node_loc:[%e Expr.compact_loc ~loc node_loc]] in match t with | Expect expect_node_info -> make_expect_node "expect" expect_node_info | Expect_exact expect_node_info -> make_expect_node "expect_exact" expect_node_info | Expect_unreachable node_loc -> [%expr [%e qualify_name "expect_unreachable"] ~node_loc:[%e Expr.compact_loc ~loc node_loc]] ;; end module Pattern = struct open Ast_pattern let string () = map (single_expr_payload (as__ (pexp_constant (pconst_string __ __ __)))) ~f:(fun f payload_expr contents _loc tag -> let (tag : Delimiter.t) = match tag with | None -> T Quote | Some tag -> T (Tag tag) in let payload_loc = compact_loc_of_ppxlib_location payload_expr.pexp_loc in let located_payload = Some (({ contents; tag } : Payload.t), payload_loc) in f ~located_payload) ;; let empty () = pstr nil let maybe_string () = string () ||| map (empty ()) ~f:(fun f -> f ~located_payload:None) end let maybe_string_payload = Pattern.maybe_string module Parsed_node = struct type t = | Expectation_node of Expectation_id.t * Expectation_node.t | Output let expect = Extension.Expert.declare "expect" Expression (Pattern.maybe_string ()) (fun ~located_payload node_loc -> Expectation_node (Expectation_id.mint (), Expect { located_payload; node_loc })) ;; let expect_exact = Extension.Expert.declare "expect_exact" Expression (Pattern.maybe_string ()) (fun ~located_payload node_loc -> Expectation_node (Expectation_id.mint (), Expect_exact { located_payload; node_loc })) ;; let expect_output = Extension.Expert.declare "@expect.output" Expression (Pattern.empty ()) (fun _ -> Output) ;; let expect_unreachable = Extension.Expert.declare "@expect.unreachable" Expression (Pattern.empty ()) (fun compact_loc -> Expectation_node (Expectation_id.mint (), Expect_unreachable compact_loc)) ;; let expectations = [ expect; expect_exact; expect_output; expect_unreachable ] let match_expectation e = match e.pexp_desc with | Pexp_extension extension -> Extension.Expert.convert expectations ~loc:e.pexp_loc extension | _ -> None ;; end let is_a_ppx_expect_ext_node e = Option.is_some (Parsed_node.match_expectation e) let replace_and_collect_expects = object inherit [(Expectation_id.t, expression) List.Assoc.t] Ast_traverse.fold_map as super method! expression ({ pexp_attributes; pexp_loc = loc; _ } as expr) acc = match Parsed_node.match_expectation expr with | None -> super#expression expr acc | Some expect_node -> let expr, acc = match expect_node (compact_loc_of_ppxlib_location loc) with | Expectation_node (id, expect_expr) -> ( [%expr Ppx_expect_test_block.run_test ~test_id:[%e Expr.id ~loc id]] , (id, Expectation_node.to_expr expect_expr ~loc) :: acc ) | Output -> [%expr Ppx_expect_test_block.read_test_output_no_backtrace_check ()], acc in Merlin_helpers.hide_expression { expr with pexp_attributes }, acc end ;; let transform_let_expect ~trailing_location ~tags ~expected_exn ~description ~loc body = let body, expectations = replace_and_collect_expects#expression body [] in let filename_rel_to_project_root = Ppx_here_expander.expand_filename loc.loc_start.pos_fname in let trailing_location = compact_loc_of_ppxlib_location trailing_location in let body_loc = compact_loc_of_ppxlib_location { loc_start = loc.loc_start; loc_end = body.pexp_loc.loc_end; loc_ghost = true } in let trailing_test_id = Expectation_id.mint () in let exn_test_id = Expectation_id.mint () in [%expr match Ppx_inline_test_lib.testing with | `Not_testing -> () | `Testing _ -> let module Ppx_expect_test_block = Ppx_expect_runtime.Make_test_block (Expect_test_config) in Ppx_expect_test_block.run_suite ~filename_rel_to_project_root:[%e estring ~loc filename_rel_to_project_root] ~line_number:[%e eint ~loc loc.loc_start.pos_lnum] ~location:[%e Expr.compact_loc ~loc (compact_loc_of_ppxlib_location loc)] ~trailing_loc:[%e Expr.compact_loc ~loc trailing_location] ~body_loc:[%e Expr.compact_loc ~loc body_loc] ~formatting_flexibility:[%e Expr.flexibility_of_strictness ~loc] ~expected_exn:[%e Expr.(option ~loc (pair payload compact_loc)) expected_exn] ~trailing_test_id:[%e Expr.id ~loc trailing_test_id] ~exn_test_id:[%e Expr.id ~loc exn_test_id] ~description:[%e Expr.option estring ~loc description] ~tags:[%e tags |> List.map ~f:(estring ~loc) |> elist ~loc] ~inline_test_config:(module Inline_test_config) ~expectations: [%e Merlin_helpers.hide_expression (Expr.id_expr_alist ~loc expectations)] (fun () -> [%e body])] ;; let let_expect_pat = let open Ast_pattern in let uncaught_exn = Attribute.declare_with_attr_loc "@expect.uncaught_exn" Attribute.Context.value_binding (Pattern.string ()) (fun ~attr_loc ~located_payload -> attr_loc, located_payload) in let opt_name = map (pstring __) ~f:(fun f x -> f ~name:(Some x)) ||| map ppat_any ~f:(fun f -> f ~name:None) in pstr (pstr_value nonrecursive (Attribute.pattern uncaught_exn (value_binding ~pat: (map (Attribute.pattern Ppx_inline_test.tags opt_name) ~f:(fun f attributes -> f ~tags:(Option.value ~default:[] attributes))) ~expr:__) ^:: nil) ^:: nil) ;; let expect_test = Extension.V3.declare_inline "expect_test" Structure_item let_expect_pat (fun ~ctxt trailing ~tags ~name code -> let loc = Ppxlib.Expansion_context.Extension.extension_point_loc ctxt in let loc = { loc with loc_ghost = true } in let trailing_location, expected_exn = match trailing with | Some (attr_loc, expected_exn) -> attr_loc, expected_exn | None -> { loc with loc_start = loc.loc_end }, None in Ppx_inline_test.validate_extension_point_exn ~name_of_ppx_rewriter:"ppx_expect" ~loc ~tags; transform_let_expect ~trailing_location ~tags ~expected_exn ~description:name ~loc code |> Ppx_inline_test.maybe_drop loc) ;; let () = Driver.add_arg "-expect-test-strict-indentation" (Bool (( := ) strict_indent)) ~doc: (Printf.sprintf "BOOL Require standardized indentation in [[%%expect]] (default: %b)" !strict_indent) ;; let () = Driver.register_transformation "expect_test" ~rules:[ Context_free.Rule.extension expect_test ] ~enclose_impl:(fun source_file_loc -> match source_file_loc, Ppx_inline_test_libname.get () with | Some loc, Some _ -> (* Insert the header and footer used for "current file" tracking only if: 1. The file is nonempty and 2. The executable is being built with the [-inline-test-lib _] flag, indicating that there is some library for which we might run expect tests. If the [-inline-test-lib] flag was not passed, then we shouldn't insert the header and footer, as we will not be running expect tests and the [Ppx_expect_runtime] library might not even be in scope (as is the case in toplevel expect tests, which are not run through [Ppx_inline_test_lib]). *) let loc = { loc with loc_ghost = true } in let filename_rel_to_project_root = Ppx_here_expander.expand_filename loc.loc_start.pos_fname in let header = let loc = { loc with loc_end = loc.loc_start } in Ppx_inline_test.maybe_drop loc [%expr Ppx_expect_runtime.Current_file.set ~filename_rel_to_project_root: [%e estring ~loc filename_rel_to_project_root]] and footer = let loc = { loc with loc_start = loc.loc_end } in Ppx_inline_test.maybe_drop loc [%expr Ppx_expect_runtime.Current_file.unset ()] in header, footer | _ -> [], []) ;; ppx_expect-0.17.2/src/ppx_expect.mli000066400000000000000000000010431470323401700174300ustar00rootroot00000000000000open! Base open Ppxlib open Ppx_expect_runtime val compact_loc_of_ppxlib_location : location -> Compact_loc.t (** Matches an extension point payload that is either empty or a single string literal. The extracted information is the [Payload.t] and its [Compact_loc.t] representing the string literal from the payload if present, or [{||}] and [None] if not. *) val maybe_string_payload : unit -> (payload, located_payload:(Payload.t * Compact_loc.t) option -> 'a, 'a) Ast_pattern.t val is_a_ppx_expect_ext_node : expression -> bool ppx_expect-0.17.2/test/000077500000000000000000000000001470323401700147405ustar00rootroot00000000000000ppx_expect-0.17.2/test/bad_test.ml000066400000000000000000000023071470323401700170610ustar00rootroot00000000000000module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end let get_a_trace () = let rec loop n = if n < 0 then Printexc.get_callstack 10, 0 else ( let x, y = loop (n - 1) in x, y + 1) in let trace, _ = loop 10 in trace ;; let print_slot trace n = match Printexc.backtrace_slots trace with | None -> assert false | Some slots -> let slot = slots.(n) in (match Printexc.Slot.format 0 slot with | None -> assert false | Some str -> print_endline str) ;; let%expect_test (_ [@tags "no-js"]) = (* We create a backtrace with 10 identical slots and then only print the 5th slot. Otherwise flambda and non-flambda compilers create slightly different backtraces. *) let trace = get_a_trace () in print_slot trace 5; [%expect {| (* expect_test_collector: This test expectation appears to contain a backtrace. This is strongly discouraged as backtraces are fragile. Please change this test to not include a backtrace. *) Raised by primitive operation at Ppx_expect_test__Bad_test.get_a_trace.loop in file "bad_test.ml", line 12, characters 17-29 |}] ;; ppx_expect-0.17.2/test/bad_test.mli000066400000000000000000000000551470323401700172300ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/dune000066400000000000000000000002431470323401700156150ustar00rootroot00000000000000(library (foreign_stubs (language c) (names non_flushing)) (name ppx_expect_test) (flags :standard -principal) (preprocess (pps ppx_assert ppx_expect))) ppx_expect-0.17.2/test/escaped_strings.ml000066400000000000000000000011061470323401700204450ustar00rootroot00000000000000let%expect_test "escaped carriage return" = print_string "a\r\nb"; [%expect " \n a\n b\n "]; print_string "a\r\nb"; [%expect_exact "a\r\nb"] ;; let%expect_test "escaped tab" = print_string "a\tb"; [%expect "a\tb"]; print_string "a\tb"; [%expect_exact "a\tb"] ;; let%expect_test "escaped quote" = print_string "a\"b"; [%expect "a\"b"]; print_string "a\"b"; [%expect_exact "a\"b"] ;; let%expect_test "escaped trailing carriage return" = print_string "a\r\nb\r\n"; [%expect " \n a\n b\n "]; print_string "a\r\nb\r\n"; [%expect_exact "a\r\nb\r\n"] ;; ppx_expect-0.17.2/test/escaped_strings.mli000066400000000000000000000000551470323401700206200ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/000077500000000000000000000000001470323401700163735ustar00rootroot00000000000000ppx_expect-0.17.2/test/example/chdir.ml000066400000000000000000000002761470323401700200230ustar00rootroot00000000000000(* The test framework should be resilient to user changing the current directory. *) let%expect_test _ = print_string "hello world\n"; Unix.chdir ".."; [%expect {| hello world |}] ;; ppx_expect-0.17.2/test/example/chdir.mli000066400000000000000000000000551470323401700201670ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/control_chars.ml000066400000000000000000000020321470323401700215620ustar00rootroot00000000000000open Core (* This test contains control chars literally in the ML source. Keep this test separate from other tests in [tests.ml] because the control chars seem to provoke odd behaviour when running commands like [hg diff] *) let%expect_test _ = let chars0_to_32 () = let s = List.range 0 32 |> List.map ~f:(fun i -> String.of_char (Char.of_int_exn i)) (* We use a [sep] to avoid having a trailing tab char in the expected output, which would be hard to write below, because our editors trim trailing whitespace. *) |> String.concat ~sep:"x" in print_string s in chars0_to_32 (); [%expect_exact "\000x\001x\002x\003x\004x\005x\006x\007x\008x\009x\010x\011x\012x\013x\014x\015x\016x\017x\018x\019x\020x\021x\022x\023x\024x\025x\026x\027x\028x\029x\030x\031"]; chars0_to_32 (); [%expect_exact "xxxxxxxxx\tx\nx x x xxxxxxxxxxxxxxxxxx"]; chars0_to_32 (); [%expect {| xxxxxxxxx x x x x xxxxxxxxxxxxxxxxxx |}] ;; ppx_expect-0.17.2/test/example/control_chars.mli000066400000000000000000000000551470323401700217360ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/dune000066400000000000000000000005071470323401700172530ustar00rootroot00000000000000(library (name expect_test_examples) (libraries core async) (preprocess (pps ppx_jane))) (rule (targets tabs.ml) (deps (:first_dep tabs.ml.in) jbuild) (action (bash "cp %{first_dep} %{targets}; %{bin:apply-style} -directory-config jbuild -in-place %{targets}"))) (alias (name DEFAULT) (deps tests.ml.pp)) ppx_expect-0.17.2/test/example/flexible_whitespace.ml000066400000000000000000000002071470323401700227320ustar00rootroot00000000000000let%expect_test _ = print_string " Be more"; [%expect {| Be more |}]; print_string "\nflexible\n"; [%expect {| flexible |}] ;; ppx_expect-0.17.2/test/example/flexible_whitespace.mli000066400000000000000000000000551470323401700231040ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/function.ml000066400000000000000000000003551470323401700205550ustar00rootroot00000000000000let%expect_test _ = let f output = print_string output; [%expect {| hello world |}] in f "hello world"; f "hello world" ;; let%expect_test _ = let f () = print_string ""; [%expect {| |}] in f (); f () ;; ppx_expect-0.17.2/test/example/function.mli000066400000000000000000000000551470323401700207230ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/functor.ml000066400000000000000000000002251470323401700204040ustar00rootroot00000000000000module M () = struct let%expect_test _ = print_string "hello world"; [%expect {| hello world |}] ;; end module A = M () module B = M () ppx_expect-0.17.2/test/example/hello_async.ml000066400000000000000000000002401470323401700212210ustar00rootroot00000000000000open Core open Async let%expect_test _ = List.iter [ "hello, "; "world"; "!" ] ~f:(fun s -> print_string s); [%expect {| hello, world! |}]; return () ;; ppx_expect-0.17.2/test/example/hello_async.mli000066400000000000000000000000551470323401700213760ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/reordered.ml000066400000000000000000000002151470323401700206760ustar00rootroot00000000000000let%expect_test _ = let f () = print_string "bar"; [%expect {| bar |}] in print_string "foo"; [%expect {| foo |}]; f () ;; ppx_expect-0.17.2/test/example/reordered.mli000066400000000000000000000000551470323401700210510ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/space_nine.ml000066400000000000000000000025161470323401700210350ustar00rootroot00000000000000(* Demonstate use of [%expect] to match a single line of text with 0|1|2 leading & trailing NLs. The text begins with a single space. Starting with.. {[ let%expect_test _ = print_string " hello"; [%expect{||}]; print_string " hello\n"; [%expect{||}]; print_string " hello\n\n"; [%expect{||}]; print_string "\n hello"; [%expect{||}]; print_string "\n hello\n"; [%expect{||}]; print_string "\n hello\n\n"; [%expect{||}]; print_string "\n\n hello"; [%expect{||}]; print_string "\n\n hello\n"; [%expect{||}]; print_string "\n\n hello\n\n"; [%expect{||}]; ;; ]} Generate with [cp space_nine.ml.corrected space_nine.ml] the following [%expect]... *) let%expect_test _ = print_string " hello"; [%expect_exact " hello"]; print_string " hello\n"; [%expect_exact " hello\n"]; print_string " hello\n\n"; [%expect_exact " hello\n\n"]; print_string "\n hello"; [%expect_exact "\n hello"]; print_string "\n hello\n"; [%expect_exact "\n hello\n"]; print_string "\n hello\n\n"; [%expect_exact "\n hello\n\n"]; print_string "\n\n hello"; [%expect_exact "\n\n hello"]; print_string "\n\n hello\n"; [%expect_exact "\n\n hello\n"]; print_string "\n\n hello\n\n"; [%expect_exact "\n\n hello\n\n"] ;; ppx_expect-0.17.2/test/example/space_nine.mli000066400000000000000000000000551470323401700212020ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/tabs.ml.in000066400000000000000000000005011470323401700202570ustar00rootroot00000000000000 (* Hydra doesn't like .ml files containing tab chars. So such examples need to go here *) let%expect_test _ = print_string " I have 8 spaces before me"; [%expect_exact {| I have 8 spaces before me|}]; print_string "\tI have a tab char before me"; [%expect_exact {| I have a tab char before me|}] ppx_expect-0.17.2/test/example/tabs.mli000066400000000000000000000000551470323401700200270ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/tests.ml000066400000000000000000000011001470323401700200570ustar00rootroot00000000000000open Core (* We may use other syntax extensions when writing expect tests. *) type t = int list [@@deriving sexp_of] let pr s = Printf.printf "%s\n" s let%expect_test "foo" = pr "line1"; pr (Sexp.to_string (sexp_of_t [ 1; 2; 3 ])); [%expect {| line1 (1 2 3) |}] ;; let%expect_test _ = print_string "hello, world!"; [%expect "hello, world!"] ;; let%expect_test _ = print_string "hello, world!"; [%expect_exact {|hello, world!|}] ;; let%expect_test _ = print_string "I need |}weird escaping"; [%expect {xxx| I need |}weird escaping |xxx}] ;; ppx_expect-0.17.2/test/example/tests.mli000066400000000000000000000000551470323401700202400ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/example/xnine.ml000066400000000000000000000024741470323401700200550ustar00rootroot00000000000000(* Demonstate use of [%expect_exact] to match a single line of text with 0|1|2 leading & trailing NLs. Starting with.. {[ let%expect_test _ = print_string "hello"; [%expect_exact ""]; print_string "hello\n"; [%expect_exact ""]; print_string "hello\n\n"; [%expect_exact ""]; print_string "\nhello"; [%expect_exact ""]; print_string "\nhello\n"; [%expect_exact ""]; print_string "\nhello\n\n"; [%expect_exact ""]; print_string "\n\nhello"; [%expect_exact ""]; print_string "\n\nhello\n"; [%expect_exact ""]; print_string "\n\nhello\n\n"; [%expect_exact ""]; ;; ]} Generate with [cp xnine.ml.corrected xnine.ml] the following [%expect_exact]... *) let%expect_test _ = print_string "hello"; [%expect_exact {|hello|}]; print_string "hello\n"; [%expect_exact "hello\n"]; print_string "hello\n\n"; [%expect_exact "hello\n\n"]; print_string "\nhello"; [%expect_exact "\nhello"]; print_string "\nhello\n"; [%expect_exact "\nhello\n"]; print_string "\nhello\n\n"; [%expect_exact "\nhello\n\n"]; print_string "\n\nhello"; [%expect_exact "\n\nhello"]; print_string "\n\nhello\n"; [%expect_exact "\n\nhello\n"]; print_string "\n\nhello\n\n"; [%expect_exact "\n\nhello\n\n"] ;; ppx_expect-0.17.2/test/example/xnine.mli000066400000000000000000000000551470323401700202170ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/explicit-strict-false/000077500000000000000000000000001470323401700211575ustar00rootroot00000000000000ppx_expect-0.17.2/test/explicit-strict-false/dune000066400000000000000000000001771470323401700220420ustar00rootroot00000000000000(library (name expect_test_explicit_no_strict_indent) (preprocess (pps ppx_expect -expect-test-strict-indentation=false))) ppx_expect-0.17.2/test/explicit-strict-false/negative-test/000077500000000000000000000000001470323401700237365ustar00rootroot00000000000000ppx_expect-0.17.2/test/explicit-strict-false/negative-test/dune000066400000000000000000000015521470323401700246170ustar00rootroot00000000000000(library (name expect_test_explicit_no_strict_indent_negative) (libraries ppx_expect_runtime) (preprocess (pps ppx_expect -expect-test-strict-indentation=false))) (rule (deps (:first_dep ./inline_tests_runner) ./inline_tests_runner.exe %{workspace_root}/bin/apply-style jbuild (glob_files *.ml)) (targets nine.ml.corrected test-output) (action (bash "\nrm -f *.ml.corrected 2>/dev/null\n! %{first_dep} -no-color > test-output 2>&1\nfor f in *.ml.corrected\ndo\n %{workspace_root}/bin/apply-style \\\n -directory-config jbuild \\\n -original-file $(basename $f .corrected) \\\n - < $f > $f.tmp\n mv $f.tmp $f\ndone\n"))) (rule (alias runtest) (deps nine.ml.corrected.expected nine.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps test-output.expected test-output) (action (bash "diff -a %{deps}"))) ppx_expect-0.17.2/test/explicit-strict-false/negative-test/nine.ml000066400000000000000000000033621470323401700252250ustar00rootroot00000000000000(* Show that, even when compiling with [-expect-test-strict-indentation=false], the issued corrected files makes the "fixed" expect blocks satisfy standard indentation rules *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| goodbye |}] ;; let () = print_string "hello\n"; [%expect {| goodbye |}] ;; let () = print_string "hello\n\n"; [%expect {| goodbye |}] ;; let () = print_string "\nhello"; [%expect {| goodbye|}] ;; let () = print_string "\nhello\n"; [%expect {| goodbye |}] ;; let () = print_string "\nhello\n\n"; [%expect {| goodbye |}] ;; let () = print_string "\n\nhello"; [%expect {| goodbye|}] ;; let () = print_string "\n\nhello\n"; [%expect {| goodbye |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| goodbye |}] ;; end in () ;; ppx_expect-0.17.2/test/explicit-strict-false/negative-test/nine.ml.corrected.expected000066400000000000000000000017141470323401700307750ustar00rootroot00000000000000(* Show that, even when compiling with [-expect-test-strict-indentation=false], the issued corrected files makes the "fixed" expect blocks satisfy standard indentation rules *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello |}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/explicit-strict-false/negative-test/test-output.expected000066400000000000000000000043251470323401700300020ustar00rootroot00000000000000------ nine.ml ++++++ nine.ml.corrected File "nine.ml", line 9, characters 0-1: |(* Show that, even when compiling with [-expect-test-strict-indentation=false], the issued | corrected files makes the "fixed" expect blocks satisfy standard indentation rules *) | |let%expect_test _ = | let module _ = struct | let () = | print_string "hello"; | [%expect -| {| -| goodbye -| |}] +| {| hello |}] | ;; | | let () = | print_string "hello\n"; | [%expect -| {| -| goodbye -| |}] +| {| hello |}] | ;; | | let () = | print_string "hello\n\n"; | [%expect -| {| -| goodbye -| -| |}] +| {| hello |}] | ;; | | let () = | print_string "\nhello"; | [%expect -| {| -| -| goodbye|}] +| {| hello |}] | ;; | | let () = | print_string "\nhello\n"; | [%expect -| {| -| -| goodbye -| |}] +| {| hello |}] | ;; | | let () = | print_string "\nhello\n\n"; | [%expect -| {| -| -| goodbye -| -| |}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello"; | [%expect -| {| -| -| -| goodbye|}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello\n"; | [%expect -| {| -| -| -| goodbye -| |}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello\n\n"; | [%expect -| {| -| -| -| goodbye -| -| |}] +| {| hello |}] | ;; | end | in | () |;; ppx_expect-0.17.2/test/explicit-strict-false/nine.ml000066400000000000000000000033051470323401700224430ustar00rootroot00000000000000(* Show that, when compiling with [-expect-test-strict-indentation=false], test blocks that match the output modulo indentation are not corrected. *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello|}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello|}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/explicit-strict-true/000077500000000000000000000000001470323401700210445ustar00rootroot00000000000000ppx_expect-0.17.2/test/explicit-strict-true/dune000066400000000000000000000001731470323401700217230ustar00rootroot00000000000000(library (name expect_test_explicit_strict_indent) (preprocess (pps ppx_expect -expect-test-strict-indentation=true))) ppx_expect-0.17.2/test/explicit-strict-true/negative-test/000077500000000000000000000000001470323401700236235ustar00rootroot00000000000000ppx_expect-0.17.2/test/explicit-strict-true/negative-test/dune000066400000000000000000000015461470323401700245070ustar00rootroot00000000000000(library (name expect_test_explicit_strict_indent_negative) (libraries ppx_expect_runtime) (preprocess (pps ppx_expect -expect-test-strict-indentation=true))) (rule (deps (:first_dep ./inline_tests_runner) ./inline_tests_runner.exe %{workspace_root}/bin/apply-style jbuild (glob_files *.ml)) (targets nine.ml.corrected test-output) (action (bash "\nrm -f *.ml.corrected 2>/dev/null\n! %{first_dep} -no-color > test-output 2>&1\nfor f in *.ml.corrected\ndo\n %{workspace_root}/bin/apply-style \\\n -directory-config jbuild \\\n -original-file $(basename $f .corrected) \\\n - < $f > $f.tmp\n mv $f.tmp $f\ndone\n"))) (rule (alias runtest) (deps nine.ml.corrected.expected nine.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps test-output.expected test-output) (action (bash "diff -a %{deps}"))) ppx_expect-0.17.2/test/explicit-strict-true/negative-test/nine.ml000066400000000000000000000034111470323401700251050ustar00rootroot00000000000000(* Show that, when compiling with [-expect-test-strict-indentation=true], test blocks that match the output modulo indentation, but are not themselves formatted according to the indentation rules, are corrected. *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello|}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello|}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/explicit-strict-true/negative-test/nine.ml.corrected.expected000066400000000000000000000017651470323401700306700ustar00rootroot00000000000000(* Show that, when compiling with [-expect-test-strict-indentation=true], test blocks that match the output modulo indentation, but are not themselves formatted according to the indentation rules, are corrected. *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello |}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/explicit-strict-true/negative-test/test-output.expected000066400000000000000000000043571470323401700276740ustar00rootroot00000000000000------ nine.ml ++++++ nine.ml.corrected File "nine.ml", line 10, characters 0-1: |(* Show that, when compiling with [-expect-test-strict-indentation=true], test blocks | that match the output modulo indentation, but are not themselves formatted according to | the indentation rules, are corrected. *) | |let%expect_test _ = | let module _ = struct | let () = | print_string "hello"; | [%expect -| {| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "hello\n"; | [%expect -| {| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "hello\n\n"; | [%expect -| {| -| hello -| -| |}] +| {| hello |}] | ;; | | let () = | print_string "\nhello"; | [%expect -| {| -| -| hello|}] +| {| hello |}] | ;; | | let () = | print_string "\nhello\n"; | [%expect -| {| -| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "\nhello\n\n"; | [%expect -| {| -| -| hello -| -| |}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello"; | [%expect -| {| -| -| -| hello|}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello\n"; | [%expect -| {| -| -| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello\n\n"; | [%expect -| {| -| -| -| hello -| -| |}] +| {| hello |}] | ;; | end | in | () |;; ppx_expect-0.17.2/test/explicit-strict-true/nine.ml000066400000000000000000000016701470323401700223330ustar00rootroot00000000000000(* Show that, when compiling with [-expect-test-strict-indentation=true], the appropriately-formatted expect block can match various malformatted outputs *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello |}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/force-drop/000077500000000000000000000000001470323401700170005ustar00rootroot00000000000000ppx_expect-0.17.2/test/force-drop/dune000066400000000000000000000002371470323401700176600ustar00rootroot00000000000000(executables (modes byte exe) (names expect_test_force_drop_integration) (libraries expect_test_force_drop_integration_lib) (preprocess (pps ppx_jane))) ppx_expect-0.17.2/test/force-drop/expect_test_force_drop_integration.ml000066400000000000000000000001331470323401700264630ustar00rootroot00000000000000let () = print_int Expect_test_force_drop_integration_lib.the_num; print_newline () ;; ppx_expect-0.17.2/test/force-drop/lib/000077500000000000000000000000001470323401700175465ustar00rootroot00000000000000ppx_expect-0.17.2/test/force-drop/lib/dune000066400000000000000000000001471470323401700204260ustar00rootroot00000000000000(library (name expect_test_force_drop_integration_lib) (libraries) (preprocess (pps ppx_expect))) ppx_expect-0.17.2/test/force-drop/lib/expect_test_force_drop_integration_lib.ml000066400000000000000000000006221470323401700300620ustar00rootroot00000000000000(* Shadow the runtime so that we can see if we enter the body of the test functor *) module Ppx_expect_runtime = struct include Ppx_expect_runtime module Make_test_block (C : Expect_test_config_types.S) = struct let () = failwith "entered test functor" include Make_test_block (C) end end let%expect_test "to_drop" = print_endline "OK"; [%expect {| NOT OK |}] ;; let the_num = 42 ppx_expect-0.17.2/test/force-drop/lib/expect_test_force_drop_integration_lib.mli000066400000000000000000000002251470323401700302320ustar00rootroot00000000000000(** We export a val just so it's easy to see that the executable in the parent directory does, in fact, link this library. *) val the_num : int ppx_expect-0.17.2/test/force-drop/lib/setup.sh000077500000000000000000000000561470323401700212460ustar00rootroot00000000000000#!/bin/bash TEST_DIR="$(pwd)" export TEST_DIR ppx_expect-0.17.2/test/force-drop/lib/test-ppx-runtime-is-mined.t000066400000000000000000000005751470323401700247120ustar00rootroot00000000000000We check that the [inline_tests_runner] explodes, even when not running tests. This gives us reasonable confidence that, if we link this lib from another executable, that executable will also explode if the tests are not elided correctly. $ cd $TEST_DIR $ OCAMLRUNPARAM=b=0 ./inline_tests_runner -list-partitions Fatal error: exception Failure("entered test functor") [2] ppx_expect-0.17.2/test/force-drop/setup.sh000077500000000000000000000000561470323401700205000ustar00rootroot00000000000000#!/bin/bash TEST_DIR="$(pwd)" export TEST_DIR ppx_expect-0.17.2/test/force-drop/test-verbose-mode.t000066400000000000000000000002511470323401700225270ustar00rootroot00000000000000This binary does not access the test functor $ cd $TEST_DIR $ ./expect_test_force_drop_integration.exe 42 $ node expect_test_force_drop_integration.bc.js 42 ppx_expect-0.17.2/test/negative-tests/000077500000000000000000000000001470323401700177025ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/chdir.ml000066400000000000000000000002131470323401700213210ustar00rootroot00000000000000let%expect_test _ = print_string "About to change dir"; Sys.mkdir "tmp" 0o755; Sys.chdir "tmp"; Sys.rmdir "../tmp"; [%expect] ;; ppx_expect-0.17.2/test/negative-tests/chdir.ml.corrected.expected000066400000000000000000000002451470323401700250770ustar00rootroot00000000000000let%expect_test _ = print_string "About to change dir"; Sys.mkdir "tmp" 0o755; Sys.chdir "tmp"; Sys.rmdir "../tmp"; [%expect {| About to change dir |}] ;; ppx_expect-0.17.2/test/negative-tests/cinaps/000077500000000000000000000000001470323401700211575ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/cinaps/dune000066400000000000000000000002311470323401700220310ustar00rootroot00000000000000(library (name expect_test_negative_tests_cinaps) (libraries core sexp_pretty stdio filesystem_core) (preprocess (pps ppx_jane ppx_string_dedent))) ppx_expect-0.17.2/test/negative-tests/cinaps/expect_test_negative_tests_cinaps.ml000066400000000000000000000043061470323401700305040ustar00rootroot00000000000000open! Core let print_newline () = Stdio.print_endline "" let print_s sexp = Stdio.print_string (Sexp_pretty.sexp_to_string sexp) let generate ~postprocess_test_output ~set_up_for_tests ~inline_test_args ~exclude_targets = let filenames = Filesystem_core.ls_dir File_path.dot |> List.map ~f:File_path.Part.to_string |> List.filter ~f:(fun filename -> String.is_suffix filename ~suffix:".ml" && not (List.mem exclude_targets filename ~equal:String.equal)) in let filenames = List.sort filenames ~compare:String.compare in let targets = List.concat [ List.map filenames ~f:(fun filename -> filename ^ ".corrected") ; [ "test-output" ] ] in let set_up_string = match set_up_for_tests with | Some set_up_string -> set_up_string ^ " " | None -> "" in let postprocess_string = match postprocess_test_output with | Some postprocess_string -> postprocess_string | None -> "> test-output 2>&1" in let args_string = match inline_test_args with | Some args_string -> Printf.sprintf " %s -no-color " args_string | None -> " -no-color " in print_newline (); print_s [%sexp `rule { deps = [ "./inline_tests_runner" ; "./inline_tests_runner.exe" ; "%{root}/bin/apply-style" ; "jbuild" ; `glob_files "*.ml" ] ; targets : string list ; action : string = [%string_dedent {| > > rm -f *.ml.corrected 2>/dev/null > ! %{set_up_string}%{"%"}{first_dep}%{args_string}%{postprocess_string} > for f in *.ml.corrected > do > %{"%"}{root}/bin/apply-style \ > -directory-config jbuild \ > -original-file $(basename $f .corrected) \ > - < $f > $f.tmp > mv $f.tmp $f > done > |}] }]; List.iter targets ~f:(fun target -> let deps = [ target ^ ".expected"; target ] in print_newline (); print_s [%sexp `alias { name = "runtest"; deps : string list; action = "diff -a %{deps}" }]); print_newline () ;; ppx_expect-0.17.2/test/negative-tests/cinaps/expect_test_negative_tests_cinaps.mli000066400000000000000000000002671470323401700306570ustar00rootroot00000000000000open! Base val generate : postprocess_test_output:string option -> set_up_for_tests:string option -> inline_test_args:string option -> exclude_targets:string list -> unit ppx_expect-0.17.2/test/negative-tests/comment.ml000066400000000000000000000002361470323401700216770ustar00rootroot00000000000000let () = Printexc.record_backtrace false let%expect_test _ = raise (Failure "RIP") (* this fails, but the comment stays *) [@@expect.uncaught_exn {||}] ;; ppx_expect-0.17.2/test/negative-tests/comment.ml.corrected.expected000066400000000000000000000002531470323401700254470ustar00rootroot00000000000000let () = Printexc.record_backtrace false let%expect_test _ = raise (Failure "RIP") (* this fails, but the comment stays *) [@@expect.uncaught_exn {| (Failure RIP) |}] ;; ppx_expect-0.17.2/test/negative-tests/disabling/000077500000000000000000000000001470323401700216365ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/disabling/dune000066400000000000000000000003001470323401700225050ustar00rootroot00000000000000(executables (modes byte exe) (names main) (libraries expect_test_disabling_test_lib) (preprocess (pps ppx_jane))) (rule (alias runtest) (deps ./main.exe) (action (bash %{deps}))) ppx_expect-0.17.2/test/negative-tests/disabling/lib/000077500000000000000000000000001470323401700224045ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/disabling/lib/dune000066400000000000000000000001201470323401700232530ustar00rootroot00000000000000(library (name expect_test_disabling_test_lib) (preprocess (pps ppx_jane))) ppx_expect-0.17.2/test/negative-tests/disabling/lib/test_ref.ml000066400000000000000000000004101470323401700245440ustar00rootroot00000000000000type t = | Init | Set_by_inline_test [@@deriving sexp, compare] let inner = ref Init let%expect_test _ = let module _ = struct let () = inner := Set_by_inline_test end in () ;; let%test_unit _ = inner := Set_by_inline_test let value () = !inner ppx_expect-0.17.2/test/negative-tests/disabling/lib/test_ref.mli000066400000000000000000000001331470323401700247170ustar00rootroot00000000000000type t = | Init | Set_by_inline_test [@@deriving sexp, compare] val value : unit -> t ppx_expect-0.17.2/test/negative-tests/disabling/main.ml000066400000000000000000000001521470323401700231120ustar00rootroot00000000000000open Expect_test_disabling_test_lib let () = [%test_result: Test_ref.t] (Test_ref.value ()) ~expect:Init ppx_expect-0.17.2/test/negative-tests/dune000066400000000000000000000110351470323401700205600ustar00rootroot00000000000000(library (name expect_test_negative_tests) (libraries core) (preprocess (pps ppx_jane))) (rule (deps (:first_dep ./inline_tests_runner) ./inline_tests_runner.exe %{workspace_root}/bin/apply-style jbuild (glob_files *.ml)) (targets chdir.ml.corrected comment.ml.corrected escaped_strings.ml.corrected exact.ml.corrected exn.ml.corrected exn_and_trailing.ml.corrected exn_missing.ml.corrected expect_output.ml.corrected flexible.ml.corrected function_with_distinct_outputs.ml.corrected functor.ml.corrected missing.ml.corrected nine.ml.corrected normal_strings.ml.corrected semicolon.ml.corrected similar_distinct_outputs.ml.corrected spacing.ml.corrected string_extension_syntax.ml.corrected string_padding.ml.corrected tag.ml.corrected three.ml.corrected trailing.ml.corrected trailing_in_module.ml.corrected unidiomatic_syntax.ml.corrected unusual_payload_location.ml.corrected test-output) (action (bash "\nrm -f *.ml.corrected 2>/dev/null\n! %{first_dep} -no-color > test-output 2>&1\nfor f in *.ml.corrected\ndo\n %{workspace_root}/bin/apply-style \\\n -directory-config jbuild \\\n -original-file $(basename $f .corrected) \\\n - < $f > $f.tmp\n mv $f.tmp $f\ndone\n"))) (rule (alias runtest) (deps chdir.ml.corrected.expected chdir.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps comment.ml.corrected.expected comment.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps escaped_strings.ml.corrected.expected escaped_strings.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps exact.ml.corrected.expected exact.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps exn.ml.corrected.expected exn.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps exn_and_trailing.ml.corrected.expected exn_and_trailing.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps exn_missing.ml.corrected.expected exn_missing.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps expect_output.ml.corrected.expected expect_output.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps flexible.ml.corrected.expected flexible.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps function_with_distinct_outputs.ml.corrected.expected function_with_distinct_outputs.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps functor.ml.corrected.expected functor.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps missing.ml.corrected.expected missing.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps nine.ml.corrected.expected nine.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps normal_strings.ml.corrected.expected normal_strings.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps semicolon.ml.corrected.expected semicolon.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps similar_distinct_outputs.ml.corrected.expected similar_distinct_outputs.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps spacing.ml.corrected.expected spacing.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps string_extension_syntax.ml.corrected.expected string_extension_syntax.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps string_padding.ml.corrected.expected string_padding.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps tag.ml.corrected.expected tag.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps three.ml.corrected.expected three.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps trailing.ml.corrected.expected trailing.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps trailing_in_module.ml.corrected.expected trailing_in_module.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps unidiomatic_syntax.ml.corrected.expected unidiomatic_syntax.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps unusual_payload_location.ml.corrected.expected unusual_payload_location.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps test-output.expected test-output) (action (bash "diff -a %{deps}"))) ppx_expect-0.17.2/test/negative-tests/escaped_strings.ml000066400000000000000000000024141470323401700234120ustar00rootroot00000000000000let%expect_test "escaped carriage return" = print_string "a\rb"; [%expect ""]; print_string "a\rb"; [%expect_exact ""]; print_string "a\r\nb"; [%expect ""]; print_string "a\r\nb"; [%expect_exact ""]; print_string "a\n\rb"; [%expect ""]; print_string "a\n\rb"; [%expect_exact ""] ;; let%expect_test "escaped tab" = print_string "a\tb"; [%expect ""]; print_string "a\tb"; [%expect_exact ""]; print_string "a\t\nb"; [%expect ""]; print_string "a\t\nb"; [%expect_exact ""]; print_string "a\n\tb"; [%expect ""]; print_string "a\n\tb"; [%expect_exact ""] ;; let%expect_test "escaped quote" = print_string "a\"b"; [%expect ""]; print_string "a\"b"; [%expect_exact ""] ;; let%expect_test "escaped trailing carriage return" = print_string "a\r\nb\r\n"; [%expect ""]; print_string "a\r\nb\r\n"; [%expect_exact ""]; print_string "a\r\nb\r\n"; [%expect]; print_string "a\r\nb\r\n"; [%expect_exact] ;; let%expect_test "unescaped carriage return --- empty expect" = print_string "a\r\nb"; [%expect]; print_string "a\r\nb"; [%expect_exact] ;; let%expect_test "unescaped carriage return --- populated expect" = print_string "a\r\nb"; [%expect {| a b |}]; print_string "a\r\nb"; [%expect_exact {|a b|}] ;; ppx_expect-0.17.2/test/negative-tests/escaped_strings.ml.corrected.expected000066400000000000000000000027351470323401700271710ustar00rootroot00000000000000let%expect_test "escaped carriage return" = print_string "a\rb"; [%expect "a\rb"]; print_string "a\rb"; [%expect_exact "a\rb"]; print_string "a\r\nb"; [%expect " \n a\n b\n "]; print_string "a\r\nb"; [%expect_exact "a\r\nb"]; print_string "a\n\rb"; [%expect " \n a\n b\n "]; print_string "a\n\rb"; [%expect_exact "a\n\rb"] ;; let%expect_test "escaped tab" = print_string "a\tb"; [%expect "a\tb"]; print_string "a\tb"; [%expect_exact "a\tb"]; print_string "a\t\nb"; [%expect " \n a\n b\n "]; print_string "a\t\nb"; [%expect_exact "a\t\nb"]; print_string "a\n\tb"; [%expect " \n a\n b\n "]; print_string "a\n\tb"; [%expect_exact "a\n\tb"] ;; let%expect_test "escaped quote" = print_string "a\"b"; [%expect "a\"b"]; print_string "a\"b"; [%expect_exact "a\"b"] ;; let%expect_test "escaped trailing carriage return" = print_string "a\r\nb\r\n"; [%expect " \n a\n b\n "]; print_string "a\r\nb\r\n"; [%expect_exact "a\r\nb\r\n"]; print_string "a\r\nb\r\n"; [%expect {| a b |}]; print_string "a\r\nb\r\n"; [%expect_exact {|a b |}] ;; let%expect_test "unescaped carriage return --- empty expect" = print_string "a\r\nb"; [%expect {| a b |}]; print_string "a\r\nb"; [%expect_exact {|a b|}] ;; let%expect_test "unescaped carriage return --- populated expect" = print_string "a\r\nb"; [%expect {| a b |}]; print_string "a\r\nb"; [%expect_exact {|a b|}] ;; ppx_expect-0.17.2/test/negative-tests/exact.ml000066400000000000000000000007721470323401700213460ustar00rootroot00000000000000open! Core (* Check that [%expect_exact] does not strip leading/trailing newlines *) let%expect_test _ = print_string "foobarbaz"; [%expect_exact {| foobarbaz |}] ;; (* Check that [%expect_exact] does not treat whitespace as indentation *) let%expect_test _ = print_string "\nfoobarbaz\n"; [%expect_exact {| foobarbaz |}] ;; (* Check that [%expect_exact] does not strip whitespace on single lines *) let%expect_test _ = print_string "foobarbaz"; [%expect_exact {| foobarbaz |}] ;; ppx_expect-0.17.2/test/negative-tests/exact.ml.corrected.expected000066400000000000000000000007601470323401700251140ustar00rootroot00000000000000open! Core (* Check that [%expect_exact] does not strip leading/trailing newlines *) let%expect_test _ = print_string "foobarbaz"; [%expect_exact {|foobarbaz|}] ;; (* Check that [%expect_exact] does not treat whitespace as indentation *) let%expect_test _ = print_string "\nfoobarbaz\n"; [%expect_exact {| foobarbaz |}] ;; (* Check that [%expect_exact] does not strip whitespace on single lines *) let%expect_test _ = print_string "foobarbaz"; [%expect_exact {|foobarbaz|}] ;; ppx_expect-0.17.2/test/negative-tests/exit-in-test/000077500000000000000000000000001470323401700222345ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/exit-in-test/broken-test/000077500000000000000000000000001470323401700244715ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/exit-in-test/broken-test/dune000066400000000000000000000001171470323401700253460ustar00rootroot00000000000000(library (name expect_test_call_exit_in_test) (preprocess (pps ppx_jane))) ppx_expect-0.17.2/test/negative-tests/exit-in-test/broken-test/test.ml000066400000000000000000000003001470323401700257730ustar00rootroot00000000000000let%expect_test _ = print_endline "foo"; [%expect {| foo |}]; print_endline "Something went horribly wrong, exiting prematurely!"; (exit 42 : unit); [%expect {| random output |}] ;; ppx_expect-0.17.2/test/negative-tests/exit-in-test/dune000066400000000000000000000001171470323401700231110ustar00rootroot00000000000000(library (name expect_test_test_exit_in_test) (preprocess (pps ppx_jane))) ppx_expect-0.17.2/test/negative-tests/exit-in-test/test.ml000066400000000000000000000004661470323401700235530ustar00rootroot00000000000000let%expect_test _ = ignore (Sys.command "./broken-test/inline_tests_runner" : int); [%expect {| File "test.ml", line 1, characters 0-188: Error: program exited while expect test was running! Output captured so far: foo Something went horribly wrong, exiting prematurely! |}] ;; ppx_expect-0.17.2/test/negative-tests/exn.ml000066400000000000000000000005271470323401700210320ustar00rootroot00000000000000open! Core let%expect_test _ = [%expect {| hi ho |}]; Printexc.record_backtrace false; ignore (failwith "hi ho" : unit); [%expect {| it's off to work we go |}] ;; let%expect_test _ = Printexc.record_backtrace false; ignore (failwith "hi ho" : unit); [%expect.unreachable] [@@expect.uncaught_exn {| (Failure "hi ho") |}] ;; ppx_expect-0.17.2/test/negative-tests/exn.ml.corrected.expected000066400000000000000000000005541470323401700246030ustar00rootroot00000000000000open! Core let%expect_test _ = [%expect {| |}]; Printexc.record_backtrace false; ignore (failwith "hi ho" : unit); [%expect.unreachable] [@@expect.uncaught_exn {| (Failure "hi ho") |}] ;; let%expect_test _ = Printexc.record_backtrace false; ignore (failwith "hi ho" : unit); [%expect.unreachable] [@@expect.uncaught_exn {| (Failure "hi ho") |}] ;; ppx_expect-0.17.2/test/negative-tests/exn_and_trailing.ml000066400000000000000000000002101470323401700235320ustar00rootroot00000000000000let%expect_test _ = print_endline "hello"; if true then raise Exit; [%expect {| hello |}] [@@expect.uncaught_exn {| Exit |}] ;; ppx_expect-0.17.2/test/negative-tests/exn_and_trailing.ml.corrected.expected000066400000000000000000000002701470323401700273110ustar00rootroot00000000000000let%expect_test _ = print_endline "hello"; if true then raise Exit; [%expect.unreachable] [@@expect.uncaught_exn {| Exit Trailing output --------------- hello |}] ;; ppx_expect-0.17.2/test/negative-tests/exn_missing.ml000066400000000000000000000004231470323401700225560ustar00rootroot00000000000000open! Core let%expect_test "without trailing output" = printf "hello world"; [%expect "hello world"] [@@expect.uncaught_exn {| (Failure "hi ho") |}] ;; let%expect_test "with trailing output" = printf "hello world" [@@expect.uncaught_exn {| (Failure "hi ho") |}] ;; ppx_expect-0.17.2/test/negative-tests/exn_missing.ml.corrected.expected000066400000000000000000000003201470323401700263230ustar00rootroot00000000000000open! Core let%expect_test "without trailing output" = printf "hello world"; [%expect "hello world"] ;; let%expect_test "with trailing output" = printf "hello world"; [%expect {| hello world |}] ;; ppx_expect-0.17.2/test/negative-tests/expect_output.ml000066400000000000000000000002101470323401700231350ustar00rootroot00000000000000open! Core let%expect_test _ = if false then ( print_string "hello"; print_string [%expect.output]; [%expect {||}]) ;; ppx_expect-0.17.2/test/negative-tests/expect_output.ml.corrected.expected000066400000000000000000000002171470323401700267150ustar00rootroot00000000000000open! Core let%expect_test _ = if false then ( print_string "hello"; print_string [%expect.output]; [%expect.unreachable]) ;; ppx_expect-0.17.2/test/negative-tests/export_test.ml000066400000000000000000000000621470323401700226120ustar00rootroot00000000000000module M () = struct let%expect_test _ = () end ppx_expect-0.17.2/test/negative-tests/flexible.ml000066400000000000000000000034221470323401700220270ustar00rootroot00000000000000open! Core (* In old versions of [ppx_expect], the below tests would respect the formatting of the incorrect output present when possible. Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, so we instead use this test to demonstrate that all of the below expectations are reformatted to the same thing. *) (* Single line actual... *) let%expect_test _ = print_string "hello"; [%expect {||}] ;; let%expect_test _ = print_string "hello"; [%expect {| |}] ;; let%expect_test _ = print_string "hello"; [%expect {| |}] ;; let%expect_test _ = print_string "hello"; [%expect {| WRONG |}] ;; let%expect_test _ = print_string "hello"; [%expect {| WRONG |}] ;; let%expect_test _ = print_string "hello"; [%expect {| WRONG |}] ;; let%expect_test _ = print_string "hello"; [%expect {| WRONG |}] ;; (* Multi line actual... *) let%expect_test _ = print_string "one1\ntwo"; [%expect {||}] ;; let%expect_test _ = print_string "one2\ntwo"; [%expect {| |}] ;; let%expect_test _ = print_string "one3\ntwo"; [%expect {| |}] ;; let%expect_test _ = print_string "one4\ntwo"; [%expect {| WRONG |}] ;; let%expect_test _ = print_string "one5\ntwo"; [%expect {| WRONG |}] ;; let%expect_test _ = print_string "one6\ntwo"; [%expect {| WRONG |}] ;; let%expect_test _ = print_string "one8\ntwo"; [%expect {| WRONG THING |}] ;; let%expect_test _ = print_string "one9\ntwo"; [%expect {| WRONG THING |}] ;; let%expect_test _ = print_string "one10\ntwo"; [%expect {| WRONG THING |}] ;; let%expect_test _ = print_string "one11\ntwo"; [%expect {| WRONG THING |}] ;; ppx_expect-0.17.2/test/negative-tests/flexible.ml.corrected.expected000066400000000000000000000035221470323401700256010ustar00rootroot00000000000000open! Core (* In old versions of [ppx_expect], the below tests would respect the formatting of the incorrect output present when possible. Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, so we instead use this test to demonstrate that all of the below expectations are reformatted to the same thing. *) (* Single line actual... *) let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; let%expect_test _ = print_string "hello"; [%expect {| hello |}] ;; (* Multi line actual... *) let%expect_test _ = print_string "one1\ntwo"; [%expect {| one1 two |}] ;; let%expect_test _ = print_string "one2\ntwo"; [%expect {| one2 two |}] ;; let%expect_test _ = print_string "one3\ntwo"; [%expect {| one3 two |}] ;; let%expect_test _ = print_string "one4\ntwo"; [%expect {| one4 two |}] ;; let%expect_test _ = print_string "one5\ntwo"; [%expect {| one5 two |}] ;; let%expect_test _ = print_string "one6\ntwo"; [%expect {| one6 two |}] ;; let%expect_test _ = print_string "one8\ntwo"; [%expect {| one8 two |}] ;; let%expect_test _ = print_string "one9\ntwo"; [%expect {| one9 two |}] ;; let%expect_test _ = print_string "one10\ntwo"; [%expect {| one10 two |}] ;; let%expect_test _ = print_string "one11\ntwo"; [%expect {| one11 two |}] ;; ppx_expect-0.17.2/test/negative-tests/for-mdx/000077500000000000000000000000001470323401700212565ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/for-mdx/dune000066400000000000000000000017311470323401700221360ustar00rootroot00000000000000(library (name expect_test_example_for_mdx) (libraries core) (preprocess (pps ppx_jane))) (rule (deps (:first_dep ./inline_tests_runner) ./inline_tests_runner.exe %{workspace_root}/bin/apply-style jbuild (glob_files *.ml)) (targets foo.ml.corrected mdx_cases.ml.corrected test-output) (action (bash "\nrm -f *.ml.corrected 2>/dev/null\n! %{first_dep} -no-color 2>&1 | tee >(sed '/part-end/q' > test-output) > /dev/null\nfor f in *.ml.corrected\ndo\n %{workspace_root}/bin/apply-style \\\n -directory-config jbuild \\\n -original-file $(basename $f .corrected) \\\n - < $f > $f.tmp\n mv $f.tmp $f\ndone\n"))) (rule (alias runtest) (deps foo.ml.corrected.expected foo.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps mdx_cases.ml.corrected.expected mdx_cases.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps test-output.expected test-output) (action (bash "diff -a %{deps}"))) ppx_expect-0.17.2/test/negative-tests/for-mdx/foo.ml000066400000000000000000000002131470323401700223670ustar00rootroot00000000000000(* $MDX part-begin=addition *) open! Core let%expect_test "addition" = printf "%d" (1 + 2); [%expect {| 4 |}] ;; (* $MDX part-end *) ppx_expect-0.17.2/test/negative-tests/for-mdx/foo.ml.corrected.expected000066400000000000000000000002131470323401700261400ustar00rootroot00000000000000(* $MDX part-begin=addition *) open! Core let%expect_test "addition" = printf "%d" (1 + 2); [%expect {| 3 |}] ;; (* $MDX part-end *) ppx_expect-0.17.2/test/negative-tests/for-mdx/mdx_cases.ml000066400000000000000000000122021470323401700235530ustar00rootroot00000000000000open! Core open struct module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end end (* $MDX part-begin=interleaved *) let%expect_test "interleaved" = let l = [ "a"; "b"; "c" ] in printf "A list [l]\n"; printf "It has length %d\n" (List.length l); [%expect {| A list [l] |}]; List.iter l ~f:print_string; [%expect {| It has length 3 abc |}] ;; (* $MDX part-end *) (* $MDX part-begin=trailing *) let%expect_test "trailing output" = print_endline "Hello"; [%expect {| Hello |}]; print_endline "world" ;; (* $MDX part-end *) (* $MDX part-begin=matching *) let%expect_test "matching behavior --- no content" = printf " "; [%expect]; printf " "; [%expect ""]; printf " "; [%expect_exact]; printf " "; [%expect_exact ""] ;; let%expect_test "matching behavior --- one line of content" = printf "\n This is one line\n\n"; [%expect]; printf "\n This is one line\n\n"; [%expect ""]; printf "\n This is one line\n\n"; [%expect_exact]; printf "\n This is one line\n\n"; [%expect_exact ""] ;; let%expect_test "matching behavior --- multiple lines of content" = printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect ""]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect_exact]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect_exact ""] ;; (* $MDX part-end *) (* $MDX part-begin=bad-format *) let%expect_test "bad formatting" = printf "a\n b"; [%expect {| a b |}] ;; (* $MDX part-end *) (* $MDX part-begin=exn *) let%expect_test "exception" = Printexc.record_backtrace false; printf "start!"; [%expect {| |}]; let sum = 2 + 2 in if sum <> 3 then ( printf "%d" sum; failwith "nope"); printf "done!"; [%expect {| done! |}] ;; (* $MDX part-end *) (* $MDX part-begin=function *) let%expect_test "function" = let f output = print_string output; [%expect {| hello world |}] in f "hello world"; f "hello world" ;; (* $MDX part-end *) (* $MDX part-begin=broken-function *) let%expect_test "function" = let f output = print_string output; [%expect {| hello world |}] in f "hello world"; f "goodbye world"; f "once upon\na midnight dreary"; f "hello world" ;; (* $MDX part-end *) (* $MDX part-begin=unreachable *) let%expect_test "unreachable" = let interesting_bool = 3 > 5 in printf "%b\n" interesting_bool; if interesting_bool then [%expect {| true |}] else ( printf "don't reach\n"; [%expect.unreachable]) ;; (* $MDX part-end *) (* $MDX part-begin=sometimes-reachable *) module Test (B : sig val interesting_opt : int option end) = struct let%expect_test "sometimes reachable" = match B.interesting_opt with | Some x -> printf "%d\n" x; [%expect {| 5 |}] | None -> [%expect {| |}] ;; end module _ = Test (struct let interesting_opt = Some 5 end) module _ = Test (struct let interesting_opt = None end) module _ = Test (struct let interesting_opt = Some 5 end) (* $MDX part-end *) (* $MDX part-begin=sometimes-raises *) module Test' (B : sig val interesting_opt : int option end) = struct let%expect_test "sometimes raises" = match B.interesting_opt with | Some x -> printf "%d\n" x; [%expect {| 5 |}] | None -> failwith "got none!" ;; end module _ = Test' (struct let interesting_opt = Some 5 end) module _ = Test' (struct let interesting_opt = None end) module _ = Test' (struct let interesting_opt = Some 5 end) (* $MDX part-end *) (* $MDX part-begin=output-capture *) (* Suppose we want to test code that attaches a timestamp to everything it prints *) let print_message s = printf "%s: %s\n" (Time_float.to_string_utc (Time_float.now ())) s let%expect_test "output capture" = (* A simple way to clean up the non-determinism is to 'X' all digits *) let censor_digits s = String.map s ~f:(fun c -> if Char.is_digit c then 'X' else c) in print_message "Hello"; [%expect.output] |> censor_digits |> print_endline; [%expect {| |}]; print_message "world"; [%expect.output] |> censor_digits |> print_endline; [%expect {| |}] ;; (* $MDX part-end *) (* $MDX part-begin=sanitization *) (* Suppose we want to test code that attaches a timestamp to everything it prints *) let print_message s = printf "%s: %s\n" (Time_float.to_string_utc (Time_float.now ())) s module Expect_test_config = struct include Expect_test_config (* A simple way to clean up the non-determinism is to 'X' all digits *) let sanitize s = String.map s ~f:(fun c -> if Char.is_digit c then 'X' else c) end let%expect_test "sanitization" = print_message "Hello"; [%expect {| |}]; print_message "world"; [%expect {| |}] ;; (* $MDX part-end *) ppx_expect-0.17.2/test/negative-tests/for-mdx/mdx_cases.ml.corrected.expected000066400000000000000000000162171470323401700273360ustar00rootroot00000000000000open! Core open struct module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end end (* $MDX part-begin=interleaved *) let%expect_test "interleaved" = let l = [ "a"; "b"; "c" ] in printf "A list [l]\n"; printf "It has length %d\n" (List.length l); [%expect {| A list [l] It has length 3 |}]; List.iter l ~f:print_string; [%expect {| abc |}] ;; (* $MDX part-end *) (* $MDX part-begin=trailing *) let%expect_test "trailing output" = print_endline "Hello"; [%expect {| Hello |}]; print_endline "world"; [%expect {| world |}] ;; (* $MDX part-end *) (* $MDX part-begin=matching *) let%expect_test "matching behavior --- no content" = printf " "; [%expect {| |}]; printf " "; [%expect ""]; printf " "; [%expect_exact {| |}]; printf " "; [%expect_exact " "] ;; let%expect_test "matching behavior --- one line of content" = printf "\n This is one line\n\n"; [%expect {| This is one line |}]; printf "\n This is one line\n\n"; [%expect "This is one line"]; printf "\n This is one line\n\n"; [%expect_exact {| This is one line |}]; printf "\n This is one line\n\n"; [%expect_exact "\n This is one line\n\n"] ;; let%expect_test "matching behavior --- multiple lines of content" = printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect " \n\ \ Once upon a midnight dreary,\n\ \ while I pondered, weak and weary,\n\ \ Over many a quaint and curious\n\ \ volume of forgotten lore\n\ \ "]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect_exact {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}]; printf {| Once upon a midnight dreary, while I pondered, weak and weary, Over many a quaint and curious volume of forgotten lore |}; [%expect_exact "\n\ Once upon a midnight dreary,\n\ \ while I pondered, weak and weary,\n\ Over many a quaint and curious\n\ \ volume of forgotten lore "] ;; (* $MDX part-end *) (* $MDX part-begin=bad-format *) let%expect_test "bad formatting" = printf "a\n b"; [%expect {| a b |}] ;; (* $MDX part-end *) (* $MDX part-begin=exn *) let%expect_test "exception" = Printexc.record_backtrace false; printf "start!"; [%expect {| start! |}]; let sum = 2 + 2 in if sum <> 3 then ( printf "%d" sum; failwith "nope"); printf "done!"; [%expect.unreachable] [@@expect.uncaught_exn {| (Failure nope) Trailing output --------------- 4 |}] ;; (* $MDX part-end *) (* $MDX part-begin=function *) let%expect_test "function" = let f output = print_string output; [%expect {| hello world |}] in f "hello world"; f "hello world" ;; (* $MDX part-end *) (* $MDX part-begin=broken-function *) let%expect_test "function" = let f output = print_string output; [%expect {| (* expect_test: Test ran multiple times with different test outputs *) ============================ Output 1 / 4 ============================ hello world ============================ Output 2 / 4 ============================ goodbye world ============================ Output 3 / 4 ============================ once upon a midnight dreary ============================ Output 4 / 4 ============================ hello world |}] in f "hello world"; f "goodbye world"; f "once upon\na midnight dreary"; f "hello world" ;; (* $MDX part-end *) (* $MDX part-begin=unreachable *) let%expect_test "unreachable" = let interesting_bool = 3 > 5 in printf "%b\n" interesting_bool; if interesting_bool then [%expect.unreachable] else ( printf "don't reach\n"; [%expect {| false don't reach |}]) ;; (* $MDX part-end *) (* $MDX part-begin=sometimes-reachable *) module Test (B : sig val interesting_opt : int option end) = struct let%expect_test "sometimes reachable" = match B.interesting_opt with | Some x -> printf "%d\n" x; [%expect {| 5 |}] | None -> [%expect {| |}] ;; end module _ = Test (struct let interesting_opt = Some 5 end) module _ = Test (struct let interesting_opt = None end) module _ = Test (struct let interesting_opt = Some 5 end) (* $MDX part-end *) (* $MDX part-begin=sometimes-raises *) module Test' (B : sig val interesting_opt : int option end) = struct let%expect_test "sometimes raises" = match B.interesting_opt with | Some x -> printf "%d\n" x; [%expect {| 5 |}] | None -> failwith "got none!" [@@expect.uncaught_exn {| (* expect_test: Test ran multiple times with different uncaught exceptions *) =============================== Output 1 / 3 ================================ =============================== Output 2 / 3 ================================ (Failure "got none!") =============================== Output 3 / 3 ================================ |}] ;; end module _ = Test' (struct let interesting_opt = Some 5 end) module _ = Test' (struct let interesting_opt = None end) module _ = Test' (struct let interesting_opt = Some 5 end) (* $MDX part-end *) (* $MDX part-begin=output-capture *) (* Suppose we want to test code that attaches a timestamp to everything it prints *) let print_message s = printf "%s: %s\n" (Time_float.to_string_utc (Time_float.now ())) s let%expect_test "output capture" = (* A simple way to clean up the non-determinism is to 'X' all digits *) let censor_digits s = String.map s ~f:(fun c -> if Char.is_digit c then 'X' else c) in print_message "Hello"; [%expect.output] |> censor_digits |> print_endline; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: Hello |}]; print_message "world"; [%expect.output] |> censor_digits |> print_endline; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: world |}] ;; (* $MDX part-end *) (* $MDX part-begin=sanitization *) (* Suppose we want to test code that attaches a timestamp to everything it prints *) let print_message s = printf "%s: %s\n" (Time_float.to_string_utc (Time_float.now ())) s module Expect_test_config = struct include Expect_test_config (* A simple way to clean up the non-determinism is to 'X' all digits *) let sanitize s = String.map s ~f:(fun c -> if Char.is_digit c then 'X' else c) end let%expect_test "sanitization" = print_message "Hello"; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: Hello |}]; print_message "world"; [%expect {| XXXX-XX-XX XX:XX:XX.XXXXXXZ: world |}] ;; (* $MDX part-end *) ppx_expect-0.17.2/test/negative-tests/for-mdx/test-output.expected000066400000000000000000000004001470323401700253100ustar00rootroot00000000000000------ foo.ml ++++++ foo.ml.corrected File "foo.ml", line 6, characters 0-1: |(* $MDX part-begin=addition *) |open! Core | |let%expect_test "addition" = | printf "%d" (1 + 2); -| [%expect {| 4 |}] +| [%expect {| 3 |}] |;; | |(* $MDX part-end *) ppx_expect-0.17.2/test/negative-tests/function_with_distinct_outputs.ml000066400000000000000000000004001470323401700266120ustar00rootroot00000000000000module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end let%expect_test _ = let f output = print_string output; [%expect {| hello world |}] in f "foo"; f "bar" ;; ppx_expect-0.17.2/test/negative-tests/function_with_distinct_outputs.ml.corrected.expected000066400000000000000000000007731470323401700324000ustar00rootroot00000000000000module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end let%expect_test _ = let f output = print_string output; [%expect {| (* expect_test: Test ran multiple times with different test outputs *) ============================ Output 1 / 2 ============================ foo ============================ Output 2 / 2 ============================ bar |}] in f "foo"; f "bar" ;; ppx_expect-0.17.2/test/negative-tests/functor.ml000066400000000000000000000014431470323401700217160ustar00rootroot00000000000000module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end module M (S : sig val output : string end) = struct let%expect_test _ = print_string S.output; [%expect {| hello world |}]; print_string S.output ;; let%expect_test _ = print_string S.output; if not (String.equal S.output "foo") then failwith "wrong output"; [%expect {| foo |}] ;; let%expect_test _ = if String.equal S.output "bar" then print_string S.output else failwith "wrong output"; [%expect.unreachable] [@@expect.uncaught_exn {| (Failure "wrong output") |}] ;; end module A = M (struct let output = "foo" end) module B = M (struct let output = "bar" end) module C = M (struct let output = "cat" end) ppx_expect-0.17.2/test/negative-tests/functor.ml.corrected.expected000066400000000000000000000047411470323401700254730ustar00rootroot00000000000000module Expect_test_config = struct include Expect_test_config let upon_unreleasable_issue = `Warning_for_collector_testing end module M (S : sig val output : string end) = struct let%expect_test _ = print_string S.output; [%expect {| (* expect_test: Test ran multiple times with different test outputs *) ============================ Output 1 / 3 ============================ foo ============================ Output 2 / 3 ============================ bar ============================ Output 3 / 3 ============================ cat |}]; print_string S.output; [%expect {| (* expect_test: Test ran multiple times with different trailing outputs *) ============================== Output 1 / 3 ============================== foo ============================== Output 2 / 3 ============================== bar ============================== Output 3 / 3 ============================== cat |}] ;; let%expect_test _ = print_string S.output; if not (String.equal S.output "foo") then failwith "wrong output"; [%expect {| foo |}] [@@expect.uncaught_exn {| (* expect_test: Test ran multiple times with different uncaught exceptions *) =============================== Output 1 / 3 ================================ =============================== Output 2 / 3 ================================ (Failure "wrong output") Trailing output --------------- bar =============================== Output 3 / 3 ================================ (Failure "wrong output") Trailing output --------------- cat |}] ;; let%expect_test _ = if String.equal S.output "bar" then print_string S.output else failwith "wrong output"; [%expect {| bar |}] [@@expect.uncaught_exn {| (* expect_test: Test ran multiple times with different uncaught exceptions *) =============================== Output 1 / 3 ================================ (Failure "wrong output") =============================== Output 2 / 3 ================================ =============================== Output 3 / 3 ================================ (Failure "wrong output") |}] ;; end module A = M (struct let output = "foo" end) module B = M (struct let output = "bar" end) module C = M (struct let output = "cat" end) ppx_expect-0.17.2/test/negative-tests/import_test.ml000066400000000000000000000001031470323401700225770ustar00rootroot00000000000000let () = Printexc.record_backtrace false include Export_test.M () ppx_expect-0.17.2/test/negative-tests/missing.ml000066400000000000000000000005111470323401700217020ustar00rootroot00000000000000open! Core (* Example with no [%expect] node at all *) let%expect_test _ = print_string "hello\n"; print_string "goodbye\n" ;; (* Example with an [%expect] node that has no payload *) let%expect_test _ = print_string "hello\n"; print_string "goodbye\n"; [%expect]; ignore ("don't print" : string); [%expect] ;; ppx_expect-0.17.2/test/negative-tests/missing.ml.corrected.expected000066400000000000000000000006441470323401700254620ustar00rootroot00000000000000open! Core (* Example with no [%expect] node at all *) let%expect_test _ = print_string "hello\n"; print_string "goodbye\n"; [%expect {| hello goodbye |}] ;; (* Example with an [%expect] node that has no payload *) let%expect_test _ = print_string "hello\n"; print_string "goodbye\n"; [%expect {| hello goodbye |}]; ignore ("don't print" : string); [%expect {| |}] ;; ppx_expect-0.17.2/test/negative-tests/nesting/000077500000000000000000000000001470323401700213515ustar00rootroot00000000000000ppx_expect-0.17.2/test/negative-tests/nesting/dune000066400000000000000000000015141470323401700222300ustar00rootroot00000000000000(library (name expect_test_nesting_tests) (libraries) (preprocess (pps ppx_jane))) (rule (deps (:first_dep ./inline_tests_runner) ./inline_tests_runner.exe %{workspace_root}/bin/apply-style jbuild (glob_files *.ml)) (targets nested.ml.corrected test-output) (action (bash "\nrm -f *.ml.corrected 2>/dev/null\n! OCAMLRUNPARAM=b=0 %{first_dep} -require-tag fast-flambda -no-color > test-output 2>&1\nfor f in *.ml.corrected\ndo\n %{workspace_root}/bin/apply-style \\\n -directory-config jbuild \\\n -original-file $(basename $f .corrected) \\\n - < $f > $f.tmp\n mv $f.tmp $f\ndone\n"))) (rule (alias runtest) (deps nested.ml.corrected.expected nested.ml.corrected) (action (bash "diff -a %{deps}"))) (rule (alias runtest) (deps test-output.expected test-output) (action (bash "diff -a %{deps}"))) ppx_expect-0.17.2/test/negative-tests/nesting/nested.ml000066400000000000000000000010201470323401700231560ustar00rootroot00000000000000let run_test () = let module _ = struct let%expect_test "" = assert false end in () ;; let%expect_test ("" [@tags "fast-flambda"]) = run_test () (* This test is still silently ignored when running with [-require-tag fast-flambda], but I don't think there's much we can do about that. It will still complain about nesting when normal testing runs. *) let run_test () = let module _ = struct let%expect_test ("" [@tags "fast-flambda"]) = assert false end in () ;; let%expect_test "" = run_test () ppx_expect-0.17.2/test/negative-tests/nesting/nested.ml.corrected.expected000066400000000000000000000013751470323401700267440ustar00rootroot00000000000000let run_test () = let module _ = struct let%expect_test "" = assert false end in () ;; let%expect_test ("" [@tags "fast-flambda"]) = run_test () [@@expect.uncaught_exn {| ( "Expect_test_runtime: reached one [let%expect_test] from another. Nesting expect\ \ntests is prohibited." (outer_test ((file nested.ml) (line 9))) (inner_test ((file nested.ml) (line 3)))) |}] ;; (* This test is still silently ignored when running with [-require-tag fast-flambda], but I don't think there's much we can do about that. It will still complain about nesting when normal testing runs. *) let run_test () = let module _ = struct let%expect_test ("" [@tags "fast-flambda"]) = assert false end in () ;; let%expect_test "" = run_test () ppx_expect-0.17.2/test/negative-tests/nesting/test-output.expected000066400000000000000000000016051470323401700254130ustar00rootroot00000000000000------ nested.ml ++++++ nested.ml.corrected File "nested.ml", line 10, characters 0-1: |let run_test () = | let module _ = struct | let%expect_test "" = assert false | end | in | () |;; | |let%expect_test ("" [@tags "fast-flambda"]) = run_test () +|[@@expect.uncaught_exn {| +| ( "Expect_test_runtime: reached one [let%expect_test] from another. Nesting expect\ +| \ntests is prohibited." (outer_test ((file nested.ml) (line 9))) +| (inner_test ((file nested.ml) (line 3)))) +| |}] | |(* This test is still silently ignored when running with [-require-tag fast-flambda], but | I don't think there's much we can do about that. It will still complain about nesting | when normal testing runs. *) |let run_test () = | let module _ = struct | let%expect_test ("" [@tags "fast-flambda"]) = assert false | end | in | () |;; | |let%expect_test "" = run_test () ppx_expect-0.17.2/test/negative-tests/nine.ml000066400000000000000000000033511470323401700211670ustar00rootroot00000000000000(* In old versions of [ppx_expect], all of the tests below would pass. Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, so we instead use this test to demonstrate that all of the below expectations are reformatted to the same thing. *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello|}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello|}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/negative-tests/nine.ml.corrected.expected000066400000000000000000000020671470323401700247430ustar00rootroot00000000000000(* In old versions of [ppx_expect], all of the tests below would pass. Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, so we instead use this test to demonstrate that all of the below expectations are reformatted to the same thing. *) let%expect_test _ = let module _ = struct let () = print_string "hello"; [%expect {| hello |}] ;; let () = print_string "hello\n"; [%expect {| hello |}] ;; let () = print_string "hello\n\n"; [%expect {| hello |}] ;; let () = print_string "\nhello"; [%expect {| hello |}] ;; let () = print_string "\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\nhello\n\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n"; [%expect {| hello |}] ;; let () = print_string "\n\nhello\n\n"; [%expect {| hello |}] ;; end in () ;; ppx_expect-0.17.2/test/negative-tests/normal_strings.ml000066400000000000000000000014601470323401700232760ustar00rootroot00000000000000let%expect_test "short quoted string" = print_string "foo\nbar\n"; [%expect ""] ;; let%expect_test "long quoted string" = print_string {| XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXX |}; [%expect ""] ;; let%expect_test "quoted strings with leading spaces" = print_string {| live long and prosper |}; [%expect ""]; print_string {| live loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong and prosper |}; [%expect ""] ;; ppx_expect-0.17.2/test/negative-tests/normal_strings.ml.corrected.expected000066400000000000000000000026011470323401700270450ustar00rootroot00000000000000let%expect_test "short quoted string" = print_string "foo\nbar\n"; [%expect " \n foo\n bar\n "] ;; let%expect_test "long quoted string" = print_string {| XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXX |}; [%expect " \n\ \ XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n\ \ XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n\ \ XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n\ \ XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX \ XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n\ \ XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXX\n\ \ "] ;; let%expect_test "quoted strings with leading spaces" = print_string {| live long and prosper |}; [%expect " \n live\n long\n and\n prosper\n "]; print_string {| live loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong and prosper |}; [%expect " \n\ \ live\n\ \ loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong\n\ \ and\n\ \ prosper\n\ \ "] ;; ppx_expect-0.17.2/test/negative-tests/semicolon.ml000066400000000000000000000001031470323401700222160ustar00rootroot00000000000000let%expect_test _ = print_string "one"; [%expect {| two |}] ;; ppx_expect-0.17.2/test/negative-tests/semicolon.ml.corrected.expected000066400000000000000000000001031470323401700257670ustar00rootroot00000000000000let%expect_test _ = print_string "one"; [%expect {| one |}] ;; ppx_expect-0.17.2/test/negative-tests/similar_distinct_outputs.ml000066400000000000000000000005221470323401700253770ustar00rootroot00000000000000module M (S : sig val foo : string end) = struct let%expect_test "similar passing" = print_string S.foo; [%expect {| foo |}] ;; let%expect_test "similar failing" = print_string S.foo; [%expect {| bar |}] ;; end module M1 = M (struct let foo = "foo" end) module M2 = M (struct let foo = "\n\nfoo\n\n" end) ppx_expect-0.17.2/test/negative-tests/similar_distinct_outputs.ml.corrected.expected000066400000000000000000000005361470323401700311550ustar00rootroot00000000000000module M (S : sig val foo : string end) = struct let%expect_test "similar passing" = print_string S.foo; [%expect {| foo |}] ;; let%expect_test "similar failing" = print_string S.foo; [%expect {| foo |}] ;; end module M1 = M (struct let foo = "foo" end) module M2 = M (struct let foo = "\n\nfoo\n\n" end) ppx_expect-0.17.2/test/negative-tests/spacing.ml000066400000000000000000000011411470323401700216550ustar00rootroot00000000000000open Core let%expect_test _ = let text_no_final_nl () = print_string "one\ntwo(no newline)\nthree" in text_no_final_nl (); [%expect {| one two(no newline) three |}]; (* take an integer tag to [text] help the different tests be distinguished somewhat in the .expected.patdiff *) let text n = Printf.printf "one\ntwo(%d)\nthree\n" n in text 1; [%expect {| one two(1) three|}]; text 2; [%expect {| one two(2) three |}]; (* Check that it reindents expectation properly *) printf " one\n blah\n three"; [%expect {| one two three |}] ;; ppx_expect-0.17.2/test/negative-tests/spacing.ml.corrected.expected000066400000000000000000000012071470323401700254310ustar00rootroot00000000000000open Core let%expect_test _ = let text_no_final_nl () = print_string "one\ntwo(no newline)\nthree" in text_no_final_nl (); [%expect {| one two(no newline) three |}]; (* take an integer tag to [text] help the different tests be distinguished somewhat in the .expected.patdiff *) let text n = Printf.printf "one\ntwo(%d)\nthree\n" n in text 1; [%expect {| one two(1) three |}]; text 2; [%expect {| one two(2) three |}]; (* Check that it reindents expectation properly *) printf " one\n blah\n three"; [%expect {| one blah three |}] ;; ppx_expect-0.17.2/test/negative-tests/string_extension_syntax.ml000066400000000000000000000005201470323401700252410ustar00rootroot00000000000000let%expect_test "correction for expect node" = print_endline "Testing"; print_endline "1"; print_endline "2"; print_endline "3"; {%expect xxx|what|xxx} ;; let%expect_test "correction for expect exact node" = print_endline "Testing"; print_endline "1"; print_endline "2"; print_endline "3"; {%expect_exact|what|} ;; ppx_expect-0.17.2/test/negative-tests/string_extension_syntax.ml.corrected.expected000066400000000000000000000005711470323401700310200ustar00rootroot00000000000000let%expect_test "correction for expect node" = print_endline "Testing"; print_endline "1"; print_endline "2"; print_endline "3"; {%expect xxx| Testing 1 2 3 |xxx} ;; let%expect_test "correction for expect exact node" = print_endline "Testing"; print_endline "1"; print_endline "2"; print_endline "3"; {%expect_exact|Testing 1 2 3 |} ;; ppx_expect-0.17.2/test/negative-tests/string_padding.ml000066400000000000000000000001051470323401700232240ustar00rootroot00000000000000let%expect_test _ = print_string "hello"; [%expect "goodbye"] ;; ppx_expect-0.17.2/test/negative-tests/string_padding.ml.corrected.expected000066400000000000000000000001031470323401700267730ustar00rootroot00000000000000let%expect_test _ = print_string "hello"; [%expect "hello"] ;; ppx_expect-0.17.2/test/negative-tests/tag.ml000066400000000000000000000007371470323401700210160ustar00rootroot00000000000000open! Core let%expect_test _ = (* Correction should include a string tag *) print_string "{|String tag required|}"; [%expect {||}]; print_string "{|String tag required|}"; [%expect_exact {||}] ;; let%expect_test _ = (* The correction should use the same string-kind (normal,quoted) as the [%expect] *) print_string "foo\\bar"; [%expect {||}]; print_string "hey\\ho"; [%expect_exact ""]; print_string {| Foo "bar baz"|}; [%expect.unreachable] ;; ppx_expect-0.17.2/test/negative-tests/tag.ml.corrected.expected000066400000000000000000000011071470323401700245570ustar00rootroot00000000000000open! Core let%expect_test _ = (* Correction should include a string tag *) print_string "{|String tag required|}"; [%expect {xxx| {|String tag required|} |xxx}]; print_string "{|String tag required|}"; [%expect_exact {xxx|{|String tag required|}|xxx}] ;; let%expect_test _ = (* The correction should use the same string-kind (normal,quoted) as the [%expect] *) print_string "foo\\bar"; [%expect {| foo\bar |}]; print_string "hey\\ho"; [%expect_exact "hey\\ho"]; print_string {| Foo "bar baz"|}; [%expect {| Foo "bar baz" |}] ;; ppx_expect-0.17.2/test/negative-tests/test-output.expected000066400000000000000000000554621470323401700237560ustar00rootroot00000000000000File "export_test.ml", line 2, characters 2-24 threw (Failure "Trying to run an expect test from the wrong file.\ \n- test declared at ppx/ppx_expect/test/negative-tests/export_test.ml:2\ \n- trying to run it from ppx/ppx_expect/test/negative-tests/import_test.ml\ \n"). FAILED 1 / 71 tests ------ chdir.ml ++++++ chdir.ml.corrected File "chdir.ml", line 6, characters 0-1: |let%expect_test _ = | print_string "About to change dir"; | Sys.mkdir "tmp" 0o755; | Sys.chdir "tmp"; | Sys.rmdir "../tmp"; -| [%expect] +| [%expect {| About to change dir |}] |;; ------ comment.ml ++++++ comment.ml.corrected File "comment.ml", line 4, characters 0-1: |let () = Printexc.record_backtrace false | |let%expect_test _ = raise (Failure "RIP") -|(* this fails, but the comment stays *) [@@expect.uncaught_exn {||}] +|(* this fails, but the comment stays *) [@@expect.uncaught_exn {| (Failure RIP) |}] |;; ------ escaped_strings.ml ++++++ escaped_strings.ml.corrected File "escaped_strings.ml", line 3, characters 0-1: |let%expect_test "escaped carriage return" = | print_string "a\rb"; -| [%expect ""]; +| [%expect "a\rb"]; | print_string "a\rb"; -| [%expect_exact ""]; +| [%expect_exact "a\rb"]; | print_string "a\r\nb"; -| [%expect ""]; -| print_string "a\r\nb"; -| [%expect_exact ""]; -| print_string "a\n\rb"; -| [%expect ""]; -| print_string "a\n\rb"; -| [%expect_exact ""] +| [%expect " +| a +| b +| "]; +| print_string "a\r\nb"; +| [%expect_exact "a\r +|b"]; +| print_string "a\n\rb"; +| [%expect " +| a +| b +| "]; +| print_string "a\n\rb"; +| [%expect_exact "a +|\rb"] |;; | |let%expect_test "escaped tab" = | print_string "a\tb"; -| [%expect ""]; +| [%expect "a\tb"]; | print_string "a\tb"; -| [%expect_exact ""]; +| [%expect_exact "a\tb"]; | print_string "a\t\nb"; -| [%expect ""]; -| print_string "a\t\nb"; -| [%expect_exact ""]; -| print_string "a\n\tb"; -| [%expect ""]; -| print_string "a\n\tb"; -| [%expect_exact ""] +| [%expect " +| a +| b +| "]; +| print_string "a\t\nb"; +| [%expect_exact "a\t +|b"]; +| print_string "a\n\tb"; +| [%expect " +| a +| b +| "]; +| print_string "a\n\tb"; +| [%expect_exact "a +|\tb"] |;; | |let%expect_test "escaped quote" = | print_string "a\"b"; -| [%expect ""]; +| [%expect "a\"b"]; | print_string "a\"b"; -| [%expect_exact ""] +| [%expect_exact "a\"b"] |;; | |let%expect_test "escaped trailing carriage return" = | print_string "a\r\nb\r\n"; -| [%expect ""]; -| print_string "a\r\nb\r\n"; -| [%expect_exact ""]; -| print_string "a\r\nb\r\n"; -| [%expect]; -| print_string "a\r\nb\r\n"; -| [%expect_exact] +| [%expect " +| a +| b +| "]; +| print_string "a\r\nb\r\n"; +| [%expect_exact "a\r +|b\r +|"]; +| print_string "a\r\nb\r\n"; +| [%expect {| +| a +| b +| |}]; +| print_string "a\r\nb\r\n"; +| [%expect_exact {|a +|b +||}] |;; | |let%expect_test "unescaped carriage return --- empty expect" = | print_string "a\r\nb"; -| [%expect]; -| print_string "a\r\nb"; -| [%expect_exact] +| [%expect {| +| a +| b +| |}]; +| print_string "a\r\nb"; +| [%expect_exact {|a +|b|}] |;; | |let%expect_test "unescaped carriage return --- populated expect" = | print_string "a\r\nb"; | [%expect | {| | a -| b |}]; +| b +| |}]; | print_string "a\r\nb"; | [%expect_exact | {|a |b|}] |;; ------ exact.ml ++++++ exact.ml.corrected File "exact.ml", line 7, characters 0-1: |open! Core | |(* Check that [%expect_exact] does not strip leading/trailing newlines *) |let%expect_test _ = | print_string "foobarbaz"; | [%expect_exact -| {| -| foobarbaz -| |}] +| {|foobarbaz|}] |;; | |(* Check that [%expect_exact] does not treat whitespace as indentation *) |let%expect_test _ = | print_string "\nfoobarbaz\n"; | [%expect_exact | {| -| foobarbaz -| |}] +|foobarbaz +||}] |;; | |(* Check that [%expect_exact] does not strip whitespace on single lines *) |let%expect_test _ = | print_string "foobarbaz"; -| [%expect_exact {| foobarbaz |}] +| [%expect_exact {|foobarbaz|}] |;; ------ exn.ml ++++++ exn.ml.corrected File "exn.ml", line 4, characters 0-1: |open! Core | |let%expect_test _ = -| [%expect {| hi ho |}]; +| [%expect {| |}]; | Printexc.record_backtrace false; | ignore (failwith "hi ho" : unit); -| [%expect {| it's off to work we go |}] +| [%expect.unreachable] +|[@@expect.uncaught_exn {| (Failure "hi ho") |}] |;; | |let%expect_test _ = | Printexc.record_backtrace false; | ignore (failwith "hi ho" : unit); | [%expect.unreachable] -|[@@expect.uncaught_exn -| {| -| (Failure "hi ho") -||}] +|[@@expect.uncaught_exn {| (Failure "hi ho") |}] |;; ------ exn_and_trailing.ml ++++++ exn_and_trailing.ml.corrected File "exn_and_trailing.ml", line 4, characters 0-1: |let%expect_test _ = | print_endline "hello"; | if true then raise Exit; -| [%expect {| hello |}] -|[@@expect.uncaught_exn {| Exit |}] +| [%expect.unreachable] +|[@@expect.uncaught_exn {| +| Exit +| Trailing output +| --------------- +| hello +| |}] |;; ------ exn_missing.ml ++++++ exn_missing.ml.corrected File "exn_missing.ml", line 6, characters 0-1: |open! Core | |let%expect_test "without trailing output" = | printf "hello world"; | [%expect "hello world"] -|[@@expect.uncaught_exn {| (Failure "hi ho") |}] |;; | -|let%expect_test "with trailing output" = printf "hello world" -|[@@expect.uncaught_exn {| (Failure "hi ho") |}] +|let%expect_test "with trailing output" = printf "hello world"; +| [%expect {| hello world |}] |;; ------ expect_output.ml ++++++ expect_output.ml.corrected File "expect_output.ml", line 8, characters 0-1: |open! Core | |let%expect_test _ = | if false | then ( | print_string "hello"; | print_string [%expect.output]; -| [%expect {||}]) +| [%expect.unreachable]) |;; ------ flexible.ml ++++++ flexible.ml.corrected File "flexible.ml", line 16, characters 0-1: |open! Core | |(* | In old versions of [ppx_expect], the below tests would respect the formatting of the | incorrect output present when possible. | | Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, | so we instead use this test to demonstrate that all of the below expectations are | reformatted to the same thing. |*) | |(* Single line actual... *) | |let%expect_test _ = | print_string "hello"; -| [%expect {||}] +| [%expect {| hello |}] |;; | |let%expect_test _ = | print_string "hello"; | [%expect -| {| -| |}] +| {| hello |}] |;; | |let%expect_test _ = | print_string "hello"; | [%expect -| {| -| |}] +| {| hello |}] |;; | |let%expect_test _ = | print_string "hello"; | [%expect -| {| WRONG -| |}] +| {| hello |}] |;; | |let%expect_test _ = | print_string "hello"; | [%expect -| {| WRONG -| |}] +| {| hello |}] |;; | |let%expect_test _ = | print_string "hello"; | [%expect -| {| -| WRONG |}] +| {| hello |}] |;; | |let%expect_test _ = | print_string "hello"; | [%expect -| {| -| WRONG -| |}] +| {| hello |}] |;; | |(* Multi line actual... *) | |let%expect_test _ = | print_string "one1\ntwo"; -| [%expect {||}] +| [%expect {| +| one1 +| two +| |}] |;; | |let%expect_test _ = | print_string "one2\ntwo"; | [%expect | {| -| |}] +| one2 +| two +| |}] |;; | |let%expect_test _ = | print_string "one3\ntwo"; | [%expect | {| -| |}] +| one3 +| two +| |}] |;; | |let%expect_test _ = | print_string "one4\ntwo"; | [%expect -| {| WRONG -| |}] +| {| +| one4 +| two +| |}] |;; | |let%expect_test _ = | print_string "one5\ntwo"; | [%expect | {| -| WRONG |}] +| one5 +| two +| |}] |;; | |let%expect_test _ = | print_string "one6\ntwo"; | [%expect | {| -| WRONG -| |}] +| one6 +| two +| |}] |;; | |let%expect_test _ = | print_string "one8\ntwo"; | [%expect | {| -| WRONG -| THING |}] +| one8 +| two +| |}] |;; | |let%expect_test _ = | print_string "one9\ntwo"; | [%expect | {| -| WRONG -| THING -| |}] +| one9 +| two +| |}] |;; | |let%expect_test _ = | print_string "one10\ntwo"; | [%expect | {| -| WRONG -| THING -| |}] +| one10 +| two +| |}] |;; | |let%expect_test _ = | print_string "one11\ntwo"; | [%expect | {| -| WRONG -| THING -| |}] +| one11 +| two +| |}] |;; ------ function_with_distinct_outputs.ml ++++++ function_with_distinct_outputs.ml.corrected File "function_with_distinct_outputs.ml", line 10, characters 0-1: |module Expect_test_config = struct | include Expect_test_config | | let upon_unreleasable_issue = `Warning_for_collector_testing |end | |let%expect_test _ = | let f output = | print_string output; -| [%expect {| hello world |}] +| [%expect {| +| (* expect_test: Test ran multiple times with different test outputs *) +| ============================ Output 1 / 2 ============================ +| foo +| ============================ Output 2 / 2 ============================ +| bar +| |}] | in | f "foo"; | f "bar" |;; ------ functor.ml ++++++ functor.ml.corrected File "functor.ml", line 13, characters 0-1: |module Expect_test_config = struct | include Expect_test_config | | let upon_unreleasable_issue = `Warning_for_collector_testing |end | |module M (S : sig | val output : string | end) = |struct | let%expect_test _ = | print_string S.output; -| [%expect {| hello world |}]; -| print_string S.output +| [%expect {| +| (* expect_test: Test ran multiple times with different test outputs *) +| ============================ Output 1 / 3 ============================ +| foo +| ============================ Output 2 / 3 ============================ +| bar +| ============================ Output 3 / 3 ============================ +| cat +| |}]; +| print_string S.output; +| [%expect {| +| (* expect_test: Test ran multiple times with different trailing outputs *) +| ============================== Output 1 / 3 ============================== +| foo +| ============================== Output 2 / 3 ============================== +| bar +| ============================== Output 3 / 3 ============================== +| cat +| |}] | ;; | | let%expect_test _ = | print_string S.output; | if not (String.equal S.output "foo") then failwith "wrong output"; | [%expect {| foo |}] +| [@@expect.uncaught_exn {| +| (* expect_test: Test ran multiple times with different uncaught exceptions *) +| =============================== Output 1 / 3 ================================ +| +| =============================== Output 2 / 3 ================================ +| (Failure "wrong output") +| Trailing output +| --------------- +| bar +| =============================== Output 3 / 3 ================================ +| (Failure "wrong output") +| Trailing output +| --------------- +| cat +| |}] | ;; | | let%expect_test _ = | if String.equal S.output "bar" then print_string S.output else failwith "wrong output"; -| [%expect.unreachable] -| [@@expect.uncaught_exn {| (Failure "wrong output") |}] +| [%expect {| bar |}] +| [@@expect.uncaught_exn {| +| (* expect_test: Test ran multiple times with different uncaught exceptions *) +| =============================== Output 1 / 3 ================================ +| (Failure "wrong output") +| =============================== Output 2 / 3 ================================ +| +| =============================== Output 3 / 3 ================================ +| (Failure "wrong output") +| |}] | ;; |end | |module A = M (struct | let output = "foo" | end) | |module B = M (struct | let output = "bar" | end) | |module C = M (struct | let output = "cat" | end) ------ missing.ml ++++++ missing.ml.corrected File "missing.ml", line 7, characters 0-1: |open! Core | |(* Example with no [%expect] node at all *) | |let%expect_test _ = | print_string "hello\n"; -| print_string "goodbye\n" +| print_string "goodbye\n"; +| [%expect {| +| hello +| goodbye +| |}] |;; | |(* Example with an [%expect] node that has no payload *) | |let%expect_test _ = | print_string "hello\n"; | print_string "goodbye\n"; -| [%expect]; +| [%expect {| +| hello +| goodbye +| |}]; | ignore ("don't print" : string); -| [%expect] +| [%expect {| |}] |;; ------ nine.ml ++++++ nine.ml.corrected File "nine.ml", line 21, characters 0-1: | so we instead use this test to demonstrate that all of the below expectations are | reformatted to the same thing. |*) | |let%expect_test _ = | | let module _ = struct | let () = | print_string "hello"; | [%expect {| hello |}] | ;; | | let () = | print_string "hello\n"; | [%expect -| {| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "hello\n\n"; | [%expect -| {| -| hello -| -| |}] +| {| hello |}] | ;; | | let () = | print_string "\nhello"; | [%expect -| {| -| -| hello|}] +| {| hello |}] | ;; | | let () = | print_string "\nhello\n"; | [%expect -| {| -| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "\nhello\n\n"; | [%expect -| {| -| -| hello -| -| |}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello"; | [%expect -| {| -| -| -| hello|}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello\n"; | [%expect -| {| -| -| -| hello -| |}] +| {| hello |}] | ;; | | let () = | print_string "\n\nhello\n\n"; | [%expect -| {| -| -| -| hello -| -| |}] +| {| hello |}] | ;; | end | in | () |;; ------ normal_strings.ml ++++++ normal_strings.ml.corrected File "normal_strings.ml", line 3, characters 0-1: |let%expect_test "short quoted string" = | print_string "foo\nbar\n"; -| [%expect ""] +| [%expect " +| foo +| bar +| "] |;; | |let%expect_test "long quoted string" = | print_string | {| | XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX | XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX | XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX | XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX | XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXX | |}; -| [%expect ""] +| [%expect " +| XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +| XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +| XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +| XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +| XXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXX +| "] |;; | |let%expect_test "quoted strings with leading spaces" = | print_string | {| | live | long | and | prosper | |}; -| [%expect ""]; +| [%expect " +| live +| long +| and +| prosper +| "]; | print_string | {| | live | loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong | and | prosper | |}; -| [%expect ""] +| [%expect " +| live +| loooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong +| and +| prosper +| "] |;; ------ semicolon.ml ++++++ semicolon.ml.corrected File "semicolon.ml", line 3, characters 0-1: |let%expect_test _ = | print_string "one"; -| [%expect {| two |}] +| [%expect {| one |}] |;; ------ similar_distinct_outputs.ml ++++++ similar_distinct_outputs.ml.corrected File "similar_distinct_outputs.ml", line 12, characters 0-1: |module M (S : sig | val foo : string | end) = |struct | let%expect_test "similar passing" = | print_string S.foo; | [%expect {| foo |}] | ;; | | let%expect_test "similar failing" = | print_string S.foo; -| [%expect {| bar |}] +| [%expect {| foo |}] | ;; |end | |module M1 = M (struct | let foo = "foo" | end) | |module M2 = M (struct | let foo = "\n\nfoo\n\n" | end) ------ spacing.ml ++++++ spacing.ml.corrected File "spacing.ml", line 8, characters 0-1: |open Core | |let%expect_test _ = | let text_no_final_nl () = print_string "one\ntwo(no newline)\nthree" in | text_no_final_nl (); | [%expect | {| -| -| one -| two(no newline) -| -| three -| |}]; +| one +| two(no newline) +| three +| |}]; | (* take an integer tag to [text] help the different tests be distinguished somewhat in the | .expected.patdiff *) | let text n = Printf.printf "one\ntwo(%d)\nthree\n" n in | text 1; | [%expect | {| -| one -| two(1) -| three|}]; +| one +| two(1) +| three +| |}]; | text 2; | [%expect | {| | one -| two(2) +| two(2) | three -| |}]; +| |}]; | (* Check that it reindents expectation properly *) | printf " one\n blah\n three"; | [%expect | {| -| one -| two -| three -| |}] +| one +| blah +| three +| |}] |;; ------ string_extension_syntax.ml ++++++ string_extension_syntax.ml.corrected File "string_extension_syntax.ml", line 6, characters 0-1: |let%expect_test "correction for expect node" = | print_endline "Testing"; | print_endline "1"; | print_endline "2"; | print_endline "3"; -| {%expect xxx|what|xxx} +| {%expect xxx| +| Testing +| 1 +| 2 +| 3 +| |xxx} |;; | |let%expect_test "correction for expect exact node" = | print_endline "Testing"; | print_endline "1"; | print_endline "2"; | print_endline "3"; -| {%expect_exact|what|} +| {%expect_exact|Testing +|1 +|2 +|3 +||} |;; ------ string_padding.ml ++++++ string_padding.ml.corrected File "string_padding.ml", line 3, characters 0-1: |let%expect_test _ = | print_string "hello"; -| [%expect "goodbye"] +| [%expect "hello"] |;; ------ tag.ml ++++++ tag.ml.corrected File "tag.ml", line 6, characters 0-1: |open! Core | |let%expect_test _ = | (* Correction should include a string tag *) | print_string "{|String tag required|}"; -| [%expect {||}]; +| [%expect {xxx| {|String tag required|} |xxx}]; | print_string "{|String tag required|}"; -| [%expect_exact {||}] +| [%expect_exact {xxx|{|String tag required|}|xxx}] |;; | |let%expect_test _ = | (* The correction should use the same string-kind (normal,quoted) as the [%expect] *) | print_string "foo\\bar"; -| [%expect {||}]; +| [%expect {| foo\bar |}]; | print_string "hey\\ho"; -| [%expect_exact ""]; +| [%expect_exact "hey\\ho"]; | print_string | {| | Foo | "bar baz"|}; -| [%expect.unreachable] +| [%expect {| +| Foo +| "bar baz" +| |}] |;; ------ three.ml ++++++ three.ml.corrected File "three.ml", line 14, characters 0-1: |(* | In old versions of [ppx_expect], all of the tests below would pass. | | Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, | so we instead use this test to demonstrate that all of the below expectations are | reformatted to the same thing. |*) | |let%expect_test _ = | let text_no_final_nl () = print_string "one\ntwo\nthree" in | text_no_final_nl (); | [%expect | {| -| one -| two -| three|}]; +| one +| two +| three +| |}]; | let text () = print_string "one\ntwo\nthree\n" in | (* Base example *) | text (); | [%expect | {| -| one -| two -| three -||}]; +| one +| two +| three +| |}]; | (* ok to omit space between "expect" and "{" *) | text (); | [%expect | {| -| one -| two -| three -||}]; +| one +| two +| three +| |}]; | (* indentation allowed *) | text (); | [%expect | {| -| one -| two -| three -||}] +| one +| two +| three +| |}] |;; ------ trailing.ml ++++++ trailing.ml.corrected File "trailing.ml", line 8, characters 0-1: |open! Core | |(* Example with trailing output after last [%expect] node *) | |let%expect_test _ = | print_string "hello"; | [%expect {| hello |}]; -| print_string "goodbye\n" +| print_string "goodbye\n"; +| [%expect {| goodbye |}] |;; | |let%expect_test _ = | print_string "foo"; | [%expect {| foo |}]; -| print_string "bar" +| print_string "bar"; +| [%expect {| bar |}] |;; | |let%expect_test _ = | print_string "hello world"; | [%expect {| hello world |}] |;; ------ trailing_in_module.ml ++++++ trailing_in_module.ml.corrected File "trailing_in_module.ml", line 10, characters 0-1: |open! Core | |module M (X : Sexpable) = struct | module N (Y : sig | val x : X.t | end) = | struct | let%expect_test "trailing output" = | let sexp = X.sexp_of_t Y.x in -| print_s sexp +| print_s sexp; +| [%expect {| +| "a\ +| \nb\ +| \nc" +| |}] | ;; | | let%expect_test "error" = | if String.length (string_of_sexp (X.sexp_of_t Y.x)) > 1 | then raise_s (Base.Sexp.message "sexp is too long" [ "input: ", X.sexp_of_t Y.x ]) +| [@@expect.uncaught_exn {| +| ("sexp is too long" ("input: " "a\ +| \nb\ +| \nc")) +| |}] | ;; | end |end | |module String_tests = M (String) | |module Run_on_abc = String_tests.N (struct | let x = "a\nb\nc" | end) ------ unidiomatic_syntax.ml ++++++ unidiomatic_syntax.ml.corrected File "unidiomatic_syntax.ml", line 4, characters 0-1: |[%%expect_test | let _ = | Printf.printf "Hello, world.\n"; -| [%expect {| Good night, moon. |}] +| [%expect {| Hello, world. |}] | ;;] ------ unusual_payload_location.ml ++++++ unusual_payload_location.ml.corrected File "unusual_payload_location.ml", line 6, characters 0-1: |let%expect_test _ = | print_endline "Does it get moved?"; | print_endline "Let's hope not."; | [%expect | -| {| Do not move this payload |} +| {| +| Does it get moved? +| Let's hope not. +| |} | | ] | |let%expect_test _ = | print_endline "Does it get moved?"; | print_endline "Let's hope not."; | [%expect_exact | -| {| Do not move this payload |} +| {|Does it get moved? +|Let's hope not. +||} | | ] ppx_expect-0.17.2/test/negative-tests/three.ml000066400000000000000000000013361470323401700213460ustar00rootroot00000000000000(* In old versions of [ppx_expect], all of the tests below would pass. Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, so we instead use this test to demonstrate that all of the below expectations are reformatted to the same thing. *) let%expect_test _ = let text_no_final_nl () = print_string "one\ntwo\nthree" in text_no_final_nl (); [%expect {| one two three|}]; let text () = print_string "one\ntwo\nthree\n" in (* Base example *) text (); [%expect {| one two three |}]; (* ok to omit space between "expect" and "{" *) text (); [%expect {| one two three |}]; (* indentation allowed *) text (); [%expect {| one two three |}] ;; ppx_expect-0.17.2/test/negative-tests/three.ml.corrected.expected000066400000000000000000000014271470323401700251200ustar00rootroot00000000000000(* In old versions of [ppx_expect], all of the tests below would pass. Currently, [ppx_expect] instead enforces standardized formatting in [[%expect]] nodes, so we instead use this test to demonstrate that all of the below expectations are reformatted to the same thing. *) let%expect_test _ = let text_no_final_nl () = print_string "one\ntwo\nthree" in text_no_final_nl (); [%expect {| one two three |}]; let text () = print_string "one\ntwo\nthree\n" in (* Base example *) text (); [%expect {| one two three |}]; (* ok to omit space between "expect" and "{" *) text (); [%expect {| one two three |}]; (* indentation allowed *) text (); [%expect {| one two three |}] ;; ppx_expect-0.17.2/test/negative-tests/trailing.ml000066400000000000000000000005331470323401700220460ustar00rootroot00000000000000open! Core (* Example with trailing output after last [%expect] node *) let%expect_test _ = print_string "hello"; [%expect {| hello |}]; print_string "goodbye\n" ;; let%expect_test _ = print_string "foo"; [%expect {| foo |}]; print_string "bar" ;; let%expect_test _ = print_string "hello world"; [%expect {| hello world |}] ;; ppx_expect-0.17.2/test/negative-tests/trailing.ml.corrected.expected000066400000000000000000000006151470323401700256200ustar00rootroot00000000000000open! Core (* Example with trailing output after last [%expect] node *) let%expect_test _ = print_string "hello"; [%expect {| hello |}]; print_string "goodbye\n"; [%expect {| goodbye |}] ;; let%expect_test _ = print_string "foo"; [%expect {| foo |}]; print_string "bar"; [%expect {| bar |}] ;; let%expect_test _ = print_string "hello world"; [%expect {| hello world |}] ;; ppx_expect-0.17.2/test/negative-tests/trailing_in_module.ml000066400000000000000000000007671470323401700241120ustar00rootroot00000000000000open! Core module M (X : Sexpable) = struct module N (Y : sig val x : X.t end) = struct let%expect_test "trailing output" = let sexp = X.sexp_of_t Y.x in print_s sexp ;; let%expect_test "error" = if String.length (string_of_sexp (X.sexp_of_t Y.x)) > 1 then raise_s (Base.Sexp.message "sexp is too long" [ "input: ", X.sexp_of_t Y.x ]) ;; end end module String_tests = M (String) module Run_on_abc = String_tests.N (struct let x = "a\nb\nc" end) ppx_expect-0.17.2/test/negative-tests/trailing_in_module.ml.corrected.expected000066400000000000000000000013731470323401700276550ustar00rootroot00000000000000open! Core module M (X : Sexpable) = struct module N (Y : sig val x : X.t end) = struct let%expect_test "trailing output" = let sexp = X.sexp_of_t Y.x in print_s sexp; [%expect {| "a\ \nb\ \nc" |}] ;; let%expect_test "error" = if String.length (string_of_sexp (X.sexp_of_t Y.x)) > 1 then raise_s (Base.Sexp.message "sexp is too long" [ "input: ", X.sexp_of_t Y.x ]) [@@expect.uncaught_exn {| ("sexp is too long" ("input: " "a\ \nb\ \nc")) |}] ;; end end module String_tests = M (String) module Run_on_abc = String_tests.N (struct let x = "a\nb\nc" end) ppx_expect-0.17.2/test/negative-tests/unidiomatic_syntax.ml000066400000000000000000000001521470323401700241450ustar00rootroot00000000000000[%%expect_test let _ = Printf.printf "Hello, world.\n"; [%expect {| Good night, moon. |}] ;;] ppx_expect-0.17.2/test/negative-tests/unidiomatic_syntax.ml.corrected.expected000066400000000000000000000001461470323401700277210ustar00rootroot00000000000000[%%expect_test let _ = Printf.printf "Hello, world.\n"; [%expect {| Hello, world. |}] ;;] ppx_expect-0.17.2/test/negative-tests/unusual_payload_location.ml000066400000000000000000000004351470323401700253330ustar00rootroot00000000000000let%expect_test _ = print_endline "Does it get moved?"; print_endline "Let's hope not."; [%expect {| Do not move this payload |}] ;; let%expect_test _ = print_endline "Does it get moved?"; print_endline "Let's hope not."; [%expect_exact {| Do not move this payload |}] ;; ppx_expect-0.17.2/test/negative-tests/unusual_payload_location.ml.corrected.expected000066400000000000000000000005141470323401700311020ustar00rootroot00000000000000let%expect_test _ = print_endline "Does it get moved?"; print_endline "Let's hope not."; [%expect {| Does it get moved? Let's hope not. |} ] let%expect_test _ = print_endline "Does it get moved?"; print_endline "Let's hope not."; [%expect_exact {|Does it get moved? Let's hope not. |} ] ppx_expect-0.17.2/test/no-output-patterns/000077500000000000000000000000001470323401700205505ustar00rootroot00000000000000ppx_expect-0.17.2/test/no-output-patterns/dune000066400000000000000000000001261470323401700214250ustar00rootroot00000000000000(library (name ppx_expect_test_no_output_patterns) (preprocess (pps ppx_expect))) ppx_expect-0.17.2/test/no-output-patterns/test.ml000066400000000000000000000001301470323401700220530ustar00rootroot00000000000000let%expect_test _ = print_endline "toto (regexp)"; [%expect {| toto (regexp) |}] ;; ppx_expect-0.17.2/test/no-output-patterns/test.mli000066400000000000000000000000551470323401700222320ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/non_flushing.c000066400000000000000000000003711470323401700175760ustar00rootroot00000000000000#include CAMLprim value stdout_from_stubs_but_dont_flush(value vunit) { printf("hello from c"); return vunit; } CAMLprim value stderr_from_stubs_but_dont_flush(value vunit) { fprintf(stderr, "error from c"); return vunit; } ppx_expect-0.17.2/test/string_extension_syntax.ml000066400000000000000000000005621470323401700223050ustar00rootroot00000000000000let%expect_test "correction for expect node" = print_endline "Testing"; print_endline "1"; print_endline "2"; print_endline "3"; {%expect| Testing 1 2 3 |} ;; let%expect_test "correction for expect exact node" = print_endline "Testing"; print_endline "1"; print_endline "2"; print_endline "3"; {%expect_exact|Testing 1 2 3 |} ;; ppx_expect-0.17.2/test/string_extension_syntax.mli000066400000000000000000000000551470323401700224530ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/test_output.ml000066400000000000000000000013401470323401700176670ustar00rootroot00000000000000let%expect_test "expect.output" = Printf.printf "hello\n"; let output = [%expect.output] in Printf.printf "'%s'\n" (String.uppercase_ascii output); [%expect {| 'HELLO ' |}]; Printf.printf "string without line break"; let output = [%expect.output] in Printf.printf "%s\n" (String.uppercase_ascii output); [%expect {| STRING WITHOUT LINE BREAK |}] ;; let%expect_test "Ensure repeated expect.outputs clean up in-betweeen" = Printf.printf "first"; let output1 = [%expect.output] in Printf.printf "second"; let output2 = [%expect.output] in Printf.printf "%s" (String.uppercase_ascii output2); [%expect {| SECOND |}]; Printf.printf "%s" (String.uppercase_ascii output1); [%expect {| FIRST |}] ;; ppx_expect-0.17.2/test/test_output.mli000066400000000000000000000000551470323401700200420ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/test_sanitize.ml000066400000000000000000000011671470323401700201640ustar00rootroot00000000000000let%expect_test "no sanitization" = print_endline "hi!"; [%expect {| hi! |}] ;; let%test_module _ = (module struct module Expect_test_config = struct include Expect_test_config let sanitize s = if s = "" then "" else "local module sanitize: " ^ s end let%expect_test "local sanitize" = print_endline "hi!"; [%expect {| local module sanitize: hi! |}] ;; end) ;; module Expect_test_config = struct include Expect_test_config let sanitize s = if s = "" then "" else "SANITIZED: " ^ s end let%expect_test "sanitize" = print_endline "hi!"; [%expect {| SANITIZED: hi! |}] ;; ppx_expect-0.17.2/test/test_sanitize.mli000066400000000000000000000000551470323401700203300ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/test_stderr.ml000066400000000000000000000001371470323401700176350ustar00rootroot00000000000000let%expect_test "stderr is collected" = Printf.eprintf "hello\n"; [%expect {| hello |}] ;; ppx_expect-0.17.2/test/test_stderr.mli000066400000000000000000000000551470323401700200050ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/uncaught_exn.ml000066400000000000000000000005461470323401700177670ustar00rootroot00000000000000let%expect_test _ = Printexc.record_backtrace false; assert false [@@expect.uncaught_exn {| "Assert_failure uncaught_exn.ml:3:2" |}] ;; let%expect_test "Expectation with uncaught expectation" = Printexc.record_backtrace false; ignore (assert false); [%expect.unreachable] [@@expect.uncaught_exn {| "Assert_failure uncaught_exn.ml:9:10" |}] ;; ppx_expect-0.17.2/test/uncaught_exn.mli000066400000000000000000000000551470323401700201330ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/unflushed_stubs_output.ml000066400000000000000000000004351470323401700221310ustar00rootroot00000000000000external stdout_no_flush : unit -> unit = "stdout_from_stubs_but_dont_flush" external stderr_no_flush : unit -> unit = "stderr_from_stubs_but_dont_flush" let%expect_test _ = stdout_no_flush (); [%expect {| hello from c |}]; stderr_no_flush (); [%expect {| error from c |}] ;; ppx_expect-0.17.2/test/unflushed_stubs_output.mli000066400000000000000000000000551470323401700223000ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/unidiomatic_syntax.ml000066400000000000000000000001461470323401700212060ustar00rootroot00000000000000[%%expect_test let _ = Printf.printf "Hello, world.\n"; [%expect {| Hello, world. |}] ;;] ppx_expect-0.17.2/test/unidiomatic_syntax.mli000066400000000000000000000000551470323401700213560ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ppx_expect-0.17.2/test/unreachable.ml000066400000000000000000000000701470323401700175400ustar00rootroot00000000000000let%expect_test _ = if false then [%expect.unreachable] ppx_expect-0.17.2/test/unreachable.mli000066400000000000000000000000551470323401700177140ustar00rootroot00000000000000(*_ This signature is deliberately empty. *)