pax_global_header00006660000000000000000000000064144066011610014511gustar00rootroot0000000000000052 comment=3c0464871690562b93bd2501811d5a4b9821a5aa ounit-2.2.7/000077500000000000000000000000001440660116100126575ustar00rootroot00000000000000ounit-2.2.7/.github/000077500000000000000000000000001440660116100142175ustar00rootroot00000000000000ounit-2.2.7/.github/workflows/000077500000000000000000000000001440660116100162545ustar00rootroot00000000000000ounit-2.2.7/.github/workflows/main.yml000066400000000000000000000021461440660116100177260ustar00rootroot00000000000000name: Main workflow on: pull_request: push: schedule: # Prime the caches every Monday - cron: 0 1 * * MON jobs: build: strategy: fail-fast: false matrix: os: - macos-latest - windows-latest ocaml-compiler: - 4.14.x runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v3 - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 if: ${{ runner.os }} != 'Windows' with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 if: ${{ runner.os }} == 'Windows' with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-repositories: | opam-repository-mingw: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset default: https://github.com/ocaml/opam-repository.git - run: opam install . --deps-only --with-test - run: opam exec -- dune build - run: opam exec -- dune runtest ounit-2.2.7/.gitignore000066400000000000000000000000501440660116100146420ustar00rootroot00000000000000_build/ *.merlin *.install *.swp /dist/ ounit-2.2.7/CHANGES.md000066400000000000000000000163421440660116100142570ustar00rootroot00000000000000## v2.2.7 - 2022-02-08 ### Fixed - Handle end of channel in Seq API. #95, @Leonidas-from-XIV - Windows and OCaml 5 compatibility. #96, @MisterDA ### Changed - Update to Dune 3.0 for newer stanzas and warnings. #96, @MisterDA ## v2.2.6 - 2022-02-08 ### Fixed - Use package seq to prepare for OCaml 5.00. Thanks to kit-ty-kate. ## v2.2.5 - 2022-01-22 ### Fixed - Remove Thread.kill call, it was anyway not implemented and now it is officially deprecated. (Closes: #85) ## v2.2.4 - 2020-12-20 ### Fixed - Skip AssertCodePosition test if no debug symbols are available. (Closes: #21) ## v2.2.3 - 2020-07-11 ### Changed - Minimal OCaml version is now 4.04. ### Fixed - Make colored output and JUnit features more prominent in the documentation. (Closes: #13, #12) - Increase default timeouts, so that they work as well for slow architecture like s390x. The fastest timeout is now 20s (immediate test) and the longest is 1h (huge test). (Closes: #18) ## v2.2.2 - 2020-01-24 ### Fixed - Don't follow symlink in bracket_tmpdir removal code (Closes: #11). ## v2.2.1 - 2019-10-02 ### Fixed - Fix problem with OCaml 4.03 and ambiguous command (Closes: #10). ## v2.2.0 - 2019-09-25 ### Changed - Rename ounit/ounit-lwt OPAM and library to ounit2/ounit2-lwt. The META file to rename oUnit to ounit was not working on Windows and MacOSX because their filesystems are case insensitive and the install directories were the same. The new ounit2/ounit2-lwt packages avoid name clash on Windows/MacOSX and we still have ounit/ounit-lwt to allow the transition to the new package name. (Closes: #8) ## v2.1.2 - 2019-09-23 ### Fixed - Fix assert_raises type, which has been inadvertently changed during the migration to dune. - Add unix dependency to ounit.advanced. ## v2.1.1 - 2019-09-23 ### Changed - install a backward compatible META to help the transition from oUnit to ounit library name. In order to depend on OUnit now, the name "ounit" should be used (rather than the old "oUnit"). This change allows to be consistent with the name of the opam package. ## v2.1.0 - 2019-09-22 ### Added - New logger for CI, like Travis and AppVeyor, with colored output. It is enabled by adding OUNIT_CI=true to environment section of .travis.yml or appveyor.yml. - ounit-lwt to build test with OUnit and Lwt. It also allows to use the runner "processes" to run test in parallel. (Closes: OF#1765) ### Changed - assert_command only displays the difference with the initial environment. This avoids to have hundreeds of lines of useless environment variables. - Upgrade minimal OCaml version to 4.02, since dune requires at least this version. ### Fixed - Run garbage collection in between tests to prevent unexpected bugs in GC (e.g finaliser throwing exceptions). (Closes: OF#1766) ## v2.0.8 - Handle infinity and NaN in cmp_float, thanks to Johannes Kloos (Closes: OF#1381) ## v2.0.7 - Prevent OUnitLoggerJUnit to fail when the hostname cannot be found, thanks to Bailey Parker for the fix (Closes: OF#1744) ## v2.0.6 - Fix internal uppercase_name. ## v2.0.5 - Allow to recover from interrupted Unix.select call. This allows to run more reliably the RunnerProcess with lwt. (Closes: OF#1363) ## v2.0.4 - minor bug fixes: - replace String.map by Buffer.* to be compatible with OCaml < 4.0. ## v2.0.3 - minor bug fixes: - use Marshal.from_string to be compatible with OCaml <= 4.01. - declare dependency on bytes in _oasis ## v2.0.2 - minor bug fixes: - replace String.uppercase_ascii. ## v2.0.1 - minor bug fixes - fix safe-string compatibility issuesi, thanks to Christoph Spiel (Closes: OF#1760, OF#1761) - fix some format string errors, thanks to Damien Doligez (Closes: OF#1422) - fix backward incompatibility with OUnit v1 (Closes: OF#1392) ## v2.0.0 - major rewrite of all the code! - implements a quickfix compatible way of outputting failures, it jumps to the a position in the logfile to help you debug the problem. - better configuration setup: environment variable, command line options, configuration files (OUnitConf) - improved output of the tests: output HTML report, output JUnit report, systematic logging to a file (OUnitLogger*) - choose how to run a test: in parallel using processes (auto-detect number of CPU), concurrently using threads or sequentially as before. - choose which test to run: just run test in sequence (simple) or run the tests that failed in the last run first and skip the success if they are still failing (failfirst) (OUnitChooser) - OUnitBracket: use a registration in the context to make it easier to use - remove all useless functions in the OUnit2 interface - non-fatal section: allow to fail inside non-fatal section without quitting immediately the whole test - refactor OUnit.ml to still provides the same function but using OUnit2. - timer that makes tests fail if they take too long (runner = processes) - allow to parametrize filenames so that you can use OUNIT_OUTPUT_FILE=ounit-$(suite_name)-$(shard_id).log and have $(suite_name) replace by the test suite name - create locks to avoid accessing the same resources within a single process or the whole application (OUnitShared) - OUnitTestData locate test data, if any. - enforce environment cleanness by checking it before and after the test (e.g check that Sys.getcwd is the same). ## v1.1.2 - regenerate with oasis v0.3.0~rc6 ## v1.1.1 - bracket now enforce returning unit - update examples - ListSimpleMake now use the provided comparator for all elements ## v1.1.0 - Add a ~pp_diff parameter to assert_equal and some classic diff operations (Closes: OF#635, OF#642) - Add an assert_command function (Closes: OF#641) - Add a bracket_tmpfile to ease temporary file use - Enhance documentation, translate the docbook manual into ocamldoc and add content - Allow to add extra command line arguments to run_test_tt_main (Closes: OF#640) - Add a -list-test options to run_test_tt_main, to list available tests - Skip tests when using "-only-test", rather than removing it. This way the path is the same even if some tests don't pass (Closes: OF#637) - Add backtrace support (Closes: OF#639), thanks to Michael Ekstrand - Use OASIS - Move to OCaml Forge: http://ounit.forge.ocamlcore.org - Maintenance is now done by Sylvain Le Gall (OCamlCore SARL), thanks to Maas-Maarten Zeeman for all his work ## v1.0.3 - Add the possibility to skip test and mark tests as todo ## v1.0.2 - Refactored OUnit package. The test result and test event data structures are now clearly separated. ## v1.0.1 - Added optional compare function to assert_equal, and a float compare function. Thanks go to Daniel Buenzli ## v1.0.0 - Add bracket support (Thanks go to Laurent Vaucher) - Add an example for bracket usage ## v0.1.0 - Makefile improvements ## v0.0.3 - Added findlib support ## v0.0.2 - Added assert_raises which checks if an exception is raised. (thanks go to Keita Yamaguchi, for the idea) - Fixed (hopefully) the .depend file ## v0.0.1 - First release of ocaml-unit ## Changelog format The format is loosely based on [Keep a Changelog], and this project adheres to [Semantic Versioning]. [Keep a Changelog]: https://keepachangelog.com/en/1.0.0 [Semantic Versioning]: https://semver.org/spec/v2.0.0.html ## BTS references * OF#XX: OCaml Forge BTS (pre-2019) ounit-2.2.7/LICENSE.txt000066400000000000000000000022541440660116100145050ustar00rootroot00000000000000Copyright (c) 2002, 2003 by Maas-Maarten Zeeman Copyright (c) 2010 by OCamlCore SARL Copyright (C) 2013 Sylvain Le Gall The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL. Permission is hereby granted, free of charge, to any person obtaining a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. ounit-2.2.7/Makefile000066400000000000000000000072371440660116100143300ustar00rootroot00000000000000############################################################################ # The OUnit library # # # # Copyright (C) 2002-2008 Maas-Maarten Zeeman. # # Copyright (C) 2010 OCamlCore SARL # # Copyright (C) 2013 Sylvain Le Gall # # # # The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL # # and Sylvain Le Gall. # # # # Permission is hereby granted, free of charge, to any person obtaining # # a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. # # # # See LICENSE.txt for details. # ############################################################################ version = dev default: test build: dune build @install doc: dune build @doc test: dune runtest all: dune build @all dune runtest install: install-ounit install-ounit-lwt install-ounit: -ocamlfind remove oUnit ocamlfind install oUnit src/lib/oUnit/META -patch-version $(version) install-ounit-lwt: -ocamlfind remove ounit-lwt ocamlfind install ounit-lwt src/lib/ounit-lwt/META -patch-version $(version) uninstall: dune uninstall -ocamlfind remove oUnit -ocamlfind remove ounit-lwt clean: dune clean null: true .PHONY: build doc test all uninstall clean null .PHONY: install install-ounit install-ounit-lwt PRECOMMIT_ARGS= \ --exclude log-html \ --exclude Makefile precommit: -@if command -v OCamlPrecommit > /dev/null; then \ OCamlPrecommit $(PRECOMMIT_ARGS); \ else \ echo "Skipping precommit checks.";\ fi test: precommit .PHONY: precommit deploy: doc test dune-release lint git push --all dune-release tag dune-release distrib --skip-tests dune-release publish dune-release opam pkg dune-release opam submit .PHONY: deploy headache: find ./ \ -name _darcs -prune -false \ -o -name _build -prune -false \ -o -name dist -prune -false \ -o -name log-html -prune -false \ -o -name '*[^~]' -type f \ | xargs /usr/bin/headache -h _header -c _headache.config .PHONY: headache ounit-2.2.7/README.md000066400000000000000000000036371440660116100141470ustar00rootroot00000000000000OUnit - xUnit testing framework for OCaml ========================================================================= [![GitHub Actions][gha-badge]][gha] OUnit is a unit test framework for OCaml. It allows one to easily create unit-tests for OCaml code. It is loosely based on [HUnit], a unit testing framework for Haskell. It is similar to [JUnit], and other XUnit testing frameworks. Features: - colored output - JUnit report generation - HTML report generation [HUnit]: https://hunit.sourceforge.net/ [JUnit]: https://junit.org/ [gha]: https://github.com/gildor478/ounit/actions/workflows/main.yml [gha-badge]: https://github.com/gildor478/ounit/actions/workflows/main.yml/badge.svg [opam]: https://opam.ocaml.org Installation ------------ The recommended way to install ounit is via the [opam package manager][opam]: ```sh $ opam install ounit2 ``` Documentation ------------- API documentation is [available online](https://gildor478.github.io/ounit). Examples -------- * From the examples/ directory of ounit: * [test_list.ml](examples/test_list.ml) * [test_stack.ml](examples/test_stack.ml) * External projects: * [OASIS tests](https://github.com/ocaml/oasis/tree/master/test) Transition to ounit2 -------------------- In the past OUnit used the ocamlfind package name "oUnit". It is uncommon to use uppercase letters in ocamlfind package name. It caused some problems during the transition to "dune". It was also not the same name as the OPAM package. As of version 2.2, the opam package ounit and the ocamlfind package oUnit are renamed to ounit2 (the same for both the ocamlfind and opam packages). To do the transition for your own tests: * in OPAM, the library should now depends on "ounit2" or "ounit2-lwt" * in dune files/OASIS/Makefile/pkg.ml replace "oUnit" by "ounit2" and "ounit-lwt" to "ounit2-lwt". We will keep OPAM packages "ounit"/"ounit-lwt" for the transition. ounit-2.2.7/_headache.config000066400000000000000000000100331440660116100157240ustar00rootroot00000000000000############################################################################ # The OUnit library # # # # Copyright (C) 2002-2008 Maas-Maarten Zeeman. # # Copyright (C) 2010 OCamlCore SARL # # Copyright (C) 2013 Sylvain Le Gall # # # # The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL # # and Sylvain Le Gall. # # # # Permission is hereby granted, free of charge, to any person obtaining # # a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. # # # # See LICENSE.txt for details. # ############################################################################ | "setup.ml" -> no | "myocamlbuild.ml" -> no | ".*\\.txt" -> no | ".*\\.txt-exp" -> no | ".*\\.html" -> no | ".*\\.patch" -> no | ".*\\.mkd" -> no | ".*\\.mod" -> no | ".*\\.mlify" -> no | "configure" -> no | ".*\\.sh" -> skip match:"#!.*" | ".*\\.sh" -> frame open:"#" line:"#" close:"#" | ".*\\.ml\\.ab" -> frame open:"(*" line:"*" close:"*)" margin:" " | ".*\\.mli?" -> skip match:"(\\*pp .* \\*)" | ".*\\.mli?" -> frame open:"(*" line:"*" close:"*)" margin:" " | "_headache\\.config" -> frame open:"#" line:"#" close:"#" | "META" -> frame open:"#" line:"#" close:"#" | ".*\\.js" -> frame open:"/*" line:"*" close:"*/" margin:" " | ".*\\.css" -> frame open:"/*" line:"*" close:"*/" margin:" " | "_announce" -> no | "_oasis" -> no | "JUnit.xsd" -> no | "changelog" -> no | "_header" -> no | ".*\\.swp" -> no | ".*\\.po" -> no | ".*\\.po.bak" -> no | ".*\\.mo" -> no | "POTFILES" -> no | "LINGUAS" -> no | ".*\\.pot" -> no | ".*\\.png" -> no | ".*\\.mllib" -> no | ".*\\.itarget" -> no | ".*\\.itarget.in" -> no | ".*\\.odocl" -> no | "_tags" -> no | "\\.boring" -> no | ".*\\.pdf" -> no | "setup\\.log" -> no | "setup\\.data" -> no | ".*\\.data" -> no | ".*\\.tar\\.gz" -> no | ".*\\.tar\\.gz\\.asc" -> no | "\\.gitignore" -> no | ".*\\.lua" -> no ounit-2.2.7/_header000066400000000000000000000023501440660116100141710ustar00rootroot00000000000000The OUnit library Copyright (C) 2002-2008 Maas-Maarten Zeeman. Copyright (C) 2010 OCamlCore SARL Copyright (C) 2013 Sylvain Le Gall The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL and Sylvain Le Gall. Permission is hereby granted, free of charge, to any person obtaining a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. See LICENSE.txt for details. ounit-2.2.7/dune-project000066400000000000000000000001201440660116100151720ustar00rootroot00000000000000(lang dune 3.0) (name ounit) (explicit_js_mode) (formatting (enabled_for dune)) ounit-2.2.7/examples/000077500000000000000000000000001440660116100144755ustar00rootroot00000000000000ounit-2.2.7/examples/dune000066400000000000000000000001141440660116100153470ustar00rootroot00000000000000(tests (names test_list test_stack) (package ounit2) (libraries ounit2)) ounit-2.2.7/examples/test_list.ml000066400000000000000000000055341440660116100170500ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 let empty_list = [] let list_a = [1;2;3] let test_list_length _ = (* Check if the list is empty. *) assert_equal 0 (List.length empty_list); (* Check if a given list contains 3 elements. *) assert_equal 3 (List.length list_a) let test_list_append _ = let list_b = List.append empty_list [1;2;3] in assert_equal list_b list_a let suite = "ExampleTestList" >::: [ "test_list_length" >:: test_list_length; "test_list_append" >:: test_list_append ] let () = run_test_tt_main suite ounit-2.2.7/examples/test_stack.ml000066400000000000000000000067601440660116100172040ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 (* * This test shows how brackets can be used. They are handy to create * a so called fixture, which can be used for multiple tests *) (* prepare a stack for test *) let setup _test_ctxt = let s = Stack.create () in Stack.push 1 s; Stack.push 2 s; Stack.push 3 s; s let teardown _stack _test_ctxt = () let test_top stack = assert_equal 3 (Stack.top stack) let test_clear stack = Stack.clear stack; assert_raises Stack.Empty (fun _ -> let _i = Stack.top stack in ()) let test_pop stack = assert_equal 3 (Stack.pop stack); assert_equal 2 (Stack.pop stack); assert_equal 1 (Stack.pop stack); assert_raises Stack.Empty (fun _ -> let _i : int = Stack.pop stack in ()) let suite = "Test Stack" >::: [ "test_top" >:: (fun test_ctxt -> let stack = bracket setup teardown test_ctxt in test_top stack); "test_clear" >:: (fun test_ctxt -> let stack = bracket setup teardown test_ctxt in test_clear stack); "test_pop" >:: (fun test_ctxt -> let stack = bracket setup teardown test_ctxt in test_pop stack) ] let () = run_test_tt_main suite ounit-2.2.7/ounit-lwt.opam000066400000000000000000000011671440660116100155040ustar00rootroot00000000000000opam-version: "2.0" synopsis: "This is a transition package, ounit-lwt is now ounit2-lwt" description: """ More details for the transition: https://github.com/gildor478/ounit#transition-to-ounit2 """ maintainer: ["Sylvain Le Gall "] authors: ["Sylvain Le Gall"] license: "MIT" homepage: "https://github.com/gildor478/ounit" doc: "https://gildor478.github.io/ounit" bug-reports: "https://github.com/gildor478/ounit/issues" depends: [ "ocamlfind" {build} "ounit2-lwt" {= version} ] install: [ [make "install-ounit-lwt" "version=%{version}%"] ] dev-repo: "git+https://github.com/gildor478/ounit.git" ounit-2.2.7/ounit.opam000066400000000000000000000011571440660116100146770ustar00rootroot00000000000000opam-version: "2.0" synopsis: "This is a transition package, ounit-lwt is now ounit2-lwt" description: """ More details for the transition: https://github.com/gildor478/ounit#transition-to-ounit2 """ maintainer: ["Sylvain Le Gall "] authors: ["Sylvain Le Gall"] license: "MIT" homepage: "https://github.com/gildor478/ounit" doc: "https://gildor478.github.io/ounit" bug-reports: "https://github.com/gildor478/ounit/issues" depends: [ "ocamlfind" {build} "ounit2" {= version} ] install: [ [make "install-ounit" "version=%{version}%"] ] dev-repo: "git+https://github.com/gildor478/ounit.git" ounit-2.2.7/ounit2-lwt.opam000066400000000000000000000013301440660116100155560ustar00rootroot00000000000000opam-version: "2.0" synopsis: "OUnit testing framework" description: """ This library contains helper functions for building Lwt tests using OUnit. """ maintainer: ["Sylvain Le Gall "] authors: ["Sylvain Le Gall"] license: "MIT" homepage: "https://github.com/gildor478/ounit" doc: "https://gildor478.github.io/ounit" bug-reports: "https://github.com/gildor478/ounit/issues" depends: [ "dune" {>= "3.0"} "ocaml" {>= "4.04.0"} "lwt" {>= "2.5.2"} "seq" "ounit2" {= version} "odoc" {with-doc} ] build: [ [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/gildor478/ounit.git" ounit-2.2.7/ounit2.opam000066400000000000000000000015761440660116100147660ustar00rootroot00000000000000opam-version: "2.0" synopsis: "OUnit testing framework" description: """ OUnit is a unit test framework for OCaml. It allows one to easily create unit-tests for OCaml code. It is loosely based on [HUnit], a unit testing framework for Haskell. It is similar to [JUnit], and other XUnit testing frameworks. """ maintainer: ["Sylvain Le Gall "] authors: ["Maas-Maarten Zeeman" "Sylvain Le Gall"] license: "MIT" homepage: "https://github.com/gildor478/ounit" doc: "https://gildor478.github.io/ounit" bug-reports: "https://github.com/gildor478/ounit/issues" depends: [ "dune" {>= "3.0"} "ocaml" {>= "4.04.0"} "base-unix" "seq" "stdlib-shims" "odoc" {with-doc} ] build: [ [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/gildor478/ounit.git" ounit-2.2.7/src/000077500000000000000000000000001440660116100134465ustar00rootroot00000000000000ounit-2.2.7/src/lib/000077500000000000000000000000001440660116100142145ustar00rootroot00000000000000ounit-2.2.7/src/lib/oUnit/000077500000000000000000000000001440660116100153125ustar00rootroot00000000000000ounit-2.2.7/src/lib/oUnit/META000066400000000000000000000004311440660116100157610ustar00rootroot00000000000000description = "Transition package to ounit2" requires = "ounit2" package "threads" ( description = "Transition package to ounit2.threads" requires = "ounit2.threads" ) package "advanced" ( description = "Transition package to ounit2.advanced" requires = "ounit2.advanced" ) ounit-2.2.7/src/lib/oUnit/dune000066400000000000000000000000641440660116100161700ustar00rootroot00000000000000(documentation (package ounit) (mld_files index)) ounit-2.2.7/src/lib/oUnit/index.mld000066400000000000000000000001721440660116100171170ustar00rootroot00000000000000{1 OUnit transitional package} This is a transitional package for ounit2. Use {{: ../ounit2/index.html} ounit2 package}. ounit-2.2.7/src/lib/ounit-lwt/000077500000000000000000000000001440660116100161565ustar00rootroot00000000000000ounit-2.2.7/src/lib/ounit-lwt/META000066400000000000000000000001111440660116100166200ustar00rootroot00000000000000description = "Transition package to ounit2-lwt" requires = "ounit2-lwt" ounit-2.2.7/src/lib/ounit-lwt/dune000066400000000000000000000000701440660116100170310ustar00rootroot00000000000000(documentation (package ounit-lwt) (mld_files index)) ounit-2.2.7/src/lib/ounit-lwt/index.mld000066400000000000000000000002121440660116100177560ustar00rootroot00000000000000{1 OUnit-lwt transitional package} This is a transitional package for ounit2-lwt. Use {{: ../ounit2-lwt/index.html} ounit2-lwt package}. ounit-2.2.7/src/lib/ounit2-lwt/000077500000000000000000000000001440660116100162405ustar00rootroot00000000000000ounit-2.2.7/src/lib/ounit2-lwt/dune000066400000000000000000000001371440660116100171170ustar00rootroot00000000000000(library (name oUnitLwt) (public_name ounit2-lwt) (libraries lwt lwt.unix ounit2.advanced)) ounit-2.2.7/src/lib/ounit2-lwt/oUnitLwt.ml000066400000000000000000000007071440660116100203630ustar00rootroot00000000000000(** Helper to write Lwt tests with OUnit. As of 2019-09-19, this module is still experimental. *) let () = OUnitRunnerProcesses.unix_fork := Lwt_unix.fork (** [lwt_wrapper f] transforms an Lwt function into a test. Example: {[ let test = "SimpleAssertion" >:: (lwt_wrapper (fun ctxt -> Lwt.return 4 >>= fun i -> Lwt.return (assert_equal ~ctxt 4 i))) ]} *) let lwt_wrapper f = fun ctxt -> f ctxt |> Lwt_main.run ounit-2.2.7/src/lib/ounit2/000077500000000000000000000000001440660116100154345ustar00rootroot00000000000000ounit-2.2.7/src/lib/ounit2/advanced/000077500000000000000000000000001440660116100172015ustar00rootroot00000000000000ounit-2.2.7/src/lib/ounit2/advanced/dune000066400000000000000000000004141440660116100200560ustar00rootroot00000000000000(rule (target oUnitLoggerHTMLData.ml) (deps (:data_gen ../../../tools/data_gen/data_gen.exe) oUnit.css oUnit.js) (action (run %{data_gen}))) (library (name oUnitAdvanced) (public_name ounit2.advanced) (wrapped false) (libraries unix seq stdlib-shims)) ounit-2.2.7/src/lib/ounit2/advanced/oUnit.css000066400000000000000000000077551440660116100210270ustar00rootroot00000000000000/**************************************************************************/ /* The OUnit library */ /* */ /* Copyright (C) 2002-2008 Maas-Maarten Zeeman. */ /* Copyright (C) 2010 OCamlCore SARL */ /* Copyright (C) 2013 Sylvain Le Gall */ /* */ /* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL */ /* and Sylvain Le Gall. */ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. */ /* */ /* See LICENSE.txt for details. */ /**************************************************************************/ h1 { font-size: 26px; margin-right: 15px; padding-left: 0px; } h2 { font-size: 20px; margin-right: 15px; padding-left: 5px; } #ounit-current h2 { text-decoration: underline; } #ounit-results-started-at { width: 100%; } .ounit-results-content div { width: 150px; margin-top: 1px; } .ounit-results-content .number { text-align: right; display: inline-block; float: right; width: 50px; } .ounit-results-verdict.ounit-failure { color: red; } .ounit-success h2, .ounit-results-successes .number { background-color: #4a4; } .ounit-failure h2, .ounit-results-failures .number { background-color: #f66; } .ounit-error h2, .ounit-results-errors .number { background-color: #000; color: #fff; } .ounit-skip h2, .ounit-results-skips .number { background-color: #fd0; } .ounit-todo h2, .ounit-results-todos .number { background-color: #aaf; } .ounit-timeout h2, .ounit-results-timeouts .number { background-color: #888; } .ounit-conf h2, .ounit-results h2 { background-color: #aaa; } .ounit-log, .ounit-conf-content { font-family: Lucida Console, Monaco, Courier New, monospace; white-space: nowrap; font-size: 16px; color: #666; margin-left: 20px; } .ounit-duration, .ounit-started-at, .ounit-results-content { margin-bottom: 10px; margin-left: 15px; } .ounit-started-at { margin-bottom: 0; } span.ounit-timestamp { display: inline-block; width: 70px; } .ounit-log .ounit-result, .ounit-results-verdict { font-weight: bold; margin-top: 5px; } #navigation { position: fixed; top: 0; right: 0; background-color: #fff; padding: 9px; border: 1px solid #000; border-top: none; border-right: none; }; ounit-2.2.7/src/lib/ounit2/advanced/oUnit.js000066400000000000000000000074031440660116100206410ustar00rootroot00000000000000/**************************************************************************/ /* The OUnit library */ /* */ /* Copyright (C) 2002-2008 Maas-Maarten Zeeman. */ /* Copyright (C) 2010 OCamlCore SARL */ /* Copyright (C) 2013 Sylvain Le Gall */ /* */ /* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL */ /* and Sylvain Le Gall. */ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. */ /* */ /* See LICENSE.txt for details. */ /**************************************************************************/ var successHidden = true; function displaySuccess(display) { var div = document.getElementsByClassName('ounit-success'); for (var i = 0; i < div.length; i++) { div[i].style.display = display; }; }; function toggleSuccess() { if (successHidden) { displaySuccess('block'); } else { displaySuccess('none'); }; successHidden = ! successHidden; var button = document.getElementById('toggleVisibiltySuccess'); if (successHidden) { button.textContent = 'Show success'; } else { button.textContent = 'Hide success'; }; }; function resetTestCurrent() { var div = document.getElementById('ounit-current'); if (div) { div.removeAttribute('id'); }; }; function setTestCurrent(div) { resetTestCurrent(); div.id = "ounit-current"; div.scrollIntoView(true); }; function nextTest() { var div = document.getElementsByClassName('ounit-test'); var found = false; var foundCurrent = false; var idx = 0; if (div) { for (; !found && idx < div.length; idx++) { if (foundCurrent && div[idx].style.display != 'none') { found = true; }; if (div[idx].id == "ounit-current") { foundCurrent = true; }; }; if (!foundCurrent && div.length > 0) { setTestCurrent(div[0]); } else if (found) { setTestCurrent(div[idx - 1]); } else { resetTestCurrent(); }; }; }; function gotoTop() { window.scrollTo(0,0); resetTestCurrent(); }; ounit-2.2.7/src/lib/ounit2/advanced/oUnitAssert.ml000066400000000000000000000266231440660116100220240ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitUtils open OUnitBracket open OUnitTest let skip_if b msg = if b then raise (Skip msg) let todo msg = raise (Todo msg) let assert_failure msg = raise (OUnit_failure msg) let assert_bool msg b = if not b then assert_failure msg let assert_string str = if not (str = "") then assert_failure str let rec seq_of_channel channel () = match input_char channel with | exception End_of_file -> Seq.Nil | char -> Seq.Cons (char, seq_of_channel channel) let assert_equal ?ctxt ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual = let get_error_string () = let res = buff_format_printf (fun fmt -> Format.pp_open_vbox fmt 0; begin match msg with | Some s -> Format.pp_open_box fmt 0; Format.pp_print_string fmt s; Format.pp_close_box fmt (); Format.pp_print_cut fmt () | None -> () end; begin match printer with | Some p -> Format.fprintf fmt "@[expected: @[%s@]@ but got: @[%s@]@]@," (p expected) (p actual) | None -> Format.fprintf fmt "@[not equal@]@," end; begin match pp_diff with | Some d -> Format.fprintf fmt "@[differences: %a@]@," d (expected, actual) | None -> () end; Format.pp_close_box fmt ()) in let len = String.length res in if len > 0 && res.[len - 1] = '\n' then String.sub res 0 (len - 1) else res in let logf fmt = match ctxt with | Some ctxt -> OUnitLogger.Test.logf ctxt.test_logger `Info fmt | None -> Printf.ksprintf ignore fmt in begin match msg with | Some str -> logf "%s" str; | _ -> () end; begin match printer with | Some p -> logf "Expected: %s" (p expected); logf "Actual: %s" (p actual) | _ -> () end; if not (cmp expected actual) then assert_failure (get_error_string ()) let assert_command ?(exit_code=Unix.WEXITED 0) ?(sinput=Seq.empty) ?(foutput=ignore) ?(use_stderr=true) ?(backtrace=true) ?chdir ?env ~ctxt prg args = let log_environment_diff () = let module SetString = Set.Make(struct type t = string let compare = String.compare end) in let set_of_array a = let ss = ref SetString.empty in for i = 0 to (Array.length a) - 1 do ss := SetString.add (Array.get a i) !ss done; !ss in let current_environment = set_of_array (Unix.environment ()) in let initial_environment = set_of_array ctxt.initial_environment in if SetString.equal current_environment initial_environment then begin OUnitLogger.Test.logf ctxt.test_logger `Info "Environment is the same as original environment."; end else begin OUnitLogger.Test.logf ctxt.test_logger `Info "Environment (diff with original environment):"; SetString.iter (fun s -> OUnitLogger.Test.logf ctxt.test_logger `Info "+%s" s) (SetString.diff current_environment initial_environment); SetString.iter (fun s -> OUnitLogger.Test.logf ctxt.test_logger `Info "-%s" s) (SetString.diff current_environment initial_environment); end in begin match env with | Some a when Array.length a = 0 && Sys.os_type = "Win32" -> OUnitLogger.Test.logf ctxt.test_logger `Info "%s" ("Using an empty environment on Windows could cause "^ "failure when running command.") | _ -> () end; OUnitTest.section_ctxt ctxt (fun ctxt -> let (fn_out, chn_out) = bracket_tmpfile ctxt in let cmd_print fmt = Format.pp_print_string fmt prg; List.iter (Format.fprintf fmt "@ %s") args in (* Start the process *) let in_write = Unix.dup (Unix.descr_of_out_channel chn_out) in let (out_read, out_write) = Unix.pipe () in let err = if use_stderr then in_write else Unix.stderr in let args = Array.of_list (prg :: args) in let env = let param = "OCAMLRUNPARAM" in let analyse_and_fix env = let arr = Array.copy env in let fixed = ref false in let new_var = ref "" in for i = 0 to (Array.length arr) - 1 do let really_starts, current_value = OUnitUtils.start_substr ~prefix:(param^"=") arr.(i) in if really_starts then begin (* Rewrite the params. *) if not (String.contains current_value 'b') then begin arr.(i) <- param^"="^current_value^"b" end; new_var := arr.(i); fixed := true end done; if !fixed then arr else Array.append arr [|param^"=b"|] in if backtrace then begin (* Analyse of the provided environment. *) match env with | Some env -> Some (analyse_and_fix env) | None -> Some (analyse_and_fix (Unix.environment ())) end else begin env end in let command_chdir, in_chdir = match chdir with | Some dn -> dn, fun f -> with_bracket ctxt (bracket_chdir dn) (fun _ _ -> f ()) | None -> Sys.getcwd (), fun f -> f () in let pid = OUnitLogger.Test.logf ctxt.test_logger `Info "%s" (buff_format_printf (fun fmt -> Format.fprintf fmt "Starting command '%t'." cmd_print)); OUnitLogger.Test.logf ctxt.test_logger `Info "Working directory: %S" command_chdir; log_environment_diff (); Unix.set_close_on_exec out_write; match env with | Some e -> in_chdir (fun () -> Unix.create_process_env prg args e out_read in_write err) | None -> in_chdir (fun () -> Unix.create_process prg args out_read in_write err) in let () = Unix.close out_read; Unix.close in_write in let () = (* Dump sinput into the process stdin *) let buff = Bytes.make 1 ' ' in Seq.iter (fun c -> let _i : int = Bytes.set buff 0 c; Unix.write out_write buff 0 1 in ()) sinput; Unix.close out_write in let _, real_exit_code = let rec wait_intr () = try Unix.waitpid [] pid with Unix.Unix_error (Unix.EINTR, _, _) -> wait_intr () in wait_intr () in (* Dump process output to stderr *) begin let chn = open_in_bin fn_out in let buff = Bytes.make 4096 'X' in let len = ref (-1) in while !len <> 0 do len := input chn buff 0 (Bytes.length buff); OUnitLogger.Test.raw_printf ctxt.test_logger "%s" Bytes.(to_string (sub buff 0 !len)); done; close_in chn end; (* Check process status *) assert_equal ~msg:(buff_format_printf (fun fmt -> Format.fprintf fmt "@[Exit status of command '%t'@]" cmd_print)) ~printer:string_of_process_status exit_code real_exit_code; begin let chn = open_in_bin fn_out in try foutput (seq_of_channel chn) with e -> close_in chn; raise e end) let raises f = try let _ = f () in None with e -> Some e let assert_raises ?msg exn (f: unit -> 'a) = let pexn = Printexc.to_string in let get_error_string () = let str = Format.sprintf "expected exception %s, but no exception was raised." (pexn exn) in match msg with | None -> assert_failure str | Some s -> assert_failure (s^"\n"^str) in match raises f with | None -> assert_failure (get_error_string ()) | Some e -> assert_equal ?msg ~printer:pexn exn e ounit-2.2.7/src/lib/ounit2/advanced/oUnitBracket.ml000066400000000000000000000133501440660116100221270ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest type t = (unit -> unit) list let create set_up tear_down test_ctxt = let fixture = set_up test_ctxt in let tear_down test_ctxt = tear_down fixture test_ctxt in OUnitShared.Mutex.with_lock test_ctxt.shared test_ctxt.tear_down_mutex (fun () -> test_ctxt.tear_down <- tear_down :: test_ctxt.tear_down); fixture let logf logger lvl fmt = OUnitLogger.Test.logf logger lvl fmt let bracket_tmpfile ?(prefix="ounit-") ?(suffix=".txt") ?mode test_ctxt = create (fun test_ctxt -> let suffix = "-"^(OUnitTest.get_shard_id test_ctxt)^suffix in let (fn, chn) = Filename.open_temp_file ?mode prefix suffix in logf test_ctxt.test_logger `Info "Created a temporary file: %S." fn; (fn, chn)) (fun (fn, chn) test_ctxt -> (try close_out chn with _ -> ()); try Sys.remove fn; logf test_ctxt.test_logger `Info "Removed a temporary file: %S." fn with _ -> ()) test_ctxt let bracket_tmpdir ?(prefix="ounit-") ?(suffix=".dir") test_ctxt = let max_attempt = 10 in let rec try_hard_mkdir attempt = if max_attempt = attempt then begin OUnitUtils.failwithf "Unable to create temporary directory after %d attempts." attempt end else begin try let suffix = "-"^(OUnitTest.get_shard_id test_ctxt)^suffix in let tmpdn = Filename.temp_file prefix suffix in Sys.remove tmpdn; Unix.mkdir tmpdn 0o755; tmpdn with Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> try_hard_mkdir (max_attempt + 1) end in create (fun test_ctxt -> let tmpdn = try_hard_mkdir 0 in logf test_ctxt.test_logger `Info "Create a temporary directory: %S." tmpdn; tmpdn) (fun tmpdn test_ctxt -> let log_delete fn = logf test_ctxt.test_logger `Info "Delete in a temporary directory: %S." fn in let safe_run f a = try f a with _ -> () in let rec rmdir fn = Array.iter (fun bn -> let fn' = Filename.concat fn bn in let is_dir = try let st = Unix.lstat fn' in st.Unix.st_kind = Unix.S_DIR with _ -> false in if is_dir then begin rmdir fn'; safe_run Unix.rmdir fn'; log_delete fn' end else begin safe_run Sys.remove fn'; log_delete fn' end) (try Sys.readdir fn with _ -> [||]) in rmdir tmpdn; safe_run Unix.rmdir tmpdn; log_delete tmpdn) test_ctxt let chdir_mutex = OUnitShared.Mutex.create OUnitShared.ScopeProcess let bracket_chdir dir = create (fun test_ctxt -> let () = OUnitLogger.infof test_ctxt.logger "Change directory to %S" dir; try OUnitShared.Mutex.lock test_ctxt.shared chdir_mutex; with OUnitShared.Lock_failure -> failwith "Trying to do a nested chdir." in let cur_pwd = Sys.getcwd () in Unix.chdir dir; cur_pwd) (fun cur_pwd test_ctxt -> Unix.chdir cur_pwd; OUnitShared.Mutex.unlock test_ctxt.shared chdir_mutex) let with_bracket test_ctxt bracket f = section_ctxt test_ctxt (fun test_ctxt -> let res = bracket test_ctxt in f res test_ctxt) ounit-2.2.7/src/lib/ounit2/advanced/oUnitCache.ml000066400000000000000000000067771440660116100215760ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest type cache = OUnitTest.result MapPath.t let cache_filename = OUnitConf.make_string_subst_opt "cache_filename" (* TODO: oUnit-$(name).cache *) (Some (Filename.concat OUnitUtils.buildir "oUnit-$(suite_name).cache")) "Cache file to store previous results." let default = MapPath.empty let load conf = match cache_filename conf with | Some fn -> begin try let chn = open_in_bin fn in let cache : cache = try Marshal.from_channel chn with _ -> default in close_in chn; cache with _ -> default end | None -> default let dump conf cache = match cache_filename conf with | Some fn -> begin try let chn = open_out_bin fn in Marshal.to_channel chn cache []; close_out chn with _ -> () end | None -> () let get_result path cache = try Some (MapPath.find path cache) with Not_found -> None let add_result path result cache = MapPath.add path result cache ounit-2.2.7/src/lib/ounit2/advanced/oUnitCheckEnv.ml000066400000000000000000000105121440660116100222370ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* Check environment after and before tests, to check isolation. *) open OUnitTest open OUnitAssert type t = { pwd: string; env: string array; } let create () = { pwd = Sys.getcwd (); env = let e = Unix.environment () in if Sys.os_type = "Win32" then begin let lst = Array.fold_right (fun v lst -> (* On Win32, sometimes an environment variable like: "=C:=C:\\foobar" will be added. AFAIU, this is the absolute location in the drive C: and it helps to resolve relative root path. For example, "C:" which is relative will translate to "C:\\foobar" in this case. We don't take this into account because using "chdir" elsewhere will change this value in the environment. https://devblogs.microsoft.com/oldnewthing/20100506-00/?p=14133 *) if OUnitUtils.starts_with ~prefix:"=" v then lst else v :: lst) e [] in Array.of_list lst end else begin e end; } module EnvElement = struct type t = string let pp_printer = Format.pp_print_string let compare = String.compare let pp_print_sep = OUnitDiff.pp_comma_separator end module SetEnv = OUnitDiff.SetMake(EnvElement) let check test_ctxt t = let t' = create () in List.iter (fun f -> non_fatal test_ctxt (fun _ -> f ())) [ (fun () -> assert_equal ~msg:"Check that the current working dir hasn't changed during the \ test." ~printer:(fun s -> s) t.pwd t'.pwd); (fun () -> let convert t = SetEnv.of_list (Array.to_list t.env) in SetEnv.assert_equal ~msg:"Check that the environment variables haven't changed during \ the test." (convert t) (convert t')); ] ounit-2.2.7/src/lib/ounit2/advanced/oUnitChooser.ml000066400000000000000000000120311440660116100221510ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Heuristic to pick a test to run. @author Sylvain Le Gall *) open OUnitTest type t = { tests_planned: path list; tests_running: path list; tests_passed: result_list; cache: OUnitCache.cache; } type choice = | ChooseToSkip of path | ChooseToPostpone | Choose of path | NoChoice let string_of_choice = function | ChooseToSkip path -> Printf.sprintf "ChooseToSkip %S" (string_of_path path) | ChooseToPostpone -> "ChooseToPostpone" | Choose path -> Printf.sprintf "Choose %S" (string_of_path path) | NoChoice -> "NoChoice" type chooser = t -> choice (** Most simple heuristic, just pick the first test. *) let simple t = match t.tests_planned with | hd :: _ -> Choose hd | [] -> NoChoice module Plugin = OUnitPlugin.Make (struct type t = chooser let name = "chooser" let conf_help = "Select the method to choose tests to run." let default_name = "simple" let default_value = simple end) include Plugin let allskip t = match t.tests_planned with | hd :: _ -> ChooseToSkip hd | [] -> NoChoice let failfirst t = let was_successful = OUnitResultSummary.was_successful in let rec find_failing = function | path :: tl -> begin match OUnitCache.get_result path t.cache with | Some result -> (* Find the first formerly failing test. *) if was_successful [path, result, None] then find_failing tl else Choose path | None -> Choose path end | [] -> begin let wait_results_running = List.fold_left (fun wait path -> match OUnitCache.get_result path t.cache with | Some result -> (not (was_successful [path, result, None])) || wait | None -> (* No former result, we need the result of * this test. *) true) false t.tests_running in if wait_results_running then (* We need more data about currently running tests. *) ChooseToPostpone else if was_successful t.tests_passed then (* All tests that were red has become green, continue. *) simple t else (* Some tests still fail, skip the rest. *) allskip t end in find_failing t.tests_planned let () = register "failfirst" ~-1 failfirst ounit-2.2.7/src/lib/ounit2/advanced/oUnitConf.ml000066400000000000000000000274261440660116100214520ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitUtils exception Parse_error of string type conf = OUnitPropList.t type 'a var = conf -> 'a type metadata = { help: string; get_print: conf -> string; parse_set: string -> conf -> unit; cli: conf -> (string * Arg.spec * string) list; } let metaconf = Hashtbl.create 13 let check_variable_name str = let () = if String.length str = 0 then failwith "'' is not a valid name." in let () = match str.[0] with | '0' .. '9' | '_' -> failwithf "%S is not a valid variable name. It must not start with %C." str str.[0] | _ -> () in String.iter (function | 'A' .. 'Z' | 'a' .. 'z' | '_' | '0' .. '9' -> () | c -> failwithf "%S is not a valid variable name. It must not contain %C." str c) str let cli_name name = let replace_underscores str = let b = Buffer.create (String.length str) in String.iter (function | '_' -> Buffer.add_char b '-' | c -> Buffer.add_char b c) str; Buffer.contents b in "-" ^ replace_underscores name let subst conf extra_subst str = let substitutions = Hashtbl.create (Hashtbl.length metaconf) in let () = (* Fill the substitutions table. *) Hashtbl.iter (fun name metadata -> Hashtbl.add substitutions name (metadata.get_print conf)) metaconf; List.iter (fun (k, v) -> Hashtbl.add substitutions k v) extra_subst in let buff = Buffer.create (String.length str) in Buffer.add_substitute buff (fun var -> try Hashtbl.find substitutions var with Not_found -> failwithf "Unknown substitution variable %S in %S." var str) str; Buffer.contents buff let make ~name ~parse ~print ~default ~help ~fcli () = let () = check_variable_name name; if Hashtbl.mem metaconf name then failwithf "Duplicate definition for configuration variable %S." name in let set, get = OUnitPropList.new_property default in let parse_set str conf = set conf (parse str) in let get_print conf = print (get conf) in Hashtbl.add metaconf name {help = help; get_print = get_print; parse_set = parse_set; cli = (fun conf -> fcli (get conf) (set conf))}; (get: 'a var) let make_string name default help = make ~name ~parse:(fun s -> s) ~print:(fun s -> s) ~default ~help ~fcli: (fun _ set -> [cli_name name, Arg.String set, "str "^help]) () let make_string_subst name default help = let get = make_string name default help in (fun ?(extra_subst=[]) conf -> subst conf extra_subst (get conf)) let make_string_opt name default help = make ~name ~parse: (function | "none" -> None | str -> Some str) ~print: (function | Some x -> x | None -> "none") ~default ~help ~fcli: (fun _ set -> [cli_name name, Arg.String (fun str -> set (Some str)), "str "^help; cli_name ("no_"^name), Arg.Unit (fun () -> set None), Printf.sprintf " Reset value of %s." name]) () let make_string_subst_opt name default opt = let get = make_string_opt name default opt in (fun ?(extra_subst=[]) conf -> match get conf with | Some str -> Some (subst conf extra_subst str) | None -> None) let make_int name default help = make ~name ~parse: (fun str -> try int_of_string str with Failure _ -> raise (Parse_error (Printf.sprintf "%S is not an integer." str))) ~print:string_of_int ~default ~help ~fcli: (fun _ set -> [cli_name name, Arg.Int set, "i "^help]) () let make_float name default help = make ~name ~parse: (fun str -> try float_of_string str with Failure _ -> raise (Parse_error (Printf.sprintf "%S is not a float." str))) ~print:string_of_float ~default ~help ~fcli: (fun _ set -> [cli_name name, Arg.Float set, "f "^help]) () let make_bool name default help = make ~name ~parse: (fun str -> try bool_of_string str with Failure _ -> raise (Parse_error (Printf.sprintf "%S is not a boolean (true or false)." str))) ~print:string_of_bool ~default ~help ~fcli: (fun _ set -> [cli_name name, Arg.Bool set, "{true|false} "^help]) () let make_enum name get_enums default help = let parse str = let enum_lst = get_enums () in if not (List.exists (fun (str', _) -> str = str') enum_lst) then raise (Parse_error (Printf.sprintf "%S is not an allowed value for %s." str name)); str in let get = make ~name ~parse ~print:(fun s -> s) ~default ~help ~fcli: (fun _ set -> [cli_name name, Arg.Symbol (List.map fst (get_enums ()), set), " "^help]) () in fun conf -> try get conf, List.assoc (get conf) (get_enums ()) with Not_found -> failwithf "Enums list for %s has changed during execution." name let make_exec name = let default = let pwd = Sys.getcwd () in let bn = Filename.concat pwd name in if Sys.file_exists (bn^".native") then bn^".native" else if Sys.file_exists (bn^".byte") then bn^".byte" else name in make_string name default (Printf.sprintf "Executable %s." name) let set ~origin conf name value = try (Hashtbl.find metaconf name).parse_set value conf with | Not_found -> failwithf "Variable %S is not defined in the application.\n%s" name origin | Parse_error str -> failwith (str ^ "\n" ^ origin) let file_parse conf fn = let parse lineno line = let origin = Printf.sprintf "File \"%s\", line %d." fn lineno in match trim (trim_comment line) with | "" -> () | str -> begin let name, value = try Scanf.sscanf str "%s = %S" (fun name value -> name, value) with Scanf.Scan_failure _ -> begin try Scanf.sscanf str "%s = %s" (fun name value -> name, value) with Scanf.Scan_failure _ -> failwithf "Unparsable line: %s\n%s" line origin end in set ~origin conf name value end in let chn = open_in fn in let lineno = ref 0 in try while true do let line = input_line chn in incr lineno; parse !lineno line done; () with | End_of_file -> close_in chn | e -> close_in chn; raise e let env_parse conf = let parse name = let uppercase_name = let b = Buffer.create (String.length name) in String.iter (function | 'a' .. 'z' as c -> Buffer.add_char b (Char.chr ((Char.code c) - 32)) | c -> Buffer.add_char b c) name; Buffer.contents b in let env_name = "OUNIT_" ^ uppercase_name in try let value = Sys.getenv env_name in (* Check and translate double quoted variable. *) let value = try Scanf.sscanf value "%S" (fun s -> s) with Scanf.Scan_failure _ -> value in let origin = Printf.sprintf "Environment variable %s=%S." env_name value in set ~origin conf name value with Not_found -> () in Hashtbl.iter (fun name _ -> parse name) metaconf let cli_parse ?argv extra_specs conf = let specs = Hashtbl.fold (fun _ metadata lst -> let cli_lst = match metadata.cli conf with | (key, spec, doc) :: tl -> (key, spec, doc ^ (Printf.sprintf " (default: %s)" (metadata.get_print conf))) :: tl | [] -> [] in cli_lst @ lst) metaconf [] in let all_specs = Arg.align ([ "-conf", Arg.String (file_parse conf), "fn Read configuration file." ] @ (List.sort Stdlib.compare specs) @ extra_specs) in let arg_parse = match argv with | Some arr -> Arg.parse_argv ~current:(ref 0) arr | None -> Arg.parse in arg_parse all_specs (fun x -> raise (Arg.Bad ("Unexpected argument: " ^ x))) ("usage: " ^ Sys.argv.(0) ^ " options*") let default ?(preset=[]) () = let conf = OUnitPropList.create () in List.iter (fun (name, value) -> set ~origin:"Preset by program." conf name value) preset; conf (** Load test options from file, environment and command line (in this order). Not that [extra_specs] is here for historical reason, better use [make] to create command line options. *) let load ?preset ?argv extra_specs = let conf = default ?preset () in if Sys.file_exists "ounit.conf" then file_parse conf "ounit.conf"; env_parse conf; cli_parse ?argv extra_specs conf; conf let dump conf = Hashtbl.fold (fun name metadata lst -> (name, metadata.get_print conf) :: lst) metaconf [] ounit-2.2.7/src/lib/ounit2/advanced/oUnitCore.ml000066400000000000000000000142711440660116100214470ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitUtils open OUnitTest open OUnitLogger (* Plugin initialisation. *) let () = OUnitRunnerProcesses.init () (* * Types and global states. *) (* Run all tests, report starts, errors, failures, and return the results *) let perform_test conf logger runner chooser test = let rec flatten_test path acc = function | TestCase(l, f) -> (path, l, f) :: acc | TestList (tests) -> fold_lefti (fun acc t cnt -> flatten_test ((ListItem cnt)::path) acc t) acc tests | TestLabel (label, t) -> flatten_test ((Label label)::path) acc t in let test_cases = List.rev (flatten_test [] [] test) in runner conf logger chooser test_cases (* A simple (currently too simple) text based test runner *) let run_test_tt conf logger runner chooser test = let () = Printexc.record_backtrace true in let () = (* TODO: move into perform test. *) List.iter (fun (k, v) -> OUnitLogger.report logger (GlobalEvent (GConf (k, v)))) (OUnitConf.dump conf) in (* Now start the test *) let running_time, test_results = time_fun (perform_test conf logger runner chooser) test in (* TODO: move into perform test. *) (* Print test report *) OUnitLogger.report logger (GlobalEvent (GResults (running_time, test_results, OUnitTest.test_case_count test))); (* Reset logger. *) OUnitLogger.close logger; (* Return the results possibly for further processing *) test_results (* Test-only override. *) let run_test_tt_main_conf = ref (fun ?(preset=[]) ?argv extra_specs -> OUnitConf.load ?argv ~preset:(OUnitChooser.preset (OUnitRunner.preset preset)) extra_specs) let suite_name = OUnitConf.make_string "suite_name" "anon" "The name of the test suite running." (* Call this one to act as your main() function. *) let run_test_tt_main ?(exit=Stdlib.exit) suite = let only_test = ref [] in let list_test = ref false in let extra_specs = [ "-only-test", Arg.String (fun str -> only_test := str :: !only_test), "path Run only the selected tests."; "-list-test", Arg.Set list_test, " List tests"; ] in let preset = match suite with | OUnitTest.TestLabel (suite_name, _) -> ["suite_name", suite_name] | OUnitTest.TestCase _ | OUnitTest.TestList _ -> [] in let conf = !run_test_tt_main_conf ~preset extra_specs in if !list_test then begin List.iter (fun pth -> print_endline (OUnitTest.string_of_path pth)) (OUnitTest.test_case_paths suite) end else begin let nsuite = if !only_test = [] then suite else begin match OUnitTest.test_filter ~skip:true !only_test suite with | Some test -> test | None -> failwithf "Filtering test %s lead to no tests." (String.concat ", " !only_test) end in let logger = OUnitLogger.combine [ OUnitLoggerStd.create conf shard_default; OUnitLoggerHTML.create conf; OUnitLoggerJUnit.create conf; OUnitLoggerCI.create conf; ] in let runner_name, runner = OUnitRunner.choice conf in let chooser_name, chooser = OUnitChooser.choice conf in let test_results = OUnitLogger.infof logger "Runner: %s" runner_name; OUnitLogger.infof logger "Chooser: %s" chooser_name; run_test_tt conf logger runner chooser nsuite in if not (OUnitResultSummary.was_successful test_results) then exit 1 end ounit-2.2.7/src/lib/ounit2/advanced/oUnitDiff.ml000066400000000000000000000143631440660116100214310ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open Format module type DIFF_ELEMENT = sig type t val pp_printer: Format.formatter -> t -> unit val compare: t -> t -> int val pp_print_sep: Format.formatter -> unit -> unit end module type S = sig type e type t val compare: t -> t -> int val pp_printer: Format.formatter -> t -> unit val pp_diff: Format.formatter -> (t * t) -> unit val assert_equal: ?msg:string -> t -> t -> unit val of_list: e list -> t end let assert_equal ?msg compare pp_printer pp_diff exp act = OUnitAssert.assert_equal ~cmp:(fun t1 t2 -> (compare t1 t2) = 0) ~printer:(fun t -> let buff = Buffer.create 13 in let fmt = formatter_of_buffer buff in pp_printer fmt t; pp_print_flush fmt (); Buffer.contents buff) ~pp_diff ?msg exp act module SetMake (D: DIFF_ELEMENT) : S with type e = D.t = struct module Set = Set.Make(D) type e = D.t type t = Set.t let compare = Set.compare let pp_printer fmt t = let first = ref true in pp_open_box fmt 0; Set.iter (fun e -> if not !first then D.pp_print_sep fmt (); D.pp_printer fmt e; first := false) t; pp_close_box fmt () let pp_diff fmt (t1, t2) = let first = ref true in let print_list c t = Set.iter (fun e -> if not !first then D.pp_print_sep fmt (); pp_print_char fmt c; D.pp_printer fmt e; first := false) t in pp_open_box fmt 0; print_list '+' (Set.diff t2 t1); print_list '-' (Set.diff t1 t2); pp_close_box fmt () let assert_equal ?msg exp act = assert_equal ?msg compare pp_printer pp_diff exp act let of_list lst = List.fold_left (fun acc e -> Set.add e acc) Set.empty lst end module ListSimpleMake (D: DIFF_ELEMENT) : S with type e = D.t and type t = D.t list = struct type e = D.t type t = e list let rec compare t1 t2 = match t1, t2 with | e1 :: tl1, e2 :: tl2 -> begin match D.compare e1 e2 with | 0 -> compare tl1 tl2 | n -> n end | [], [] -> 0 | _, [] -> -1 | [], _ -> 1 let pp_print_gen pre fmt t = let first = ref true in pp_open_box fmt 0; List.iter (fun e -> if not !first then D.pp_print_sep fmt (); fprintf fmt "%s%a" pre D.pp_printer e; first := false) t; pp_close_box fmt () let pp_printer fmt t = pp_print_gen "" fmt t let pp_diff fmt (t1, t2) = let rec pp_diff' n t1 t2 = match t1, t2 with | e1 :: tl1, e2 :: tl2 -> begin match D.compare e1 e2 with | 0 -> pp_diff' (n + 1) tl1 tl2 | _ -> fprintf fmt "element number %d differ (%a <> %a)" n D.pp_printer e1 D.pp_printer e2 end | [], [] -> () | [], lst -> fprintf fmt "at end,@ "; pp_print_gen "+" fmt lst | lst, [] -> fprintf fmt "at end,@ "; pp_print_gen "-" fmt lst in pp_open_box fmt 0; pp_diff' 0 t1 t2; pp_close_box fmt () let assert_equal ?msg exp act = assert_equal ?msg compare pp_printer pp_diff exp act let of_list lst = lst end let pp_comma_separator fmt () = fprintf fmt ",@ " module EString = struct type t = string let compare = String.compare let pp_printer = Format.pp_print_string let pp_print_sep = pp_comma_separator end module EInt = struct type t = int let compare = ( - ) let pp_printer = Format.pp_print_int let pp_print_sep = pp_comma_separator end ounit-2.2.7/src/lib/ounit2/advanced/oUnitDiff.mli000066400000000000000000000115421440660116100215760ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Unit tests for collection of elements This module allows to define a more precise way to display differences between collection of elements. When collection differ, the tester is interested by what are the missing/extra elements. This module provides a [diff] operation to spot the difference quickly between two sets of elements. Example: {[ open OUnit;; module EInt = struct type t = int let compare = ( - ) let pp_printer = Format.pp_print_int let pp_print_sep = OUnitDiff.pp_comma_separator end module ListInt = OUnitDiff.ListSimpleMake(EInt);; let test_diff () = ListInt.assert_equal [1; 2; 3; 4; 5] [1; 2; 5; 4] ;; let _ = run_test_tt_main ("test_diff" >:: test_diff) ;; ]} when run this test outputs: {[ OUnit: expected: 1, 2, 3, 4, 5 but got: 1, 2, 5, 4 differences: element number 2 differ (3 <> 5) ]} @since 1.1.0 @author Sylvain Le Gall *) (** {2 Signatures} *) (** Definition of an element *) module type DIFF_ELEMENT = sig (** Type of an element *) type t (** Pretty printer for an element *) val pp_printer : Format.formatter -> t -> unit (** Element comparison *) val compare : t -> t -> int (** Pretty print element separator *) val pp_print_sep : Format.formatter -> unit -> unit end (** Definition of standard operations *) module type S = sig (** Type of an element *) type e (** Type of a collection of element *) type t (** Compare a collection of element *) val compare : t -> t -> int (** Pretty printer a collection of element *) val pp_printer : Format.formatter -> t -> unit (** Pretty printer for collection differences *) val pp_diff : Format.formatter -> t * t -> unit (** {!assert_equal} with [~diff], [~cmp] and [~printer] predefined for this collection events *) val assert_equal : ?msg:string -> t -> t -> unit (** Create [t] using of list *) val of_list : e list -> t end (** {2 Implementations} *) (** Collection of elements based on a Set, elements order doesn't matter *) module SetMake : functor (D : DIFF_ELEMENT) -> S with type e = D.t (** Collection of elements based on a List, order matters but difference display is very simple. It stops at the first element which differs. *) module ListSimpleMake : functor (D: DIFF_ELEMENT) -> S with type e = D.t and type t = D.t list val pp_comma_separator : Format.formatter -> unit -> unit module EString : DIFF_ELEMENT with type t = string module EInt : DIFF_ELEMENT with type t = int ounit-2.2.7/src/lib/ounit2/advanced/oUnitLogger.ml000066400000000000000000000154171440660116100220010ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* Logger for information and various OUnit events. *) open OUnitUtils (* See OUnit.mli. *) type position = { filename: string; line: int; } (** See OUnit.mli. *) type log_severity = [`Error | `Warning | `Info] (** See OUnit.mli. *) type 'result test_event = | EStart | EEnd | EResult of 'result | ELog of log_severity * string | ELogRaw of string type ('path, 'result) result_full = ('path * 'result * position option) (** Events which occur at the global level. *) type ('path, 'result) global_event = | GConf of string * string (** Dump a configuration options. *) | GLog of log_severity * string | GStart (** Start running the tests. *) | GEnd (** Finish running the tests. *) | GResults of (float * ('path, 'result) result_full list * int) type ('path, 'result) log_event_t = | GlobalEvent of ('path, 'result) global_event | TestEvent of 'path * 'result test_event type ('path, 'result) log_event = { shard: string; timestamp: float; event: ('path, 'result) log_event_t; } type ('path, 'result) logger = { lshard: string; fwrite: ('path, 'result) log_event -> unit; fpos: unit -> position option; fclose: unit -> unit; } let shard_default = OUnitUtils.shardf 0 let string_of_event ev = let spf fmt = Printf.sprintf fmt in let string_of_log_severity = function | `Error -> "`Error" | `Warning -> "`Warning" | `Info -> "`Info" in match ev with | GlobalEvent e -> begin match e with | GConf (k, v) -> spf "GConf (%S, %S)" k v | GLog (lvl, s) -> spf "GLog (%s, %S)" (string_of_log_severity lvl) s | GStart -> "GStart" | GEnd -> "GEnd" | GResults _ -> "GResults" end | TestEvent (_, e) -> begin match e with | EStart -> "EStart" | EEnd -> "EEnd" | EResult _ -> "EResult (_)" | ELog (lvl, str) -> spf "ELog (%s, %S)" (string_of_log_severity lvl) str | ELogRaw str -> spf "ELogRaw %S" str end let null_logger = { lshard = shard_default; fwrite = ignore; fpos = (fun () -> None); fclose = ignore; } let fun_logger fwrite fclose = { lshard = shard_default; fwrite = (fun log_ev -> fwrite log_ev); fpos = (fun () -> None); fclose = fclose; } let post_logger fpost = let data = ref [] in let fwrite ev = data := ev :: !data in let fclose () = fpost (List.rev !data) in { lshard = shard_default; fwrite = fwrite; fpos = (fun () -> None); fclose = fclose; } let set_shard shard logger = {logger with lshard = shard} let report logger ev = logger.fwrite { shard = logger.lshard; timestamp = now (); event = ev; } let infof logger fmt = Printf.ksprintf (fun str -> report logger (GlobalEvent (GLog (`Info, str)))) fmt let warningf logger fmt = Printf.ksprintf (fun str -> report logger (GlobalEvent (GLog (`Warning, str)))) fmt let errorf logger fmt = Printf.ksprintf (fun str -> report logger (GlobalEvent (GLog (`Error, str)))) fmt let position logger = logger.fpos () let close logger = logger.fclose () let combine lst = let rec fpos = function | logger :: tl -> begin match position logger with | Some _ as pos -> pos | None -> fpos tl end | [] -> None in let lshard = match lst with hd :: _ -> hd.lshard | [] -> shard_default in { lshard = lshard; fwrite = (fun log_ev -> List.iter (fun logger -> logger.fwrite log_ev) lst); fpos = (fun () -> fpos lst); fclose = (fun () -> List.iter (fun logger -> close logger) (List.rev lst)); } module Test = struct type 'result t = 'result test_event -> unit let create logger path = fun ev -> logger.fwrite { shard = logger.lshard; timestamp = now (); event = TestEvent (path, ev) } let raw_printf t fmt = Printf.ksprintf (fun s -> t (ELogRaw s)) fmt let logf t lvl fmt = Printf.ksprintf (fun s -> t (ELog (lvl, s))) fmt end ounit-2.2.7/src/lib/ounit2/advanced/oUnitLoggerCI.ml000066400000000000000000000125251440660116100222120ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* CI logger for OUnit (Travis, AppVeyor...). This logger allows to print results and logs in CI tools like Travis and AppVeyor. *) open OUnitLogger open OUnitResultSummary open OUnitTest let printlf color fmt = let ansi_color = match color with | `Red -> "31" | `Green -> "32" | `Yellow -> "33" | `None -> "" in Printf.fprintf stdout "\027[%sm" ansi_color; Printf.kfprintf (fun chn -> Printf.fprintf chn "\027[0m\n") stdout fmt let successes_color = `None let errors_color = `Red let failures_color = `Red let skips_color = `Yellow let todos_color = `Yellow let timeouts_color = `Red let severity = function | Some `Error -> `Red, "E" | Some `Warning -> `Yellow, "W" | Some `Info -> `None, "I" | None -> `None, "I" let print_separator () = printlf `None "=========================" let render conf events = let smr = OUnitResultSummary.of_log_events conf events in List.iter (fun test_data -> print_separator (); printlf `None "%s" test_data.test_name; begin match test_data.test_result with | RSuccess -> printlf successes_color "Success" | RFailure (str, _, backtrace) -> printlf failures_color "Failure: %s" str; begin match backtrace with | Some txt -> printlf failures_color "Backtrace: %s" txt | None -> () end | RError (str, backtrace) -> printlf errors_color "Error: %s" str; begin match backtrace with | Some txt -> printlf errors_color "Backtrace: %s" txt | None -> () end | RSkip str -> printlf skips_color "Skipped: %s" str; | RTodo str -> printlf todos_color "TODO: %s" str; | RTimeout test_length -> printlf timeouts_color "Timeout %.1fs" (delay_of_length test_length) end; printlf `None "Logs:"; List.iter (fun (tmstp, svrt, str) -> let color, prefix = severity svrt in printlf color "%04.1fs %s: %s" tmstp prefix str) test_data.log_entries; if List.length test_data.log_entries <> 0 then printlf `None "%04.1fs I: End" (test_data.timestamp_end -. test_data.timestamp_start); ) (List.filter (fun test_data -> test_data.test_result <> RSuccess) smr.tests); print_separator (); printlf `None "Summary:"; printlf `None "Tried tests: %d" smr.test_case_count; printlf `Red "Errors: %d" smr.errors; printlf `Red "Failures: %d" smr.failures; printlf `Yellow "Skipped tests: %d" smr.skips; printlf `Yellow "TODO tests: %d" smr.todos; printlf `Red "Timed-out tests: %d" smr.timeouts; () let ci = OUnitConf.make_bool "ci" false "Display logs for CI, like Travis and AppVeyor, in the console with colors." let create conf = if ci conf then post_logger (render conf) else null_logger ounit-2.2.7/src/lib/ounit2/advanced/oUnitLoggerHTML.ml000066400000000000000000000223171440660116100224630ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* HTML logger for OUnit. *) open OUnitLogger open OUnitUtils open OUnitTest open OUnitResultSummary let html_escaper str = let buffer = Buffer.create (String.length str) in let addc = Buffer.add_char buffer in let addse se = addc '&'; Buffer.add_string buffer se; addc ';' in String.iter (function | '"' -> addse "quot" | '&' -> addse "amp" | '<' -> addse "lt" | '>' -> addse "gt" (* | 'Œ' -> addse "OElig" | 'œ' -> addse "oelig" | 'Š' -> addse "Scaron" | 'š' -> addse "scaron" | 'Ÿ' -> addse "Yuml" | 'ˆ' -> addse "circ" | '˜' -> addse "tilde" | ' ' -> addse "ensp" | ' ' -> addse "emsp" | ' ' -> addse "thinsp" | '–' -> addse "ndash" | '—' -> addse "mdash" | '‘' -> addse "lsquo" | '’' -> addse "rsquo" | '‚' -> addse "sbquo" | '“' -> addse "ldquo" | '”' -> addse "rdquo" | '„' -> addse "bdquo" | '†' -> addse "dagger" | '‡' -> addse "Dagger" | '‰' -> addse "permil" | '‹' -> addse "lsaquo" | '›' -> addse "rsaquo" | '€' -> addse "euro" *) | '\'' -> addse "#39" | c -> addc c) str; Buffer.contents buffer let render conf dn events = let smr = OUnitResultSummary.of_log_events conf events in let () = if not (Sys.file_exists dn) then Unix.handle_unix_error (fun () -> Unix.mkdir dn 0o755) () in let chn = open_out (Filename.concat dn "oUnit.css") in let () = output_string chn OUnitLoggerHTMLData.oUnit_css; close_out chn in let chn = open_out (Filename.concat dn "oUnit.js") in let () = output_string chn OUnitLoggerHTMLData.oUnit_js; close_out chn in let chn = open_out (Filename.concat dn "index.html") in let printf fmt = Printf.fprintf chn fmt in printf "\ Test suite %s

Test suite %s

Results

\n" (html_escaper smr.suite_name) smr.charset (html_escaper smr.suite_name); begin let printf_result clss label num = printf "
\n\ %s: %d\n\
\n" clss label num in let printf_non0_result clss label num = if num > 0 then printf_result clss label num in printf "
\ Started at: %s
" (date_iso8601 smr.start_at); printf "
\ Total duration: %.3fs\
" smr.running_time; printf_result "test-count" "Tests count" smr.test_case_count; printf_non0_result "errors" "Errors" smr.errors; printf_non0_result "failures" "Failures" smr.failures; printf_non0_result "skips" "Skipped" smr.skips; printf_non0_result "todos" "TODO" smr.todos; printf_non0_result "timeouts" "Timed out" smr.timeouts; printf_result "successes" "Successes" smr.successes; (* Print final verdict *) if was_successful smr.global_results then printf "
Success
" else printf "
Failure
" end; printf "\

Configuration

\n"; List.iter (fun (k, v) -> printf "%s=%S
\n" (html_escaper k) (html_escaper v)) smr.conf; printf ("\
"); List.iter (fun test_data -> let class_result, text_result = match test_data.test_result with | RSuccess -> "ounit-success", "succeed" | RFailure _ -> "ounit-failure", "failed" | RError _ -> "ounit-error", "error" | RSkip _ -> "ounit-skip", "skipped" | RTodo _ -> "ounit-todo", "TODO" | RTimeout _ -> "ounit-timeout", "timeout" in let class_severity_opt = function | Some `Error -> "ounit-log-error" | Some `Warning -> "ounit-log-warning" | Some `Info -> "ounit-log-info" | None -> "" in printf "

%s (%s)

Started at: %s
Test duration: %.3fs
\n" class_result (html_escaper test_data.test_name) (html_escaper text_result) (date_iso8601 test_data.timestamp_start) (test_data.timestamp_end -. test_data.timestamp_start); printf "%.3fsStart
\n" 0.0; List.iter (fun (tmstp, svrt, str) -> printf "\ %.3fs%s
\n" (class_severity_opt svrt) tmstp (html_escaper str)) test_data.log_entries; printf "%.3fsEnd
\n" (test_data.timestamp_end -. test_data.timestamp_start); printf "
"; begin (* TODO: use backtrace *) match test_data.test_result with | RSuccess -> printf "Success." | RFailure (str, _, _) -> printf "Failure:
%s" (html_escaper str) | RError (str, _) -> printf "Error:
%s" (html_escaper str) | RSkip str -> printf "Skipped:
%s" (html_escaper str) | RTodo str -> printf "Todo:
%s" (html_escaper str) | RTimeout test_length -> printf "Timeout after %.1fs
" (delay_of_length test_length) end; printf "
"; printf "\
\n"; (* TODO: results, end timestamp *)) smr.tests; printf "\ "; close_out chn let output_html_dir = OUnitConf.make_string_subst_opt "output_html_dir" None "Output directory of the HTML files." let create conf = match output_html_dir conf with | Some dn -> post_logger (render conf dn) | None -> null_logger ounit-2.2.7/src/lib/ounit2/advanced/oUnitLoggerJUnit.ml000066400000000000000000000125121440660116100227440ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* JUnit logger for OUnit. *) open OUnitLogger open OUnitUtils open OUnitTest open OUnitResultSummary let xml_escaper = OUnitLoggerHTML.html_escaper let render conf fn events = let smr = OUnitResultSummary.of_log_events conf events in let chn = open_out fn in let string_of_failure = function | msg, None -> msg^"\nNo backtrace." | msg, Some backtrace -> msg^"\n"^backtrace in let printf fmt = Printf.fprintf chn fmt in printf "\ \n" smr.charset (xml_escaper smr.suite_name) (xml_escaper smr.suite_name) (xml_escaper (date_iso8601 ~tz:false smr.start_at)) (xml_escaper (fqdn ())) smr.test_case_count (smr.failures + smr.todos) smr.errors smr.running_time; printf "\ \ \n"; List.iter (fun (k, v) -> printf "\ \ \n" (xml_escaper k) (xml_escaper v)) smr.conf; printf "\ \ \n"; List.iter (fun test_data -> printf "\ \ \n" (xml_escaper test_data.test_name) (xml_escaper test_data.test_name) (test_data.timestamp_end -. test_data.timestamp_start); begin match test_data.test_result with | RSuccess | RSkip _ -> () | RError (msg, backtrace) -> printf "\ \ %s\n" (xml_escaper msg) (xml_escaper (string_of_failure (msg, backtrace))) | RFailure (msg, _, backtrace) -> printf "\ \ %s\n" (xml_escaper msg) (xml_escaper (string_of_failure (msg, backtrace))) | RTodo msg -> printf "\ \ \n" (xml_escaper msg) | RTimeout test_length -> printf "\ \ \n" (delay_of_length test_length) end; printf "\ \ \n") smr.tests; printf "\ \ \n"; List.iter (fun log_event -> List.iter (fun s -> printf "%s\n" (xml_escaper s)) (OUnitLoggerStd.format_log_event log_event)) events; printf "\ \ "; close_out chn let output_junit_file = OUnitConf.make_string_subst_opt "output_junit_file" None "Output file for JUnit." let create conf = match output_junit_file conf with | Some fn -> post_logger (render conf fn) | None -> null_logger ounit-2.2.7/src/lib/ounit2/advanced/oUnitLoggerStd.ml000066400000000000000000000301171440660116100224460ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitLogger open OUnitTest open OUnitResultSummary let ocaml_position pos = Printf.sprintf "File \"%s\", line %d, characters 1-1:" pos.filename pos.line let multiline f str = if String.length str > 0 then let buf = Buffer.create 80 in let flush () = f (Buffer.contents buf); Buffer.clear buf in String.iter (function '\n' -> flush () | c -> Buffer.add_char buf c) str; flush () let count results f = List.fold_left (fun count (_, test_result, _) -> if f test_result then count + 1 else count) 0 results (* TODO: deprecate in 2.1.0. *) let results_style_1_X = OUnitConf.make_bool "results_style_1_X" false "Use OUnit 1.X results printer (will be deprecated in 2.1.0+)." let format_display_event conf log_event = match log_event.event with | GlobalEvent e -> begin match e with | GConf (_, _) | GLog _ | GStart | GEnd -> "" | GResults (running_time, results, test_case_count) -> let separator1 = String.make (Format.get_margin ()) '=' in let separator2 = String.make (Format.get_margin ()) '-' in let buf = Buffer.create 1024 in let bprintf fmt = Printf.bprintf buf fmt in let print_results = List.iter (fun (path, test_result, pos_opt) -> bprintf "%s\n" separator1; if results_style_1_X conf then begin bprintf "%s: %s\n\n" (result_flavour test_result) (string_of_path path); end else begin bprintf "Error: %s.\n\n" (string_of_path path); begin match pos_opt with | Some pos -> bprintf "%s\nError: %s (in the log).\n\n" (ocaml_position pos) (string_of_path path) | None -> () end; begin match test_result with | RError (_, Some backtrace) -> bprintf "%s\n" backtrace | RFailure (_, Some pos, _) -> bprintf "%s\nError: %s (in the code).\n\n" (ocaml_position pos) (string_of_path path) | RFailure (_, _, Some backtrace) -> bprintf "%s\n" backtrace | _ -> () end; end; bprintf "%s\n" (result_msg test_result); bprintf "%s\n" separator2) in let filter f = let lst = List.filter (fun (_, test_result, _) -> f test_result) results in lst, List.length lst in let errors, nerrors = filter is_error in let failures, nfailures = filter is_failure in let skips, nskips = filter is_skip in let _, ntodos = filter is_todo in let timeouts, ntimeouts = filter is_timeout in bprintf "\n"; print_results errors; print_results failures; print_results timeouts; bprintf "Ran: %d tests in: %.2f seconds.\n" (List.length results) running_time; (* Print final verdict *) if was_successful results then begin if skips = [] then bprintf "OK" else bprintf "OK: Cases: %d Skip: %d" test_case_count nskips end else begin bprintf "FAILED: Cases: %d Tried: %d Errors: %d \ Failures: %d Skip: %d Todo: %d \ Timeouts: %d." test_case_count (List.length results) nerrors nfailures nskips ntodos ntimeouts; end; bprintf "\n"; Buffer.contents buf end | TestEvent (_, e) -> begin match e with | EStart | EEnd | ELog _ | ELogRaw _ -> "" | EResult RSuccess -> "." | EResult (RFailure _) -> "F" | EResult (RError _) -> "E" | EResult (RSkip _) -> "S" | EResult (RTodo _) -> "T" | EResult (RTimeout _) -> "~" end let format_log_event ev = let rlst = ref [] in let timestamp_str = OUnitUtils.date_iso8601 ev.timestamp in let spf pre fmt = Printf.ksprintf (multiline (fun l -> rlst := (timestamp_str^" "^ev.shard^" "^pre^": "^l) :: !rlst)) fmt in let ispf fmt = spf "I" fmt in let wspf fmt = spf "W" fmt in let espf fmt = spf "E" fmt in let format_result path result = let path_str = string_of_path path in match result with | RTimeout test_length -> espf "Test %s timed out after %.1fs" path_str (delay_of_length test_length) | RError (msg, backtrace_opt) -> espf "Test %s exited with an error." path_str; espf "%s in test %s." msg path_str; OUnitUtils.opt (espf "%s") backtrace_opt | RFailure (msg, _, backtrace_opt) -> espf "Test %s has failed." path_str; espf "%s in test %s." msg path_str; OUnitUtils.opt (espf "%s") backtrace_opt | RTodo msg -> wspf "TODO test %s: %s." path_str msg | RSkip msg -> wspf "Skip test %s: %s." path_str msg | RSuccess -> ispf "Test %s is successful." path_str in begin match ev.event with | GlobalEvent e -> begin match e with | GConf (k, v) -> ispf "Configuration %s = %S" k v | GLog (`Error, str) -> espf "%s" str | GLog (`Warning, str) -> wspf "%s" str | GLog (`Info, str) -> ispf "%s" str | GStart -> ispf "Start testing." | GEnd -> ispf "End testing." | GResults (running_time, results, test_case_count) -> let counter = count results in ispf "=============="; ispf "Summary:"; List.iter (fun (path, test_result, _) -> format_result path test_result) results; (* Print final verdict *) ispf "Ran: %d tests in: %.2f seconds." (List.length results) running_time; ispf "Cases: %d." test_case_count; ispf "Tried: %d." (List.length results); ispf "Errors: %d." (counter is_error); ispf "Failures: %d." (counter is_failure); ispf "Skip: %d." (counter is_skip); ispf "Todo: %d." (counter is_todo); ispf "Timeout: %d." (counter is_timeout) end | TestEvent (path, e) -> begin let path_str = string_of_path path in match e with | EStart -> ispf "Start test %s." path_str | EEnd -> ispf "End test %s." path_str | EResult result -> format_result path result | ELog (`Error, str) -> espf "%s" str | ELog (`Warning, str) -> wspf "%s" str | ELog (`Info, str) -> ispf "%s" str | ELogRaw str -> ispf "%s" str end end; List.rev !rlst let file_logger _ shard_id fn = let chn = open_out fn in let line = ref 1 in let fwrite ev = List.iter (fun l -> output_string chn l; output_char chn '\n'; incr line) (format_log_event ev); flush chn in let fpos () = Some { filename = fn; line = !line } in let fclose () = close_out chn in { lshard = shard_id; fwrite = fwrite; fpos = fpos; fclose = fclose; } let verbose = OUnitConf.make_bool "verbose" false "Run test in verbose mode." let display = OUnitConf.make_bool "display" true "Output logs on screen." let std_logger conf shard_id = if display conf then let verbose = verbose conf in let fwrite log_ev = if verbose then List.iter print_endline (format_log_event log_ev) else print_string (format_display_event conf log_ev); flush stdout in { lshard = shard_id; fwrite = fwrite; fpos = (fun () -> None); fclose = ignore; } else null_logger let output_file = OUnitConf.make_string_subst_opt "output_file" (Some (Filename.concat OUnitUtils.buildir "oUnit-$(suite_name)-$(shard_id).log")) "Output verbose log in the given file." let is_output_file_shard_dependent conf = let fn1 = output_file ~extra_subst:["shard_id", "foo"] conf in let fn2 = output_file ~extra_subst:["shard_id", "bar"] conf in fn1 <> fn2 let create_file_logger conf shard_id = match output_file ~extra_subst:["shard_id", shard_id] conf with | Some fn -> file_logger conf shard_id fn | None -> null_logger let create conf shard_id = let std_logger = std_logger conf shard_id in let file_logger = create_file_logger conf shard_id in combine [std_logger; file_logger] ounit-2.2.7/src/lib/ounit2/advanced/oUnitPlugin.ml000066400000000000000000000062371440660116100220200ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Standard functions for plugin (register, choose). *) type name = string module type SETTINGS = sig type t val name: name val conf_help: string val default_name: name val default_value: t end module Make(Settings: SETTINGS) = struct let all = ref [0, (Settings.default_name, Settings.default_value)] let register name pref f = all := (pref, (name, f)) :: !all let of_name s = try List.assoc s (List.map snd !all) with Not_found -> OUnitUtils.failwithf "Unable to find %s '%s'." Settings.name s let choice = OUnitConf.make_enum Settings.name (fun () -> List.map snd !all) Settings.default_name Settings.conf_help let preset lst = let _, (default, _) = List.fold_left max (List.hd !all) (List.tl !all) in (Settings.name, default) :: lst end ounit-2.2.7/src/lib/ounit2/advanced/oUnitPropList.ml000066400000000000000000000054741440660116100223400ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Property list. @see MLton property list. *) type t = (int, unit -> unit) Hashtbl.t let create () = Hashtbl.create 13 let new_property default = let id = Oo.id (object end) in let v = ref default in let set t x = Hashtbl.replace t id (fun () -> v := x) in let get t = try let x = (Hashtbl.find t id) (); !v in v := default; x with Not_found -> default in (set, get) ounit-2.2.7/src/lib/ounit2/advanced/oUnitResultSummary.ml000066400000000000000000000241011440660116100234040ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* Summary of the results, based on captured log events. *) open OUnitUtils open OUnitTest open OUnitLogger type log_entry = float (* time since start of the test *) * log_severity option * string (* log entry without \n *) type test_data = { test_name: string; timestamp_start: float; (* UNIX timestamp *) timestamp_end: float; (* UNIX timestamp *) log_entries: log_entry list; (* time sorted log entry, timestamp from timestamp_start *) test_result: OUnitTest.result; } type t = { suite_name: string; start_at: float; charset: string; conf: (string * string) list; running_time: float; global_results: OUnitTest.result_list; test_case_count: int; tests: test_data list; errors: int; failures: int; skips: int; todos: int; timeouts: int; successes: int; } let is_success = function | RSuccess -> true | RFailure _ | RError _ | RSkip _ | RTodo _ | RTimeout _ -> false let is_failure = function | RFailure _ -> true | RSuccess | RError _ | RSkip _ | RTodo _ | RTimeout _ -> false let is_error = function | RError _ -> true | RSuccess | RFailure _ | RSkip _ | RTodo _ | RTimeout _ -> false let is_skip = function | RSkip _ -> true | RSuccess | RFailure _ | RError _ | RTodo _ | RTimeout _ -> false let is_todo = function | RTodo _ -> true | RSuccess | RFailure _ | RError _ | RSkip _ | RTimeout _ -> false let is_timeout = function | RTimeout _ -> true | RSuccess | RFailure _ | RError _ | RSkip _ | RTodo _ -> false let result_flavour = function | RError _ -> "Error" | RFailure _ -> "Failure" | RSuccess -> "Success" | RSkip _ -> "Skip" | RTodo _ -> "Todo" | RTimeout _ -> "Timeout" let result_msg = function | RSuccess -> "Success" | RError (msg, _) | RFailure (msg, _, _) | RSkip msg | RTodo msg -> msg | RTimeout test_length -> Printf.sprintf "Timeout after %.1fs" (delay_of_length test_length) let worst_cmp result1 result2 = let rank = function | RSuccess -> 0 | RSkip _ -> 1 | RTodo _ -> 2 | RFailure _ -> 3 | RError _ -> 4 | RTimeout _ -> 5 in (rank result1) - (rank result2) let worst_result_full result_full lst = let worst = List.fold_left (fun ((_, result1, _) as result_full1) ((_, result2, _) as result_full2) -> if worst_cmp result1 result2 < 0 then result_full2 else result_full1) result_full lst in worst, List.filter (fun result_full -> not (result_full == worst)) (result_full :: lst) let was_successful lst = List.for_all (fun (_, rslt, _) -> match rslt with | RSuccess | RSkip _ -> true | _ -> false) lst let encoding = OUnitConf.make_string "log_encoding" "utf-8" "Encoding of the log." let of_log_events conf events = let global_conf = List.fold_left (fun acc log_ev -> match log_ev.event with | GlobalEvent (GConf (k, v)) -> (k, v) :: acc | _ -> acc) [] (List.rev events) in let running_time, global_results, test_case_count = let rec find_results = function | {event = GlobalEvent (GResults (running_time, results, test_case_count)); _} :: _ -> running_time, results, test_case_count | _ :: tl -> find_results tl | [] -> failwith "Cannot find results in OUnitResult.of_log_events." in find_results events in let tests = let rec split_raw tmstp str lst = try let idx = String.index str '\n' in split_raw tmstp (String.sub str (idx + 1) (String.length str - idx - 1)) ((tmstp, None, String.sub str 0 idx) :: lst) with Not_found -> (tmstp, None, str) :: lst in let finalize t = let log_entries = List.sort (fun (f1, _, _) (f2, _, _) -> Stdlib.compare f2 f1) t.log_entries in let log_entries = List.rev_map (fun (f, a, b) -> f -. t.timestamp_start, a, b) log_entries in {t with log_entries = log_entries} in let default_timestamp = 0.0 in let rec process_log_event tests log_event = let timestamp = log_event.timestamp in match log_event.event with | GlobalEvent _ -> tests | TestEvent (path, ev) -> begin let t = try MapPath.find path tests with Not_found -> { test_name = string_of_path path; timestamp_start = default_timestamp; timestamp_end = default_timestamp; log_entries = []; test_result = RFailure ("Not finished", None, None); } in let alt0 t1 t2 = if t1 = default_timestamp then t2 else t1 in let t' = match ev with | EStart -> {t with timestamp_start = timestamp; timestamp_end = alt0 t.timestamp_end timestamp} | EEnd -> {t with timestamp_end = timestamp; timestamp_start = alt0 t.timestamp_start timestamp} | EResult rslt -> {t with test_result = rslt} | ELog (svrt, str) -> {t with log_entries = (timestamp, Some svrt, str) :: t.log_entries} | ELogRaw str -> {t with log_entries = split_raw timestamp str t.log_entries} in MapPath.add path t' tests end and group_test tests = function | hd :: tl -> group_test (process_log_event tests hd) tl | [] -> let lst = MapPath.fold (fun _ test lst -> finalize test :: lst) tests [] in List.sort (fun t1 t2 -> Stdlib.compare t1.timestamp_start t2.timestamp_start) lst in group_test MapPath.empty events in let start_at = List.fold_left (fun start_at log_ev -> min start_at log_ev.timestamp) (now ()) events in let suite_name = match global_results with | (path, _, _) :: _ -> List.fold_left (fun acc nd -> match nd with | ListItem _ -> acc | Label str -> str) "noname" path | [] -> "noname" in let count f = List.length (List.filter (fun (_, test_result, _) -> f test_result) global_results) in let charset = encoding conf in { suite_name = suite_name; start_at = start_at; charset = charset; conf = global_conf; running_time = running_time; global_results = global_results; test_case_count = test_case_count; tests = tests; errors = count is_error; failures = count is_failure; skips = count is_skip; todos = count is_todo; timeouts = count is_timeout; successes = count is_success; } ounit-2.2.7/src/lib/ounit2/advanced/oUnitRunner.ml000066400000000000000000000446001440660116100220270ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest open OUnitLogger (** Number of shards to use. The way the shards are used depends on the type of runner. *) let shards = let shards = ref 2 in if Sys.os_type = "Unix" then begin if Sys.file_exists "/proc/cpuinfo" then begin let chn_in = open_in "/proc/cpuinfo" in let () = try while true do try let line = input_line chn_in in Scanf.sscanf line "cpu cores : %d" (fun i -> shards := max i 2) with Scanf.Scan_failure _ -> () done with End_of_file -> () in close_in chn_in end end; OUnitConf.make_int "shards" !shards "Number of shards to use as worker (threads or processes)." (** Whether or not run a Gc.full_major in between tests. This adds time when running tests, but helps to avoid unexpected error due to finalisation of values allocated during a test. *) let run_gc_full_major = OUnitConf.make_bool "run_gc_full_major" true "Run a Gc.full_major in between tests." (** Common utilities to run test. *) let run_one_test conf logger shared test_path (test_fun: OUnitTest.test_fun) = let () = OUnitLogger.report logger (TestEvent (test_path, EStart)) in let non_fatal = ref [] in let main_result_full = with_ctxt conf logger shared non_fatal test_path (fun ctxt -> let check_env = OUnitCheckEnv.create () in let result_full = try test_fun ctxt; OUnitCheckEnv.check ctxt check_env; if run_gc_full_major conf then begin Gc.full_major (); end; test_path, RSuccess, None with e -> OUnitTest.result_full_of_exception ctxt e in report_result_full ctxt result_full) in let result_full, other_result_fulls = match main_result_full, List.rev !non_fatal with | (_, RSuccess, _), [] -> main_result_full, [] | (_, RSuccess, _), hd :: tl -> OUnitResultSummary.worst_result_full hd tl | _, lst -> OUnitResultSummary.worst_result_full main_result_full lst in OUnitLogger.report logger (TestEvent (test_path, EEnd)); result_full, other_result_fulls type runner = OUnitConf.conf -> OUnitTest.logger -> OUnitChooser.chooser -> (path * test_length * test_fun) list -> OUnitTest.result_list (* The simplest runner possible, run test one after the other in a single * process, without threads. *) (* Run all tests, sequential version *) let sequential_runner: runner = fun conf logger chooser test_cases -> let shared = OUnitShared.create () in let rec iter state = match OUnitState.next_test_case conf logger state with | OUnitState.Finished, state -> OUnitState.get_results state | OUnitState.Next_test_case (test_path, test_fun, worker), state -> iter (OUnitState.test_finished conf (run_one_test conf logger shared test_path test_fun) worker state) | (OUnitState.Try_again | OUnitState.Not_enough_worker), _ -> assert false in let state = OUnitState.add_worker () (OUnitState.create conf chooser test_cases) in iter state (**/**) (* Plugin interface. *) module Plugin = OUnitPlugin.Make (struct type t = runner let name = "runner" let conf_help = "Select a the method to run tests." let default_name = "sequential" let default_value = sequential_runner end) (**/**) include Plugin (** Build worker based runner. *) module GenericWorker = struct open OUnitState type message_to_worker = | Exit | AckLock of bool | RunTest of path let string_of_message_to_worker = function | Exit -> "Exit" | AckLock _ -> "AckLock _" | RunTest _ -> "RunTest _" type message_from_worker = | AckExit | Log of OUnitTest.log_event_t | Lock of int | Unlock of int | TestDone of (OUnitTest.result_full * OUnitTest.result_list) let string_of_message_from_worker = function | AckExit -> "AckExit" | Log _ -> "Log _" | Lock _ -> "Lock _" | Unlock _ -> "Unlock _" | TestDone _ -> "TestDone _" module MapPath = Map.Make (struct type t = path let rec compare lst1 lst2 = match lst1, lst2 with | hd1 :: tl1, hd2 :: tl2 -> begin match Stdlib.compare hd1 hd2 with | 0 -> compare tl1 tl2 | n -> n end | [], _ :: _ -> -1 | _ :: _, [] -> 1 | [], [] -> 0 end) type map_test_cases = (OUnitTest.path * OUnitTest.test_length * (OUnitTest.ctxt -> unit)) MapPath.t type ('a, 'b) channel = { send_data: 'a -> unit; receive_data: unit -> 'b; close: unit -> unit; } type worker_channel = (message_from_worker, message_to_worker) channel (* Add some extra feature to channel. *) let wrap_channel shard_id string_of_read_message string_of_written_message channel = (* Turn on to debug communication in channel. *) let debug_communication = false in if debug_communication then begin let debugf fmt = Printf.ksprintf (fun s -> if debug_communication then prerr_endline ("D("^shard_id^"): "^s)) fmt in let send_data msg = debugf "Sending message %S" (string_of_written_message msg); channel.send_data msg; debugf "Message transmitted, continuing." in let receive_data () = let () = debugf "Waiting to receive data." in let msg = channel.receive_data () in debugf "Received message %S" (string_of_read_message msg); msg in { send_data = send_data; receive_data = receive_data; close = channel.close; } end else begin channel end (* Run a worker, react to message receive from parent. *) let main_worker_loop ~yield ~shard_id ~worker_log_file (conf: OUnitConf.conf) (channel: worker_channel) (map_test_cases: map_test_cases) = let logger = let master_logger = set_shard shard_id (OUnitLogger.fun_logger (fun {event = log_ev; _} -> channel.send_data (Log log_ev)) ignore) in let base_logger = if worker_log_file then OUnitLoggerStd.create_file_logger conf shard_id else OUnitLogger.null_logger in OUnitLogger.combine [base_logger; master_logger] in let shared = let try_lock id = channel.send_data (Lock id); match channel.receive_data () with | AckLock b -> b | Exit | RunTest _ -> assert false in let rec lock id = if not (try_lock id) then begin yield (); lock id end else begin () end in let unlock id = channel.send_data (Unlock id); in let global = { OUnitShared. lock = lock; try_lock = try_lock; unlock = unlock; } in { OUnitShared. global = global; process = OUnitShared.noscope_create (); } in let rec loop () = match channel.receive_data () with | Exit -> channel.send_data AckExit | RunTest test_path -> let test_path, _, test_fun = MapPath.find test_path map_test_cases in let res = run_one_test conf logger shared test_path test_fun in channel.send_data (TestDone res); loop () | AckLock _ -> loop () in loop () type 'a worker = { channel: (message_to_worker, message_from_worker) channel; close_worker: unit -> string option; select_fd: 'a; shard_id: string; is_running: unit -> bool; } type 'a worker_creator = shard_id:string -> master_id:string -> worker_log_file:bool -> OUnitConf.conf -> map_test_cases -> 'a worker type 'a workers_waiting_selector = timeout:float -> 'a worker list -> 'a worker list (* Run all tests. *) let runner (create_worker: 'a worker_creator) (workers_waiting: 'a workers_waiting_selector) : runner = fun (conf: OUnitConf.conf) logger chooser test_cases -> let map_test_cases = List.fold_left (fun mp ((test_path, _, _) as test_case) -> MapPath.add test_path test_case mp) MapPath.empty test_cases in let state = OUnitState.create conf chooser test_cases in let shards = max (shards conf) 1 in let master_id = logger.OUnitLogger.lshard in let worker_idx = ref 1 in let test_per_worker, incr_tests_per_worker = OUnitUtils.make_counter () in let health_check_per_worker, incr_health_check_per_worker = OUnitUtils.make_counter () in let () = infof logger "Using %d workers maximum." shards; in let worker_log_file = if not (OUnitLoggerStd.is_output_file_shard_dependent conf) then begin warningf logger "-output-file doesn't include $(shard_id), \ shards won't have file log."; false end else begin true end in let master_shared = OUnitShared.noscope_create () in (* Act depending on the received message. *) let process_message worker msg state = match msg with | AckExit -> let msg_opt = infof logger "Worker %s has ended." worker.shard_id; worker.close_worker () in OUnitUtils.opt (errorf logger "Worker return status: %s") msg_opt; remove_idle_worker worker state | Log log_ev -> OUnitLogger.report (set_shard worker.shard_id logger) log_ev; state | Lock id -> worker.channel.send_data (AckLock (master_shared.OUnitShared.try_lock id)); state | Unlock id -> master_shared.OUnitShared.unlock id; state | TestDone test_result -> OUnitState.test_finished conf test_result worker state in (* Report a worker dead and unregister it. *) let declare_dead_worker test_path worker result state = let log_pos = position logger in report logger (TestEvent (test_path, EResult result)); report logger (TestEvent (test_path, EEnd)); remove_idle_worker worker (test_finished conf ((test_path, result, log_pos), []) worker state) in let declare_dead_idle_worker worker state = let msg = Printf.sprintf "Worker %s died unexpectedly." worker.shard_id in report logger (GlobalEvent (GLog (`Info, msg))); remove_idle_worker worker state in (* Kill the worker that has timed out. *) let kill_timeout state = List.fold_left (fun state (test_path, test_length, worker) -> let _msg : string option = errorf logger "Worker %s, running test %s has timed out." worker.shard_id (string_of_path test_path); worker.close_worker () in declare_dead_worker test_path worker (RTimeout test_length) state) state (get_worker_timed_out state) in (* Check that worker are healthy (i.e. still running). *) let check_health state = List.fold_left (fun state (test_path_opt, worker) -> incr_health_check_per_worker worker.shard_id; if worker.is_running () then begin match test_path_opt with | Some test_path -> update_test_activity test_path state | None -> state end else begin match test_path_opt with | Some test_path -> begin (* Argh, a test failed badly! *) let result_msg = errorf logger "Worker %s, running test %s is not running anymore." worker.shard_id (string_of_path test_path); match worker.close_worker () with | Some msg -> Printf.sprintf "Worker stops running: %s" msg | None -> "Worker stops running for unknown reason." in declare_dead_worker test_path worker (RError (result_msg, None)) state end | None -> declare_dead_idle_worker worker state end) state (get_worker_need_health_check state) in (* Main wait loop. *) let wait_test_done state = let state = (check_health (kill_timeout state)) in if get_workers state <> [] then begin let workers_waiting_lst = infof logger "%d tests running: %s." (count_tests_running state) (String.concat ", " (List.map string_of_path (get_tests_running state))); workers_waiting ~timeout:(timeout state) (get_workers state) in List.fold_left (fun state worker -> process_message worker (worker.channel.receive_data ()) state) state workers_waiting_lst end else begin state end in (* Wait for every worker to stop. *) let rec wait_stopped state = if OUnitState.get_workers state = [] then state else wait_stopped (wait_test_done state) in let rec iter state = match OUnitState.next_test_case conf logger state with | Not_enough_worker, state -> if OUnitState.count_worker state < shards then begin (* Start a worker. *) let shard_id = OUnitUtils.shardf !worker_idx in let () = infof logger "Starting worker number %s." shard_id in let worker = create_worker ~shard_id ~master_id ~worker_log_file conf map_test_cases in let () = infof logger "Worker %s started." worker.shard_id in let state = add_worker worker state in incr worker_idx; iter state end else begin iter (wait_test_done state) end | Try_again, state -> iter (wait_test_done state) | Next_test_case (test_path, _, worker), state -> incr_tests_per_worker worker.shard_id; worker.channel.send_data (RunTest test_path); iter state | Finished, state -> let count_tests_running = OUnitState.count_tests_running state in if count_tests_running = 0 then begin let state = List.iter (fun worker -> worker.channel.send_data Exit) (OUnitState.get_workers state); wait_stopped state in infof logger "Used %d worker during test execution." (!worker_idx - 1); List.iter (fun (shard_id, count) -> infof logger "Run %d tests with shard %s." count shard_id) (test_per_worker ()); List.iter (fun (shard_id, count) -> infof logger "Check health of shard %s, %d times." shard_id count) (health_check_per_worker ()); OUnitState.get_results state end else begin infof logger "Still %d tests running : %s." count_tests_running (String.concat ", " (List.map string_of_path (get_tests_running state))); iter (wait_test_done state) end in iter state end ounit-2.2.7/src/lib/ounit2/advanced/oUnitRunnerProcesses.ml000066400000000000000000000216241440660116100237170ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Use processes to run several tests in parallel. * * Run processes that handle running tests. The processes read test, execute * it, and communicate back to the master the log. * * This need to be done in another process because OCaml Threads are not truly * running in parallel. Moreover we cannot use Unix.fork because it's not * portable *) open Unix open OUnitRunner.GenericWorker let unix_fork = ref Unix.fork (* Create functions to handle sending and receiving data over a file descriptor. *) let make_channel shard_id string_of_read_message string_of_written_message fd_read fd_write = let () = set_nonblock fd_read; set_close_on_exec fd_read; set_close_on_exec fd_write in let chn_write = out_channel_of_descr fd_write in let really_read fd str = let off = ref 0 in let read = ref 0 in while !read < Bytes.length str do try let one_read = Unix.read fd str !off (Bytes.length str - !off) in read := !read + one_read; off := !off + one_read with Unix_error(EAGAIN, _, _) -> () done; str in let header_str = Bytes.create Marshal.header_size in let send_data msg = Marshal.to_channel chn_write msg []; Stdlib.flush chn_write in let receive_data () = try let data_size = Marshal.data_size (really_read fd_read header_str) 0 in let data_str = really_read fd_read (Bytes.create data_size) in let msg = (* TODO: use Marshal.from_bytes when OCaml requirement is > 4.01. *) Marshal.from_string (Bytes.unsafe_to_string (Bytes.cat header_str data_str)) 0 in msg with Failure(msg) -> OUnitUtils.failwithf "Communication error with worker processes: %s" msg in let close () = close_out chn_write; in wrap_channel shard_id string_of_read_message string_of_written_message { send_data = send_data; receive_data = receive_data; close = close } let processes_grace_period = OUnitConf.make_float "processes_grace_period" 5.0 "Delay to wait for a process to stop." let processes_kill_period = OUnitConf.make_float "processes_kill_period" 5.0 "Delay to wait for a process to stop after killing it." let rec select_no_interrupt read_descrs write_descrs except_descrs timeout = if timeout < 0.0 then begin [], [], [] end else begin try Unix.select read_descrs write_descrs except_descrs 0.1 with Unix.Unix_error (Unix.EINTR, "select", "") -> select_no_interrupt read_descrs write_descrs except_descrs (timeout -. 0.1) end let create_worker ~shard_id ~master_id ~worker_log_file conf map_test_cases = let safe_close fd = try close fd with Unix_error _ -> () in let pipe_read_from_worker, pipe_write_to_master = Unix.pipe () in let pipe_read_from_master, pipe_write_to_worker = Unix.pipe () in match !unix_fork () with | 0 -> (* Child process. *) let () = safe_close pipe_read_from_worker; safe_close pipe_write_to_worker; (* stdin/stdout/stderr remain open and shared with master. *) () in let channel = make_channel shard_id string_of_message_to_worker string_of_message_from_worker pipe_read_from_master pipe_write_to_master in main_worker_loop conf ~yield:ignore channel ~shard_id map_test_cases ~worker_log_file; channel.close (); safe_close pipe_read_from_master; safe_close pipe_write_to_master; exit 0 | pid -> let channel = make_channel master_id string_of_message_from_worker string_of_message_to_worker pipe_read_from_worker pipe_write_to_worker in let rstatus = ref None in let msg_of_process_status status = if status = WEXITED 0 then None else Some (OUnitUtils.string_of_process_status status) in let is_running () = match !rstatus with | None -> let pid, status = waitpid [WNOHANG] pid in if pid <> 0 then begin rstatus := Some status; false end else begin true end | Some _ -> false in let close_worker () = let rec wait_end timeout = if timeout < 0.0 then begin false, None end else begin if is_running () then let _, _, _ = select_no_interrupt [] [] [] 0.1 in wait_end (timeout -. 0.1) else match !rstatus with | Some status -> true, msg_of_process_status status | None -> true, None end in let ended, msg_opt = channel.close (); safe_close pipe_read_from_worker; safe_close pipe_write_to_worker; (* Recovery for worker going wild and not dying. *) List.fold_left (fun (ended, msg_opt) signal -> if ended then begin ended, msg_opt end else begin kill pid signal; wait_end (processes_kill_period conf) end) (wait_end (processes_grace_period conf)) [15 (* SIGTERM *); 9 (* SIGKILL *)] in if ended then msg_opt else Some (Printf.sprintf "unable to kill process %d" pid) in { channel = channel; close_worker = close_worker; select_fd = pipe_read_from_worker; shard_id = shard_id; is_running = is_running; } (* Filter running workers waiting data. *) let workers_waiting ~timeout workers = let workers_fd_lst = List.rev_map (fun worker -> worker.select_fd) workers in let workers_fd_waiting_lst, _, _ = select_no_interrupt workers_fd_lst [] [] timeout in List.filter (fun workers -> List.memq workers.select_fd workers_fd_waiting_lst) workers let init () = if Sys.os_type = "Unix" then match Sys.backend_type with | Native | Bytecode -> OUnitRunner.register "processes" 100 (runner create_worker workers_waiting) | Other _ -> () ounit-2.2.7/src/lib/ounit2/advanced/oUnitShared.ml000066400000000000000000000111241440660116100217570ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) exception Lock_failure type scope = ScopeGlobal | ScopeProcess type 'a shared_noscope = { lock: 'a -> unit; unlock: 'a -> unit; try_lock: 'a -> bool; } type shared = { global: int shared_noscope; process: int shared_noscope; } let get_scoped shared = function | ScopeGlobal -> shared.global | ScopeProcess -> shared.process (* Global variable that need to be set for threads. *) let mutex_create = ref (fun () -> let r = ref false in let try_lock () = if !r then begin false end else begin r := true; true end in let lock () = if not (try_lock ()) then raise Lock_failure in let unlock () = r := false in { lock = lock; try_lock = try_lock; unlock = unlock; }) module Mutex = struct type t = int * scope let create scope = (Oo.id (object end), scope) let lock shared (id, scope) = (get_scoped shared scope).lock id let try_lock shared (id, scope) = (get_scoped shared scope).try_lock id let unlock shared (id, scope) = (get_scoped shared scope).unlock id let with_lock shared mutex f = try let res = lock shared mutex; f () in unlock shared mutex; res with e -> unlock shared mutex; raise e end (* A simple shared_noscope that works only for 1 process. *) let noscope_create () = let state = Hashtbl.create 13 in let state_mutex = !mutex_create () in let get_mutex id = let mutex = state_mutex.lock (); try Hashtbl.find state id with Not_found -> let mutex = !mutex_create () in Hashtbl.add state id mutex; mutex in state_mutex.unlock (); mutex in let try_lock id = (get_mutex id).try_lock () in let lock id = (get_mutex id).lock () in let unlock id = (get_mutex id).unlock () in { lock = lock; unlock = unlock; try_lock = try_lock; } (* Create a shared, for 1 process. *) let create () = let scoped = noscope_create () in { global = scoped; process = scoped; } ounit-2.2.7/src/lib/ounit2/advanced/oUnitState.ml000066400000000000000000000241161440660116100216360ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Manipulate the state of OUnit runner. *) open OUnitLogger open OUnitTest open OUnitChooser type 'worker next_test_case_t = | Not_enough_worker | Try_again | Next_test_case of path * test_fun * 'worker | Finished type time = float type 'worker test_running = { test_length: test_length; deadline: time; next_health_check: time; worker: 'worker; } type 'worker t = { tests_planned: (path * (test_length * test_fun)) list; tests_running: (path * ('worker test_running)) list; tests_passed: (OUnitTest.result_full * OUnitTest.result_list) list; idle_workers: 'worker list; chooser: OUnitChooser.chooser; cache: OUnitCache.cache; health_check_interval: time; } let health_check_interval = OUnitConf.make_float "health_check_interval" 1.0 "Seconds between checking health of workers." let create conf chooser test_cases = { tests_passed = []; tests_planned = List.map (fun (test_path, test_length, test_fun) -> test_path, (test_length, test_fun)) test_cases; tests_running = []; idle_workers = []; chooser = chooser; cache = OUnitCache.load conf; health_check_interval = health_check_interval conf; } let filter_out e lst = List.filter (fun (e', _) -> e <> e') lst let maybe_dump_cache conf state = if state.tests_running = [] && state.tests_planned = [] then (* We are finished, all results are in, flush the cache. *) OUnitCache.dump conf (List.fold_left (fun cache (path, test_result, _) -> OUnitCache.add_result path test_result cache) state.cache (List.map fst state.tests_passed)); state let add_test_results conf all_test_results state = let ((test_path, _, _), _) = all_test_results in let state = {state with tests_passed = all_test_results :: state.tests_passed; tests_planned = filter_out test_path state.tests_planned}; in maybe_dump_cache conf state let test_finished conf all_test_results worker state = let ((test_path, _, _), _) = all_test_results in let state = {(add_test_results conf all_test_results state) with tests_running = filter_out test_path state.tests_running; idle_workers = worker :: state.idle_workers} in maybe_dump_cache conf state let add_worker worker state = {state with idle_workers = worker :: state.idle_workers} let remove_idle_worker worker state = let found, idle_workers = List.fold_left (fun (found, lst) worker' -> if worker' == worker then true, lst else found, worker' :: lst) (false, []) state.idle_workers in if not found then raise Not_found; {state with idle_workers = idle_workers} let count_worker state = List.length state.idle_workers + List.length state.tests_running let count_tests_running state = List.length state.tests_running let get_workers state = List.rev_append state.idle_workers (List.rev_map (fun (_, {worker = worker; _}) -> worker) state.tests_running) let get_idle_workers state = state.idle_workers let is_idle_worker worker state = List.exists (fun worker' -> worker == worker') state.idle_workers let get_tests_running state = List.map fst state.tests_running let rec next_test_case conf logger state = match state.tests_planned, state.idle_workers with | [], _ -> Finished, state | _, worker :: tl_workers -> begin let choice = state.chooser { OUnitChooser. tests_planned = List.map fst state.tests_planned; tests_running = List.map fst state.tests_running; tests_passed = List.map fst state.tests_passed; cache = state.cache; } in match choice with | Choose test_path -> begin try let test_length, test_fun = List.assoc test_path state.tests_planned in let now = OUnitUtils.now () in Next_test_case (test_path, test_fun, worker), {state with tests_running = (test_path, { test_length = test_length; deadline = now +. delay_of_length test_length; next_health_check = now +. state.health_check_interval; worker = worker; }) :: state.tests_running; tests_planned = filter_out test_path state.tests_planned; idle_workers = tl_workers} with Not_found -> assert false end | ChooseToPostpone -> Try_again, state | ChooseToSkip path -> let skipped_result = RSkip "Skipped by the chooser." in OUnitLogger.report logger (TestEvent (path, EStart)); OUnitLogger.report logger (TestEvent (path, EResult skipped_result)); OUnitLogger.report logger (TestEvent (path, EEnd)); next_test_case conf logger (add_test_results conf ((path, skipped_result, None), []) state) | NoChoice -> Finished, state end | _, [] -> Not_enough_worker, state (** Get all the results. *) let get_results state = List.fold_right (fun (result, other_results) res -> result :: other_results @ res) state.tests_passed [] (** Get all the workers that need to be checked for their health. *) let get_worker_need_health_check state = let now = OUnitUtils.now () in let running_workers = List.fold_left (fun lst (test_path, test_running) -> if test_running.next_health_check <= now then (Some test_path, test_running.worker) :: lst else lst) [] state.tests_running in let idle_workers = List.map (fun worker -> (None, worker)) state.idle_workers in running_workers @ idle_workers (** Update the activity of a worker, this postpone the next health check. *) let update_test_activity test_path state = let now = OUnitUtils.now () in let tests_running = List.fold_right (fun (test_path', test_running) lst -> let test_running = if test_path' = test_path then {test_running with next_health_check = now +. state.health_check_interval} else test_running in (test_path', test_running) :: lst) state.tests_running [] in {state with tests_running = tests_running} (** Get all the workers that are timed out, i.e. that need to be stopped. *) let get_worker_timed_out state = let now = OUnitUtils.now () in List.fold_left (fun lst (test_path, test_running) -> if test_running.deadline <= now then (test_path, test_running.test_length, test_running.worker) :: lst else lst) [] state.tests_running (** Compute when is the next time, we should either run health check or timeout a test. *) let timeout state = let now = OUnitUtils.now () in let next_event_time = List.fold_left (fun next_event_time (_, test_running) -> min test_running.next_health_check (min test_running.deadline next_event_time)) (now +. state.health_check_interval) state.tests_running in max 0.1 (next_event_time -. now) ounit-2.2.7/src/lib/ounit2/advanced/oUnitTest.ml000066400000000000000000000273121440660116100214760ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitUtils exception Skip of string exception Todo of string exception OUnit_failure of string (** See OUnit.mli. *) type node = ListItem of int | Label of string (** See OUnit.mli. *) type path = node list (** See OUnit2.mli. *) type backtrace = string option (* The type of length of a test. *) type test_length = | Immediate (* < 1s *) | Short (* < 1min *) | Long (* < 10min *) | Huge (* < 30min *) | Custom_length of float (** See OUnit.mli. *) type result = | RSuccess | RFailure of string * OUnitLogger.position option * backtrace | RError of string * backtrace | RSkip of string | RTodo of string | RTimeout of test_length (* See OUnit.mli. *) type result_full = (path * result * OUnitLogger.position option) type result_list = result_full list type log_event_t = (path, result) OUnitLogger.log_event_t type logger = (path, result) OUnitLogger.logger type ctxt = (* TODO: hide this to avoid building a context outside. *) { conf: OUnitConf.conf; logger: logger; shared: OUnitShared.shared; path: path; test_logger: result OUnitLogger.Test.t; (* TODO: Still a race condition possible, what if another threads * modify anything during the process (e.g. register tear down). *) mutable tear_down: (ctxt -> unit) list; tear_down_mutex: OUnitShared.Mutex.t; non_fatal: result_full list ref; non_fatal_mutex: OUnitShared.Mutex.t; initial_environment: string array; } type test_fun = ctxt -> unit (* The type of tests. *) type test = | TestCase of test_length * test_fun | TestList of test list | TestLabel of string * test let delay_of_length = function | Immediate -> 20.0 (* 20 seconds *) | Short -> 600.0 (* 10 minutes *) | Long -> 1800.0 (* 30 minutes *) | Huge -> 3600.0 (* 1 hour *) | Custom_length f -> f let get_shard_id test_ctxt = test_ctxt.logger.OUnitLogger.lshard (** Isolate a function inside a context. All the added tear down will run before returning. *) let section_ctxt ctxt f = let old_tear_down = OUnitShared.Mutex.with_lock ctxt.shared ctxt.tear_down_mutex (fun () -> ctxt.tear_down) in let clean_exit () = OUnitShared.Mutex.with_lock ctxt.shared ctxt.tear_down_mutex (fun () -> List.iter (fun tear_down -> tear_down ctxt) ctxt.tear_down; ctxt.tear_down <- old_tear_down) in OUnitShared.Mutex.with_lock ctxt.shared ctxt.tear_down_mutex (fun () -> ctxt.tear_down <- []); try let res = f ctxt in clean_exit (); res with e -> clean_exit (); raise e (** Create a context and run the function. *) let with_ctxt conf logger shared non_fatal test_path f = let ctxt = { conf = conf; logger = logger; path = test_path; shared = shared; test_logger = OUnitLogger.Test.create logger test_path; tear_down = []; tear_down_mutex = OUnitShared.Mutex.create OUnitShared.ScopeProcess; non_fatal = non_fatal; non_fatal_mutex = OUnitShared.Mutex.create OUnitShared.ScopeProcess; initial_environment = Unix.environment (); } in section_ctxt ctxt f let standard_modules = [ "arg.ml"; "arrayLabels.ml"; "array.ml"; "buffer.ml"; "callback.ml"; "camlinternalLazy.ml"; "camlinternalMod.ml"; "camlinternalOO.ml"; "char.ml"; "complex.ml"; "digest.ml"; "filename.ml"; "format.ml"; "gc.ml"; "genlex.ml"; "hashtbl.ml"; "int32.ml"; "int64.ml"; "lazy.ml"; "lexing.ml"; "listLabels.ml"; "list.ml"; "map.ml"; "marshal.ml"; "moreLabels.ml"; "nativeint.ml"; "obj.ml"; "oo.ml"; "parsing.ml"; "pervasives.ml"; "printexc.ml"; "printf.ml"; "queue.ml"; "random.ml"; "scanf.ml"; "set.ml"; "sort.ml"; "stack.ml"; "std_exit.ml"; "stdLabels.ml"; "stream.ml"; "stringLabels.ml"; "string.ml"; "sys.ml"; "weak.ml"; "unix.ml"; ] (** Transform an exception in a result. *) let result_full_of_exception ctxt e = let backtrace () = if Printexc.backtrace_status () then Some (Printexc.get_backtrace ()) else None in let locate_exn () = if Printexc.backtrace_status () then begin let lst = extract_backtrace_position (Printexc.get_backtrace ()) in let pos_opt = try List.find (function | None -> false | Some (fn, _) -> not (starts_with ~prefix:"oUnit" (Filename.basename fn)) && not (List.mem fn standard_modules)) lst with Not_found -> None in match pos_opt with | Some (filename, line) -> Some {OUnitLogger.filename = filename; line = line} | None -> None end else None in let result = match e with | OUnit_failure s -> RFailure (s, locate_exn (), backtrace ()) | Skip s -> RSkip s | Todo s -> RTodo s | s -> RError (Printexc.to_string s, backtrace ()) in let position = match result with | RSuccess | RSkip _ | RTodo _ | RTimeout _ -> None | RFailure _ | RError _ -> OUnitLogger.position ctxt.logger in ctxt.path, result, position let report_result_full ctxt result_full = let test_path, result, _ = result_full in OUnitLogger.report ctxt.logger (OUnitLogger.TestEvent (test_path, OUnitLogger.EResult result)); result_full (** Isolate a function inside a context, just as [!section_ctxt] but don't propagate a failure, register it for later. *) let non_fatal ctxt f = try section_ctxt ctxt f with e -> let result_full = report_result_full ctxt (result_full_of_exception ctxt e) in OUnitShared.Mutex.with_lock ctxt.shared ctxt.non_fatal_mutex (fun () -> ctxt.non_fatal := result_full :: !(ctxt.non_fatal)) (* Some shorthands which allows easy test construction *) let (>:) s t = TestLabel(s, t) (* infix *) let (>::) s f = TestLabel(s, TestCase(Short, f)) (* infix *) let (>:::) s l = TestLabel(s, TestList(l)) (* infix *) (* Utility function to manipulate test *) let rec test_decorate g = function | TestCase(l, f) -> TestCase (l, g f) | TestList tst_lst -> TestList (List.map (test_decorate g) tst_lst) | TestLabel (str, tst) -> TestLabel (str, test_decorate g tst) (* Return the number of available tests *) let rec test_case_count = function | TestCase _ -> 1 | TestLabel (_, t) -> test_case_count t | TestList l -> List.fold_left (fun c t -> c + test_case_count t) 0 l let string_of_node = function | ListItem n -> string_of_int n | Label s -> s module Path = struct type t = path let compare p1 p2 = Stdlib.compare p1 p2 let to_string p = String.concat ":" (List.rev_map string_of_node p) end module MapPath = Map.Make(Path) let string_of_path = Path.to_string (* Returns all possible paths in the test. The order is from test case to root. *) let test_case_paths test = let rec tcps path test = match test with | TestCase _ -> [path] | TestList tests -> List.concat (mapi (fun t i -> tcps ((ListItem i)::path) t) tests) | TestLabel (l, t) -> tcps ((Label l)::path) t in tcps [] test (* Test filtering with their path *) module SetTestPath = Set.Make(String) let test_filter ?(skip=false) only test = let set_test = List.fold_left (fun st str -> SetTestPath.add str st) SetTestPath.empty only in let rec filter_test path tst = if SetTestPath.mem (string_of_path path) set_test then begin Some tst end else begin match tst with | TestCase (l, _) -> begin if skip then Some (TestCase (l, fun _ -> raise (Skip "Test disabled"))) else None end | TestList tst_lst -> begin let ntst_lst = fold_lefti (fun ntst_lst tst i -> let nntst_lst = match filter_test ((ListItem i) :: path) tst with | Some tst -> tst :: ntst_lst | None -> ntst_lst in nntst_lst) [] tst_lst in if not skip && ntst_lst = [] then None else Some (TestList (List.rev ntst_lst)) end | TestLabel (lbl, tst) -> begin let ntst_opt = filter_test ((Label lbl) :: path) tst in match ntst_opt with | Some ntst -> Some (TestLabel (lbl, ntst)) | None -> if skip then Some (TestLabel (lbl, tst)) else None end end in filter_test [] test ounit-2.2.7/src/lib/ounit2/advanced/oUnitTestData.ml000066400000000000000000000061141440660116100222650ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) let make_filename = List.fold_left Filename.concat let testdata_default = let pwd = Sys.getcwd () in let is_dir lst = let dn = make_filename pwd lst in Sys.file_exists dn && Sys.is_directory dn in try let path = List.find is_dir [ ["test"; "data"]; ["tests"; "data"]; ["data"] ] in Some (make_filename pwd path) with Not_found -> None let testdata_dir = OUnitConf.make_string_opt "testdata_dir" testdata_default "Location of the test data directory (absolute path)." let in_testdata_dir conf path = match testdata_dir conf with | Some fn -> make_filename fn path | None -> failwith "Test data dir not defined." ounit-2.2.7/src/lib/ounit2/advanced/oUnitUtils.ml000066400000000000000000000166511440660116100216630ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Utilities for OUnit @author Sylvain Le Gall *) let is_blank = function | ' ' | '\012' | '\n' | '\r' | '\t' -> true | _ -> false let rec trim s = let strlen = String.length s in if strlen = 0 then "" else if is_blank s.[0] then trim (String.sub s 1 (strlen - 1)) else if is_blank s.[strlen - 1] then trim (String.sub s 0 (strlen - 1)) else s let trim_comment s = let buff = Buffer.create (String.length s) in let idx = ref 0 in while !idx < String.length s && s.[!idx] != '#' do Buffer.add_char buff s.[!idx]; incr idx done; Buffer.contents buff let split_lines s = let rev_lst = ref [] in let buff = Buffer.create 13 in let flush () = rev_lst := Buffer.contents buff :: !rev_lst; Buffer.clear buff in if String.length s > 0 then begin String.iter (function | '\n' -> flush () | c -> Buffer.add_char buff c) s; flush (); List.rev !rev_lst end else [] let starts_with ~prefix s = if String.length s >= String.length prefix then String.sub s 0 (String.length prefix) = prefix else false let start_substr ~prefix s = if starts_with ~prefix s then begin let prefix_len = String.length prefix in true, String.sub s prefix_len (String.length s - prefix_len) end else begin false, s end let extract_backtrace_position str = let prefixes = [ "Raised at "; "Re-raised at "; "Raised by primitive operation at "; "Called from "; ] in let rec extract_one_line s prefixes = match prefixes with | [] -> None | prefix :: tl -> let really_starts, eol = start_substr ~prefix s in if really_starts then begin if eol = "unknown location" then None else try Scanf.sscanf eol "%_s@\"%s@\", line %d, characters %d-%d" (fun fn line _ _ -> Some (fn, line)) with Scanf.Scan_failure _ -> None end else begin extract_one_line s tl end in List.map (fun s -> extract_one_line s prefixes) (split_lines str) let cmp_float ?(epsilon = 0.00001) a b = match classify_float a, classify_float b with | FP_infinite, FP_infinite -> a = b | FP_infinite, _ | _, FP_infinite | FP_nan, _ | _, FP_nan -> false | _, _ -> abs_float (a -. b) <= epsilon *. (abs_float a) || abs_float (a -. b) <= epsilon *. (abs_float b) let buff_format_printf f = let buff = Buffer.create 13 in let fmt = Format.formatter_of_buffer buff in f fmt; Format.pp_print_flush fmt (); Buffer.contents buff (* Applies function f in turn to each element in list. Function f takes one element, and integer indicating its location in the list *) let mapi f l = let rec rmapi cnt l = match l with | [] -> [] | h :: t -> (f h cnt) :: (rmapi (cnt + 1) t) in rmapi 0 l let fold_lefti f accu l = let rec rfold_lefti cnt accup l = match l with | [] -> accup | h::t -> rfold_lefti (cnt + 1) (f accup h cnt) t in rfold_lefti 0 accu l let now () = Unix.gettimeofday () (* Function which runs the given function and returns the running time of the function, and the original result in a tuple *) let time_fun f x = let begin_time = now () in let res = f x in (now () -. begin_time, res) let date_iso8601 ?(tz=true) timestamp = let tm = Unix.gmtime timestamp in let res = Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02d" (1900 + tm.Unix.tm_year) (1 + tm.Unix.tm_mon) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in if tz then res ^ "+00:00" else res let buildir = (* Detect a location where we can store semi-temporary data: - it must survive a compilation - it must be removed with 'make clean' *) let pwd = Sys.getcwd () in let dir_exists fn = Sys.file_exists fn && Sys.is_directory fn in let concat, dirname = Filename.concat, Filename.dirname in List.find dir_exists [ concat pwd "_build"; concat (dirname pwd) "_build"; concat (dirname (dirname pwd)) "_build"; pwd ] let failwithf fmt = Printf.ksprintf failwith fmt let opt f = function Some v -> f v | None -> () let fqdn () = try (Unix.gethostbyname (Unix.gethostname ())).Unix.h_name with Not_found -> "localhost" let shardf = Printf.sprintf "%s#%02d" (Unix.gethostname ()) let string_of_process_status = function | Unix.WEXITED n -> Printf.sprintf "Exited with code %d" n | Unix.WSIGNALED n -> Printf.sprintf "Killed by signal %d" n | Unix.WSTOPPED n -> Printf.sprintf "Stopped by signal %d" n let make_counter () = let data = Hashtbl.create 13 in let all () = Hashtbl.fold (fun k v lst -> (k, v) :: lst) data [] in let incr k = let v = try Hashtbl.find data k with Not_found -> 0 in Hashtbl.replace data k (v + 1) in all, incr ounit-2.2.7/src/lib/ounit2/dune000066400000000000000000000002331440660116100163100ustar00rootroot00000000000000(library (name oUnit) (public_name ounit2) (wrapped false) (libraries unix seq ounit2.advanced)) (documentation (package ounit2) (mld_files index)) ounit-2.2.7/src/lib/ounit2/index.mld000066400000000000000000000235161440660116100172500ustar00rootroot00000000000000{1 OUnit: xUnit testing framework for OCaml} {2 What is unit Testing?} A test-oriented methodology for software development is most effective when tests are easy to create, change, and execute. The JUnit tool pioneered test-first development in Java. OUnit is an adaptation of JUnit to OCaml. With OUnit, as with JUnit, you can easily create tests, name them, group them into suites, and execute them, with the framework checking the results automatically. {!modules: OUnit2 OUnit} {2 Getting Started} The basic principle of a OUnit test suite is to have a {i test.ml} file which will contain the tests, and an OCaml module under test, here named {i foo.ml}. File {i foo.ml}: {[ (* The functions we wish to test *) let unity x = x;; let funix ()= 0;; let fgeneric () = failwith "Not implemented";; ]} The main point of a test is to check that the function under test has the expected behavior. You check the behavior using assert functions. The simplest one is {!OUnit2.assert_equal}. This function compares the result of the function under test with an expected result. Some useful functions include: - {!OUnit2.assert_equal} the basic assert function - {!OUnit2.(>:::)} to define a list of tests - {!OUnit2.(>::)} to name a test - {!OUnit2.run_test_tt_main} to run the test suite you define - {!OUnit2.bracket_tmpfile} that create a temporary filename. - {!OUnit2.bracket_tmpdir} that create a temporary directory. File {i test.ml}: {[ open OUnit2;; let test1 test_ctxt = assert_equal "x" (Foo.unity "x");; let test2 test_ctxt = assert_equal 100 (Foo.unity 100);; (* Name the test cases and group them together *) let suite = "suite">::: ["test1">:: test1; "test2">:: test2] ;; let () = run_test_tt_main suite ;; ]} And compile the module {[ $ ocamlfind ocamlc -o test -package oUnit -linkpkg -g foo.ml test.ml ]} A executable named "test" will be created. When run it produces the following output. {[ $ ./test .. Ran: 2 tests in: 0.00 Seconds OK ]} When using {!OUnit2.run_test_tt_main}, a non-zero exit code signals that the test suite failed. {2 Extra features} OUnit supports colored output and JUnit/HTML generation. They are command line flags or environment variables that you can set before running OUnit test suites. {ul {- Colored output: {ul {- Set the environment variable [OUNIT_CI=true]} {- Use the command line flag [-ci true]} }} {- JUnit generation: {ul {- Set the environment variable [OUNIT_OUTPUT_JUNIT_FILE=fn]} {- Use the command line flag [-output-junit-file fn]} }} {- HTML report {ul {- Set the environment variable [OUNIT_OUTPUT_HTML_DIR=fn]} {- Use the command line flag [-output-html-dir fn]} }}} {2 Advanced usage} This section is only for advanced users who wish to uncover the power of OUnit. {!modules: OUnit2} {3 Error reporting} The error reporting part of OUnit is quite important. If you want to identify the failure, you should tune the display of the value and the test. Here is a list of things you can display: - name of the test: OUnit uses numbers to define path's test. But an error reporting about a failed test "0:1:2" is less explicit than "OUnit:0:comparator:1:float_comparator:2" - [~msg] parameter: it allows you to define, say, which assert has failed in your test. When you have more than one assert in a test, you should provide a [~msg] to differentiate them - [~printer] parameter: {!OUnit2.assert_equal} allows you to define a printer for compared values. A message ["abcd" is not equal to "defg"] is better than [not equal] {[ open OUnit2;; let _ = "mytest">:: (fun test_ctxt -> assert_equal ~msg:"int value" ~printer:string_of_int 1 (Foo.unity 1)) ;; ]} {3 Command-line arguments} {!OUnit2.run_test_tt_main} already provides a set of command-line arguments to help users run only the tests they want: - [-only-test]: skip all the tests except this one, you can use this flag several time to select more than one test to run - [-list-test]: list all the available tests and exit - [-help]: display help message and exit It is also possible to add your own command-line arguments, environment variables and config file variables. You should do it if you want to define some extra arguments. For example: {[ open OUnit2;; let my_program = Conf.make_exec "my_program" ;; let test1 test_ctxt = assert_command (my_program test_ctxt) [] ;; let () = run_test_tt_main ("test1" >:: test1) ;; ]} The [Conf.make_*] creates a command-line argument, an environment variable and a config file variable. {3 Skip and todo tests} Tests are not always meaningful and can even fail because something is missing in the environment. In order to handle this, you can define a skip condition that will skip the test. If you start by defining your tests rather than implementing the functions under test, you know that some tests will just fail. You can mark these tests as pending todo tests. This way they will be reported differently in your test suite. {[ open OUnit2;; let _ = "allfuns" >::: [ "funix">:: (fun test_ctxt -> skip_if (Sys.os_type = "Win32") "Don't work on Windows"; assert_equal 0 (Foo.funix ())); "fgeneric">:: (fun test_ctxt -> todo "fgeneric not implemented"; assert_equal 0 (Foo.fgeneric ())); ] ;; ]} {3 OUnit2.Threads} This module provide thread related utilities. In particular, it provides a "thread" runner, that allows to run concurrently tests using OCaml threads. This should provide a good level of parallelism on Windows, for UNIX systems it is recommended to use the standard "process" runner. To install the extra thread runner: {[ let () = OUnitThreads.init () ]} {!modules: OUnitThreads} {3 Effective OUnit} This section has general tips about unit testing and OUnit. It is the result of some years using OUnit in real-world applications. - test everything: the more you create tests, the better chance you have to catch errors in your program early. Every submitted bug to your application should have a matching test. This is a good practice, but it is not always easy to implement. - test only what is really exported: on the long term, you have to maintain your test suite. If you test low-level functions, you'll have a lot of tests to rewrite. You should focus on creating tests for functions for which the behavior shouldn't change. - test fast: the best test suite is the one that runs after every single build. You should set your default Makefile target to run the test suite. It means that your test suite should be fast to run, typically, a 10s test suite is fine. - test long: contrary to the former tip, you should also have a complete test suite which can be very long to run. The best way to achieve both tips, is to define a command-line argument [-long] and skip the tests that are too long in your test suite according to it. When you do a release, you should run your long test suite. - family tests: when testing behavior, most of the time you call exactly the same code with different arguments. In this case [List.map] and {!OUnit2.(>:::)} are your friends. For example: {[ open OUnit2;; let _ = "Family">::: (List.map (fun (arg,res) -> let title = Printf.sprintf "%s->%s" arg res in title >:: (fun test_ctxt -> assert_equal res (Foo.unity arg))) ["abcd", "abcd"; "defg", "defg"; "wxyz", "wxyz"]) ;; ]} - test failures and successes: the most obvious thing you want to test are successes, i.e. that you get the expected behavior in the normal case. But most of the errors arise in corner cases and in the code of the test itself. For example, you can have a partial application of your {!OUnit2.assert_equal} and never encounter any errors, just because the [assert_equal] is not called. In this case, if you test errors as well as the "happy path", you will have a notice the missing errors as well. - set up and clean your environment in the test: you should not set up and clean your test environment outside the test. Ideally, if you run no tests, the program should do nothing. This also ensures that you are always testing in a clean environment, not polluted by the result of failed tests of an earlier test run. This includes the process environment, like current working directory. {[ open OUnit2;; let _ = (* We need to call a function in a particular directory *) "change-dir-and-run">:: (fun test_ctxt -> assert_command ~chdir:"/foo/test" "ls" []) ;; ]} - separate your tests: OUnit test code should live outside the code under a directory called {i test}. This allow to drop the dependency on OUnit when distributing your library/application. This also enables people to easily make a difference from what really matters (the main code) and what are only tests. It is also possible to have the tests directly in the code, like in Quickcheck-style tests. The unit testing scope is always hard to define. Unit testing should be about testing a single feature. But OUnit can also help you to test higher-level behavior, by running a full program for example. While it isn't real unit testing, you can use OUnit to do it and should not hesitate to do it. In terms of lines of codes, a test suite can represent from 10% to 150% of the code under test. With time, your test suite will grow faster than your program/library. A good ratio is 33%. {3 OUnit2.Advanced} These modules should only be used when building low-level OUnit features. They allow to create your own process runner or logger. Modules available in [ounit2.advanced]: {!modules: OUnitAssert OUnitBracket OUnitCache OUnitCheckEnv OUnitChooser OUnitConf OUnitCore OUnitDiff OUnitLogger OUnitLoggerCI OUnitLoggerHTML OUnitLoggerJUnit OUnitLoggerStd OUnitPlugin OUnitPropList OUnitResultSummary OUnitRunner OUnitRunnerProcesses OUnitShared OUnitState OUnitTest OUnitTestData OUnitUtils} @author Maas-Maarten Zeeman @author Sylvain Le Gall ounit-2.2.7/src/lib/ounit2/oUnit.ml000066400000000000000000000264561440660116100171010ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitUtils let get_test_context, set_test_context, reset_test_context = let context_opt = ref None in (* get *) (fun () -> match !context_opt with | Some ctxt -> ctxt | None -> failwith "Function need to be called from inside a test."), (fun ctxt -> context_opt := Some ctxt), (fun _ -> context_opt := None) type node = ListItem of int | Label of string let node1_of_node = function | OUnitTest.ListItem i -> ListItem i | OUnitTest.Label s -> Label s let node_of_node1 = function | ListItem i -> OUnitTest.ListItem i | Label s -> OUnitTest.Label s type path = node list let path1_of_path pth = List.map node1_of_node pth type test_fun = unit -> unit type test = TestCase of test_fun | TestList of test list | TestLabel of string * test let rec test1_of_test = function | OUnitTest.TestCase (_, f) -> TestCase (fun () -> f (get_test_context ())) | OUnitTest.TestList lst -> TestList (List.map test1_of_test lst) | OUnitTest.TestLabel (str, tst) -> TestLabel (str, test1_of_test tst) let rec test_of_test1 = function | TestCase f -> OUnitTest.TestCase (OUnitTest.Short, fun ctxt -> set_test_context ctxt; f (); reset_test_context ()) | TestList lst -> OUnitTest.TestList (List.map test_of_test1 lst) | TestLabel (str, tst) -> OUnitTest.TestLabel (str, test_of_test1 tst) let rec ounit2_of_ounit1 = function | TestCase f -> OUnit2.test_case (fun ctxt -> set_test_context ctxt; f (); reset_test_context ()) | TestList lst -> OUnit2.test_list (List.map ounit2_of_ounit1 lst) | TestLabel (lbl, test) -> OUnit2.( >: ) lbl (ounit2_of_ounit1 test) type test_result = RSuccess of path | RFailure of path * string | RError of path * string | RSkip of path * string | RTodo of path * string let test_result1_of_test_result path rslt = let path1 = path1_of_path path in let rslt1 = match rslt with | OUnitTest.RSuccess -> RSuccess path1 | OUnitTest.RFailure (str, _, _) -> RFailure (path1, str) | OUnitTest.RError (str, _) -> RError (path1, str) | OUnitTest.RSkip str -> RSkip (path1, str) | OUnitTest.RTodo str -> RTodo (path1, str) | OUnitTest.RTimeout test_length -> RError (path1, (Printf.sprintf "timeout after %.1fs." (OUnitTest.delay_of_length test_length))) in rslt1 type test_event = EStart of path | EEnd of path | EResult of test_result type test_results = test_result list let list_result1_of_list_result = List.map (fun (pth, rslt, _) -> test_result1_of_test_result pth rslt) let assert_failure = OUnitAssert.assert_failure let assert_bool = OUnitAssert.assert_bool let ( @? ) = OUnitAssert.assert_bool let assert_string = OUnitAssert.assert_string let assert_command ?exit_code ?sinput ?foutput ?use_stderr ?env ?(verbose=false) prg args = let ctxt = let ctxt = get_test_context () in let conf' = Hashtbl.copy ctxt.OUnitTest.conf in OUnitConf.set ~origin:"OUnit.assert_command" conf' "verbose" (string_of_bool verbose); { ctxt with OUnitTest.test_logger = OUnitLogger.Test.create (OUnitLoggerStd.std_logger conf' OUnitLogger.shard_default) ctxt.OUnitTest.path; } in OUnitAssert.assert_command ?exit_code ?sinput ?foutput ?use_stderr ?env ~ctxt prg args let assert_equal ?cmp ?printer ?pp_diff ?msg a b = OUnitAssert.assert_equal ?cmp ?printer ?pp_diff ?msg a b let assert_raises ?msg exc f = OUnitAssert.assert_raises ?msg exc f let skip_if = OUnitAssert.skip_if let todo = OUnitAssert.todo let cmp_float ?epsilon f1 f2 = OUnitUtils.cmp_float ?epsilon f1 f2 let bracket pre f post () = OUnitTest.section_ctxt (get_test_context ()) (fun ctxt -> let fixture = OUnitBracket.create (fun _ -> pre ()) (fun fixture _ -> post fixture) ctxt in let () = f fixture in ()) let bracket_tmpfile ?prefix ?suffix ?mode gen () = OUnitTest.section_ctxt (get_test_context ()) (fun ctxt -> let fixture = OUnitBracket.bracket_tmpfile ?prefix ?suffix ?mode ctxt in gen fixture) let (>:) a b = test1_of_test (OUnitTest.(>:) a (test_of_test1 b)) let (>::) a b = test1_of_test (OUnitTest.(>::) a (fun _ -> b ())) let (>:::) a b = test1_of_test (OUnitTest.(>:::) a (List.map test_of_test1 b)) let test_decorate g tst = test1_of_test (OUnitTest.test_decorate (fun f -> let f1 = (fun () -> f (get_test_context ())) in let f1' = g f1 in (fun ctxt -> set_test_context ctxt; f1' (); reset_test_context ())) (test_of_test1 tst)) let test_filter ?skip lst test = let res = OUnitTest.test_filter ?skip lst (test_of_test1 test) in match res with | Some tst -> Some (test1_of_test tst) | None -> None let test_case_count tst = OUnitTest.test_case_count (test_of_test1 tst) let string_of_node nd = OUnitTest.string_of_node (node_of_node1 nd) let string_of_path pth = OUnitTest.string_of_path (List.map node_of_node1 pth) let test_case_paths tst = let lst = OUnitTest.test_case_paths (test_of_test1 tst) in List.map (List.map node1_of_node) lst let default_v1_conf ?(verbose=false) () = OUnitConf.default ~preset: [ "chooser", "simple"; "runner", "sequential"; "results_style_1_X", "true"; "verbose", (string_of_bool verbose); "output_file", "none"; ] () let perform_test logger1 tst = let logger = OUnitLogger.fun_logger (function | {OUnitLogger.event = OUnitLogger.GlobalEvent _; _} -> () | {OUnitLogger.event = OUnitLogger.TestEvent (path, test_event); _} -> begin let path1 = path1_of_path path in match test_event with | OUnitLogger.EStart -> logger1 (EStart path1) | OUnitLogger.EEnd -> logger1 (EEnd path1) | OUnitLogger.EResult rslt -> logger1 (EResult (test_result1_of_test_result path rslt)) | OUnitLogger.ELog _ | OUnitLogger.ELogRaw _ -> () end) ignore in let conf = default_v1_conf () in list_result1_of_list_result (OUnitCore.perform_test conf logger (snd (OUnitRunner.choice conf)) (snd (OUnitChooser.choice conf)) (test_of_test1 tst)) let run_test_tt ?verbose test = let conf = default_v1_conf ?verbose () in list_result1_of_list_result (OUnitCore.run_test_tt conf (OUnitLoggerStd.create conf OUnitLogger.shard_default) (snd (OUnitRunner.choice conf)) (snd (OUnitChooser.choice conf)) (test_of_test1 test)) let run_test_tt_main ?(arg_specs=[]) ?(set_verbose=ignore) suite = let suite = test_of_test1 suite in let only_test = ref [] in let list_test = ref false in let verbose = ref false in let specs = [ "-verbose", Arg.Set verbose, " Rather than displaying dots while running the test, be more verbose."; "-only-test", Arg.String (fun str -> only_test := str :: !only_test), "path Run only the selected tests."; "-list-test", Arg.Set list_test, " List tests"; ] @ arg_specs in let () = Arg.parse (Arg.align specs) (fun x -> raise (Arg.Bad ("Bad argument : " ^ x))) ("usage: " ^ Sys.argv.(0) ^ " [options] [-only-test path]*") in let conf = default_v1_conf ~verbose:!verbose () in set_verbose (OUnitLoggerStd.verbose conf); if !list_test then begin List.iter (fun pth -> print_endline (OUnitTest.string_of_path pth)) (OUnitTest.test_case_paths suite); [] end else begin let nsuite = if !only_test = [] then suite else begin match OUnitTest.test_filter ~skip:true !only_test suite with | Some test -> test | None -> failwithf "Filtering test %s lead to no tests." (String.concat ", " !only_test) end in let test_results = OUnitCore.run_test_tt conf (OUnitLoggerStd.std_logger conf OUnitLogger.shard_default) (snd (OUnitRunner.choice conf)) (snd (OUnitChooser.choice conf)) nsuite in if not (OUnitResultSummary.was_successful test_results) then exit 1 else list_result1_of_list_result test_results; end ounit-2.2.7/src/lib/ounit2/oUnit.mli000066400000000000000000000233461440660116100172450ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Unit test building blocks @author Maas-Maarten Zeeman @author Sylvain Le Gall *) (** {2 Assertions} Assertions are the basic building blocks of unittests. *) (** Signals a failure. This will raise an exception with the specified string. @raise Failure signal a failure *) val assert_failure : string -> 'a (** Signals a failure when bool is false. The string identifies the failure. @raise Failure signal a failure *) val assert_bool : string -> bool -> unit (** Shorthand for assert_bool @raise Failure to signal a failure *) val ( @? ) : string -> bool -> unit (** Signals a failure when the string is non-empty. The string identifies the failure. @raise Failure signal a failure *) val assert_string : string -> unit (** [assert_command prg args] Run the command provided. @param exit_code expected exit code @param sinput provide this [char Seq.t] as input of the process @param foutput run this function on output, it can contains an [assert_equal] to check it @param use_stderr redirect [stderr] to [stdout] @param env Unix environment @param verbose if failed, dump stdout/stderr of the process to stderr @since 1.1.0 *) val assert_command : ?exit_code:Unix.process_status -> ?sinput:char Seq.t -> ?foutput:(char Seq.t -> unit) -> ?use_stderr:bool -> ?env:string array -> ?verbose:bool -> string -> string list -> unit (** [assert_equal expected real] Compares two values, when they are not equal a failure is signaled. @param cmp customize function to compare, default is [=] @param printer value printer, don't print value otherwise @param pp_diff if not equal, ask a custom display of the difference using [diff fmt exp real] where [fmt] is the formatter to use @param msg custom message to identify the failure @raise Failure signal a failure @version 1.1.0 *) val assert_equal : ?cmp:('a -> 'a -> bool) -> ?printer:('a -> string) -> ?pp_diff:(Format.formatter -> ('a * 'a) -> unit) -> ?msg:string -> 'a -> 'a -> unit (** Asserts if the expected exception was raised. @param msg identify the failure @raise Failure description *) val assert_raises : ?msg:string -> exn -> (unit -> 'a) -> unit (** {2 Skipping tests } In certain condition test can be written but there is no point running it, because they are not significant (missing OS features for example). In this case this is not a failure nor a success. Following functions allow you to escape test, just as assertion but without the same error status. A test skipped is counted as success. A test todo is counted as failure. *) (** [skip cond msg] If [cond] is true, skip the test for the reason explain in [msg]. For example [skip_if (Sys.os_type = "Win32") "Test a doesn't run on windows"]. @since 1.0.3 *) val skip_if : bool -> string -> unit (** The associated test is still to be done, for the reason given. @since 1.0.3 *) val todo : string -> unit (** {2 Compare Functions} *) (** Compare floats up to a given relative error. @param epsilon if the difference is smaller [epsilon] values are equal *) val cmp_float : ?epsilon:float -> float -> float -> bool (** {2 Bracket} A bracket is a functional implementation of the commonly used setUp and tearDown feature in unittests. It can be used like this: ["MyTestCase" >:: (bracket test_set_up test_fun test_tear_down)] *) (** [bracket set_up test tear_down] The [set_up] function runs first, then the [test] function runs and at the end [tear_down] runs. The [tear_down] function runs even if the [test] failed and help to clean the environment. *) val bracket: (unit -> 'a) -> ('a -> unit) -> ('a -> unit) -> unit -> unit (** [bracket_tmpfile test] The [test] function takes a temporary filename and matching output channel as arguments. The temporary file is created before the test and removed after the test. @param prefix see [Filename.open_temp_file] @param suffix see [Filename.open_temp_file] @param mode see [Filename.open_temp_file] @since 1.1.0 *) val bracket_tmpfile: ?prefix:string -> ?suffix:string -> ?mode:open_flag list -> ((string * out_channel) -> unit) -> unit -> unit (** {2 Constructing Tests} *) (** The type of test function *) type test_fun = unit -> unit (** The type of tests *) type test = TestCase of test_fun | TestList of test list | TestLabel of string * test (** Create a TestLabel for a test *) val (>:) : string -> test -> test (** Create a TestLabel for a TestCase *) val (>::) : string -> test_fun -> test (** Create a TestLabel for a TestList *) val (>:::) : string -> test list -> test (** Some shorthands which allows easy test construction. Examples: - ["test1" >: TestCase((fun _ -> ()))] => [TestLabel("test2", TestCase((fun _ -> ())))] - ["test2" >:: (fun _ -> ())] => [TestLabel("test2", TestCase((fun _ -> ())))] - ["test-suite" >::: ["test2" >:: (fun _ -> ());]] => [TestLabel("test-suite", TestSuite([TestLabel("test2", TestCase((fun _ -> ())))]))] *) (** [test_decorate g tst] Apply [g] to test function contains in [tst] tree. @since 1.0.3 *) val test_decorate : (test_fun -> test_fun) -> test -> test (** [test_filter paths tst] Filter test based on their path string representation. @param skip if set, just use [skip_if] for the matching tests. @since 1.0.3 *) val test_filter : ?skip:bool -> string list -> test -> test option (** {2 Retrieve Information from Tests} *) (** Returns the number of available test cases *) val test_case_count : test -> int (** Types which represent the path of a test *) type node = ListItem of int | Label of string type path = node list (** The path to the test (in reverse order). *) (** Make a string from a node *) val string_of_node : node -> string (** Make a string from a path. The path will be reversed before it is translated into a string *) val string_of_path : path -> string (** Returns a list with paths of the test *) val test_case_paths : test -> path list (** {2 Performing Tests} *) (** The possible results of a test *) type test_result = RSuccess of path | RFailure of path * string | RError of path * string | RSkip of path * string | RTodo of path * string (** Events which occur during a test run. *) type test_event = EStart of path (** A test start. *) | EEnd of path (** A test end. *) | EResult of test_result (** Result of a test. *) (** Results of a test run. *) type test_results = test_result list (** Perform the test, allows you to build your own test runner *) val perform_test : (test_event -> unit) -> test -> test_results (** A simple text based test runner. @param verbose print verbose message *) val run_test_tt : ?verbose:bool -> test -> test_results (** Main version of the text based test runner. It reads the supplied command line arguments to set the verbose level and limit the number of test to run. @param arg_specs add extra command line arguments @param set_verbose call a function to set verbosity @param fexit call a final function after test, by default exit 1. @version 1.1.0 *) val run_test_tt_main : ?arg_specs:(Arg.key * Arg.spec * Arg.doc) list -> ?set_verbose:(bool -> unit) -> test -> test_results val ounit2_of_ounit1 : test -> OUnit2.test ounit-2.2.7/src/lib/ounit2/oUnit2.ml000066400000000000000000000105751440660116100171560ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest let (>:) = OUnitTest.(>:) let (>::) = OUnitTest.(>::) let (>:::) = OUnitTest.(>:::) type test_ctxt = OUnitTest.ctxt type test_fun = OUnitTest.test_fun type test_length = OUnitTest.test_length type test = OUnitTest.test let test_case ?(length=Short) f = TestCase(length, f) let test_list lst = TestList lst type log_severity = OUnitLogger.log_severity let assert_failure = OUnitAssert.assert_failure let assert_bool = OUnitAssert.assert_bool let assert_string = OUnitAssert.assert_string (* Upgrade to OUnit v2, using logger. *) (* let assert_command = OUnitAssert.assert_command *) let assert_command ?exit_code ?sinput ?foutput ?use_stderr ?backtrace ?chdir ?env ~ctxt prg args = OUnitAssert.assert_command ?exit_code ?sinput ?foutput ?use_stderr ?backtrace ?chdir ?env ~ctxt prg args let assert_equal = OUnitAssert.assert_equal let assert_raises = OUnitAssert.assert_raises let skip_if = OUnitAssert.skip_if let todo = OUnitAssert.todo let cmp_float = OUnitUtils.cmp_float let bracket = OUnitBracket.create let bracket_tmpfile = OUnitBracket.bracket_tmpfile let bracket_tmpdir = OUnitBracket.bracket_tmpdir let with_bracket_chdir test_ctxt dn f = OUnitBracket.with_bracket test_ctxt (OUnitBracket.bracket_chdir dn) (fun _ -> f) let non_fatal = OUnitTest.non_fatal let run_test_tt_main = OUnitCore.run_test_tt_main let logf ctxt log_severity fmt = OUnitLogger.Test.logf ctxt.test_logger log_severity fmt let in_testdata_dir ctxt path = OUnitTestData.in_testdata_dir ctxt.conf path let conf_wrap f name default help = let get = f name default help in fun ctxt -> get ctxt.conf module Conf = struct type 'a conf_t = string -> 'a -> Arg.doc -> test_ctxt -> 'a let make_string = conf_wrap OUnitConf.make_string let make_string_opt = conf_wrap OUnitConf.make_string_opt let make_int = conf_wrap OUnitConf.make_int let make_float = conf_wrap OUnitConf.make_float let make_bool = conf_wrap OUnitConf.make_bool let make_exec name = let get = OUnitConf.make_exec name in fun ctxt -> get ctxt.conf end ounit-2.2.7/src/lib/ounit2/oUnit2.mli000066400000000000000000000260421440660116100173230ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Unit test building blocks (v2). @author Sylvain Le Gall *) (** {2 Types} *) (** Context of a test. *) type test_ctxt = OUnitTest.ctxt (** The type of test function. *) type test_fun = test_ctxt -> unit (** The type of test. *) type test = OUnitTest.test (** The expected length of the test. *) type test_length = OUnitTest.test_length (** {2 Assertions} Assertions are the basic building blocks of unittests. *) (** Signals a failure. This will raise an exception with the specified string. @raise Failure signal a failure *) val assert_failure : string -> 'a (** Signals a failure when bool is false. The string identifies the failure. @raise Failure signal a failure *) val assert_bool : string -> bool -> unit (** Signals a failure when the string is non-empty. The string identifies the failure. @raise Failure signal a failure *) val assert_string : string -> unit (** [assert_command prg args] Run the command provided. @param exit_code expected exit code @param sinput provide this [char Seq.t] as input of the process @param foutput run this function on output, it can contains an [assert_equal] to check it @param use_stderr redirect [stderr] to [stdout] @param backtrace Set OCAMLRUNPARAM=b @param chdir Chdir into a directory before running the command. @param env Unix environment @param verbose if a failed, dump stdout/stderr of the process to stderr *) val assert_command : ?exit_code:Unix.process_status -> ?sinput:char Seq.t -> ?foutput:(char Seq.t -> unit) -> ?use_stderr:bool -> ?backtrace:bool -> ?chdir:string -> ?env:string array -> ctxt:test_ctxt -> string -> string list -> unit (** [assert_equal expected real] Compares two values, when they are not equal a failure is signaled. @param cmp customize function to compare, default is [=] @param printer value printer, don't print value otherwise @param pp_diff if not equal, ask a custom display of the difference using [diff fmt exp real] where [fmt] is the formatter to use @param msg custom message to identify the failure @param ctxt if provided, always print expected and real value @raise Failure signal a failure *) val assert_equal : ?ctxt:test_ctxt -> ?cmp:('a -> 'a -> bool) -> ?printer:('a -> string) -> ?pp_diff:(Format.formatter -> ('a * 'a) -> unit) -> ?msg:string -> 'a -> 'a -> unit (** Asserts if the expected exception was raised. @param msg identify the failure @raise Failure description *) val assert_raises : ?msg:string -> exn -> (unit -> 'a) -> unit (** {2 Skipping tests } In certain condition test can be written but there is no point running it, because they are not significant (missing OS features for example). In this case this is not a failure nor a success. Following functions allow you to escape test, just as assertion but without the same error status. A test skipped is counted as success. A test todo is counted as failure. *) (** [skip cond msg] If [cond] is true, skip the test for the reason explain in [msg]. For example [skip_if (Sys.os_type = "Win32") "Test a doesn't run on windows"]. *) val skip_if : bool -> string -> unit (** The associated test is still to be done, for the reason given. *) val todo : string -> unit (** {2 Compare Functions} *) (** Compare floats up to a given relative error. In keeping with standard floating point semantics, NaN is not equal to anything: [cmp_float nan nan = false]. @param epsilon if the difference is smaller [epsilon] values are equal *) val cmp_float : ?epsilon:float -> float -> float -> bool (** {2 Bracket} A bracket is a registered object with setUp and tearDown in unit tests. Data generated during the setUp will be automatically tearDown when the test ends. *) (** [bracket set_up tear_down test_ctxt] set up an object and register it to be tore down in [test_ctxt]. *) val bracket : (test_ctxt -> 'a) -> ('a -> test_ctxt -> unit) -> test_ctxt -> 'a (** [bracket_tmpfile test_ctxt] Create a temporary filename and matching output channel. The temporary file is removed after the test. @param prefix see [Filename.open_temp_file] @param suffix see [Filename.open_temp_file] @param mode see [Filename.open_temp_file] *) val bracket_tmpfile: ?prefix:string -> ?suffix:string -> ?mode:open_flag list -> test_ctxt -> (string * out_channel) (** [bracket_tmpdir test_ctxt] Create a temporary dirname. The temporary directory is removed after the test. @param prefix see [Filename.open_temp_file] @param suffix see [Filename.open_temp_file] *) val bracket_tmpdir: ?prefix:string -> ?suffix:string -> test_ctxt -> string (** [with_bracket_chdir test_ctxt dn f] change directory to [dn] during execution of function [f]. In order to [Sys.chdir], we need to take a lock to avoid other tests trying to do change the current directory at the same time. So this bracket is not directly accessible in order to use it only on shorter piece of code. *) val with_bracket_chdir: test_ctxt -> string -> (test_ctxt -> 'a) -> 'a (** {2 Constructing Tests} *) (** Create a TestLabel for a test *) val (>:) : string -> test -> test (** Create a TestLabel for a TestCase *) val (>::) : string -> test_fun -> test (** Create a TestLabel for a TestList *) val (>:::) : string -> test list -> test (** Generic function to create a test case. *) val test_case : ?length:test_length -> test_fun -> test (** Generic function to create a test list. *) val test_list : test list -> test (** Some shorthands which allows easy test construction. Examples: - ["test1" >: TestCase((fun _ -> ()))] => [TestLabel("test2", TestCase((fun _ -> ())))] - ["test2" >:: (fun _ -> ())] => [TestLabel("test2", TestCase((fun _ -> ())))] - ["test-suite" >::: ["test2" >:: (fun _ -> ());]] => [TestLabel("test-suite", TestSuite([TestLabel("test2", TestCase((fun _ -> ())))]))] *) (** {2 Performing Tests} *) (** Severity level for log. *) type log_severity = [ `Error | `Warning | `Info ] (** Log into OUnit logging system. *) val logf: test_ctxt -> log_severity -> ('a, unit, string, unit) format4 -> 'a (** Build a filename for a file that should be located in the test data dir. The test data dir, can be defined on the command line (preferably absolute) The default option is to locate it in topsrcdir/test/data. *) val in_testdata_dir: test_ctxt -> string list -> string (** [non_fatal ctxt f] Run [f] but if an exception is raised or an assert fails, don't stop, just register the result. The global test running result will mix in the non fatal result to determine the success or failure of the test. *) val non_fatal: test_ctxt -> (test_ctxt -> unit) -> unit (** Define command line options, environment variables and file configuration. This module helps to define configuration options that are translated to command line options et al. The name defined for the variable is: - should be a valid OCaml identifier - kept as is for use in configuration file. (foo_bar = "") - '_' are replaced by '-' and a leading '-' is added for command line (-foo "") - capitalized and prefixed by OUNIT_ for environment (OUNIT_FOO_BAR="") *) module Conf: sig (** The default type of function that create a configuration option of type 'a. *) type 'a conf_t = string -> 'a -> Arg.doc -> test_ctxt -> 'a (** [make_string name default help] Create a string configuration option with default value [default] and a short help string. The result of the partial application of the function can be used inside tests to be evaluated to a value. {[ let my_option = Conf.make_string "my_option" "the default" "A default option." let tests = "ATest" >:: (fun test_ctxt -> let option_value = my_option test_ctxt in ()) ]} *) val make_string: string conf_t (** Create a [string option] configuration option. See [!make_string]. *) val make_string_opt: (string option) conf_t (** Create an [int] configuration option. See [!make_string]. *) val make_int: int conf_t (** Create a [float] configuration option. See [!make_string]. *) val make_float: float conf_t (** Create a [bool] configuration option. See [!make_string]. *) val make_bool: bool conf_t (** [make_exec execname] Create a option to define an executable. *) val make_exec: string -> test_ctxt -> string end (** Main version of the text based test runner. It reads the supplied command line arguments to set the verbose level and limit the number of test to run. @param test the test suite to run. *) val run_test_tt_main : ?exit:(int -> unit) -> test -> unit ounit-2.2.7/src/lib/ounit2/threads/000077500000000000000000000000001440660116100170665ustar00rootroot00000000000000ounit-2.2.7/src/lib/ounit2/threads/dune000066400000000000000000000001771440660116100177510ustar00rootroot00000000000000(library (name oUnitThreads) (public_name ounit2.threads) (private_modules oUnitRunnerThreads) (libraries threads ounit2)) ounit-2.2.7/src/lib/ounit2/threads/oUnitRunnerThreads.ml000066400000000000000000000170251440660116100232300ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (** Use threads to run several tests concurrently. * * Run threads that handle running tests. It works the same way * as processes. Due to the non-parallel threads behavior in OCaml, you cannot * truly use the power of parallelism with threads, except when you have a lot * of disk and process operation. *) open OUnitRunner.GenericWorker let make_channel shard_id sync_send_data (string_of_read_message: 'read -> string) (string_of_written_message: 'written -> string) (chan_read: 'read Event.channel) (chan_write: 'written Event.channel) = let chan_sync_send_data = Event.new_channel () in let send_data msg = if sync_send_data then Event.sync (Event.send chan_sync_send_data shard_id); Event.sync (Event.send chan_write msg) in let receive_data _ = Event.sync (Event.receive chan_read) in chan_sync_send_data, wrap_channel shard_id string_of_read_message string_of_written_message { send_data = send_data; receive_data = receive_data; close = ignore; } let create_worker ~shard_id ~master_id ~worker_log_file conf map_test_cases = (* Threads will get message from master by there. *) let master_to_worker = Event.new_channel () in (* Threads will send message to master by there. *) let worker_to_master = Event.new_channel () in (* Signal end of the worker. *) let worker_finished = ref false in let worker_finished_mutex = Mutex.create () in let worker_finished_cond = Condition.create () in let select_fd, channel_worker = make_channel shard_id true string_of_message_to_worker string_of_message_from_worker master_to_worker worker_to_master in let thread_main_worker () = let at_end () = channel_worker.close (); Mutex.lock worker_finished_mutex; worker_finished := true; Condition.broadcast worker_finished_cond; Mutex.unlock worker_finished_mutex in try main_worker_loop conf ~yield:Thread.yield channel_worker ~shard_id map_test_cases ~worker_log_file; at_end () with e -> at_end (); raise e in let thread = Thread.create thread_main_worker () in let _, channel_master = make_channel master_id false string_of_message_from_worker string_of_message_to_worker worker_to_master master_to_worker in let is_running () = let res = Mutex.lock worker_finished_mutex; not !worker_finished in Mutex.unlock worker_finished_mutex; res in let close_worker () = let killer () = let total_wait = ref 0.0 in let step = 0.1 in Mutex.lock worker_finished_mutex; while !total_wait < 5.0 && not !worker_finished do Mutex.unlock worker_finished_mutex; Thread.delay step; total_wait := !total_wait +. step; Mutex.lock worker_finished_mutex done; if not !worker_finished then begin (* We should kill [thread] here but there seems to be no way to kill a thread so we will just fail. *) raise (Invalid_argument "Thread.kill not implemented") end; Mutex.unlock worker_finished_mutex in let killer_thread = Thread.create killer () in Mutex.lock worker_finished_mutex; while not !worker_finished do Condition.wait worker_finished_cond worker_finished_mutex done; Mutex.unlock worker_finished_mutex; try Thread.join killer_thread; Thread.join thread; None with e -> Some (Printf.sprintf "Exception raised: %s." (Printexc.to_string e)) in { channel = channel_master; close_worker = close_worker; select_fd = select_fd; shard_id = shard_id; is_running = is_running; } let workers_waiting ~timeout:_ workers = let channel_timeout = Event.new_channel () in (* TODO: clean implementation of the timeout. * Timeout not implemented, because it should be killed in most cases and * actually Thread.kill is not implemented for systhreads. * We could do either of this: * - Thread.time_read + mkpipe * - use signal ALARM * * Patch welcome. * * Sylvain Le Gall -- 2013/09/18. let thread_timeout = Thread.create (fun () -> Thread.delay timeout; Event.sync (Event.send channel_timeout None)) () in *) let worker_id_ready = Event.select (Event.receive channel_timeout :: (List.rev_map (fun worker -> Event.wrap (Event.receive worker.select_fd) (fun s -> Some s)) workers)) in match worker_id_ready with | None -> (* Thread.join thread_timeout; *) [] | Some worker_id -> (* Thread.kill thread_timeout; *) try let worker = List.find (fun worker -> worker.shard_id = worker_id) workers in [worker] with Not_found -> assert false let init () = OUnitRunner.register "threads" 70 (runner create_worker workers_waiting) ounit-2.2.7/src/lib/ounit2/threads/oUnitThreads.ml000066400000000000000000000052031440660116100220310ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) let init () = OUnitShared.mutex_create := (fun () -> let mutex = Mutex.create () in { OUnitShared. lock = (fun () -> Mutex.lock mutex); try_lock = (fun () -> Mutex.try_lock mutex); unlock = (fun () -> Mutex.unlock mutex); }); OUnitRunnerThreads.init () ounit-2.2.7/src/tools/000077500000000000000000000000001440660116100146065ustar00rootroot00000000000000ounit-2.2.7/src/tools/data_gen/000077500000000000000000000000001440660116100163505ustar00rootroot00000000000000ounit-2.2.7/src/tools/data_gen/data_gen.ml000066400000000000000000000006731440660116100204520ustar00rootroot00000000000000let file_to_string f = let chan = open_in_bin f in let len = in_channel_length chan in let res = Bytes.create len in really_input chan res 0 len; close_in chan; Bytes.to_string res let _ = let css = file_to_string "oUnit.css" in let js = file_to_string "oUnit.js" in let chan = open_out_bin "oUnitLoggerHTMLData.ml" in Printf.fprintf chan "let oUnit_css = %S;; let oUnit_js = %S;;" css js; close_out chan ounit-2.2.7/src/tools/data_gen/dune000066400000000000000000000000361440660116100172250ustar00rootroot00000000000000(executable (name data_gen)) ounit-2.2.7/test/000077500000000000000000000000001440660116100136365ustar00rootroot00000000000000ounit-2.2.7/test/JUnit.xsd000066400000000000000000000235631440660116100154200ustar00rootroot00000000000000 JUnit test result schema for the Apache Ant JUnit and JUnitReport tasks Copyright © 2011, Windy Road Technology Pty. Limited The Apache Ant JUnit XML Schema is distributed under the terms of the GNU Lesser General Public License (LGPL) http://www.gnu.org/licenses/lgpl.html Permission to waive conditions of this license may be requested from Windy Road Support (http://windyroad.org/support). Contains an aggregation of testsuite results Derived from testsuite/@name in the non-aggregated documents Starts at '0' for the first testsuite and is incremented by 1 for each following testsuite Contains the results of exexuting a testsuite Properties (e.g., environment settings) set during test execution Indicates that the test errored. An errored test is one that had an unanticipated problem. e.g., an unchecked throwable; or a problem with the implementation of the test. Contains as a text node relevant data for the error, e.g., a stack trace The error message. e.g., if a java exception is thrown, the return value of getMessage() The type of error that occurred. e.g., if a java exception is thrown the full class name of the exception. Indicates that the test failed. A failure is a test which the code has explicitly failed by using the mechanisms for that purpose. e.g., via an assertEquals. Contains as a text node relevant data for the failure, e.g., a stack trace The message specified in the assert The type of the assert. Name of the test method Full class name for the class the test method is in. Time taken (in seconds) to execute the test Data that was written to standard out while the test was executed Data that was written to standard error while the test was executed Full class name of the test for non-aggregated testsuite documents. Class name without the package for aggregated testsuites documents when the test was executed. Timezone may not be specified. Host on which the tests were executed. 'localhost' should be used if the hostname cannot be determined. The total number of tests in the suite The total number of tests in the suite that failed. A failure is a test which the code has explicitly failed by using the mechanisms for that purpose. e.g., via an assertEquals The total number of tests in the suite that errorrd. An errored test is one that had an unanticipated problem. e.g., an unchecked throwable; or a problem with the implementation of the test. Time taken (in seconds) to execute the tests in the suite ounit-2.2.7/test/common/000077500000000000000000000000001440660116100151265ustar00rootroot00000000000000ounit-2.2.7/test/common/dune000066400000000000000000000002521440660116100160030ustar00rootroot00000000000000(library (name testcommon) (modules testCommonRunner segfault) (foreign_stubs (names segfault) (language c)) (wrapped false) (libraries ounit2 ounit2.advanced)) ounit-2.2.7/test/common/segfault.c000066400000000000000000000002641440660116100171060ustar00rootroot00000000000000#include #include value caml_cause_segfault(value unit) { CAMLparam1 (unit); int *ptr = NULL; *ptr = 1; CAMLreturn (Val_unit); } ounit-2.2.7/test/common/segfault.ml000066400000000000000000000000761440660116100172750ustar00rootroot00000000000000external cause_segfault: unit -> unit = "caml_cause_segfault" ounit-2.2.7/test/common/testCommonRunner.ml000066400000000000000000000056441440660116100210130ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 let run_fake_external_prog ~ctxt ?(runner="sequential") ?exit_code prog args fn = let env = Array.of_list (Array.fold_left (fun lst e -> let prefix = "OUNIT_" in if String.length e >= String.length prefix then begin let start = String.sub e 0 (String.length prefix) in if start = prefix then lst else e :: lst end else e :: lst) [] (Unix.environment ())) in assert_command ~ctxt ?exit_code ~env prog ("-output-file" :: fn :: "-runner" :: runner :: args) ounit-2.2.7/test/dune000066400000000000000000000007161440660116100145200ustar00rootroot00000000000000(test (name test) (libraries ounit2 ounit2.advanced str libtest) (package ounit2) (deps test.exe (:fakeHTML fakeHTML/fakeHTML.exe) (:fakeRunner fakeRunner/fakeRunner.exe) (:fakeShared fakeShared/fakeShared.exe) (:fakeBadFinaliser fakeBadFinaliser/fakeBadFinaliser.exe) JUnit.xsd) (action (run %{test} -fakeHTML %{fakeHTML} -fakeRunner %{fakeRunner} -fakeShared %{fakeShared} -fakeBadFinaliser %{fakeBadFinaliser}))) ounit-2.2.7/test/fakeBadFinaliser/000077500000000000000000000000001440660116100170105ustar00rootroot00000000000000ounit-2.2.7/test/fakeBadFinaliser/dune000066400000000000000000000001051440660116100176620ustar00rootroot00000000000000(executable (name fakeBadFinaliser) (libraries ounit2 testcommon)) ounit-2.2.7/test/fakeBadFinaliser/fakeBadFinaliser.ml000066400000000000000000000057131440660116100225220ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* * Fake test, to test finalisation misbehaving. *) open OUnit2 let finaliser_token = OUnit2.Conf.make_string "finaliser_token" "abcdef" "Token to identify to check in the logs the the finaliser has run." let finalise_with_error token _ = print_endline token; Segfault.cause_segfault () let suite = "OUnitFakeBadFinaliser" >::: [ "test where the finaliser should fail" >:: (fun test_ctxt -> let fake_value = String.make 8 'X' in Gc.finalise (finalise_with_error (finaliser_token test_ctxt)) fake_value; assert_equal fake_value "XXXXXXXX"); ] let () = run_test_tt_main suite ounit-2.2.7/test/fakeHTML/000077500000000000000000000000001440660116100152315ustar00rootroot00000000000000ounit-2.2.7/test/fakeHTML/dune000066400000000000000000000000621440660116100161050ustar00rootroot00000000000000(executable (name fakeHTML) (libraries ounit2)) ounit-2.2.7/test/fakeHTML/fakeHTML.ml000066400000000000000000000056151440660116100171650ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* * Fake tests, to test HTML output. *) open OUnit2 let suite = "OUnitLoggerHTML" >::: [ "first test" >:: (fun _ -> assert_equal 0 1); "second test" >:: (fun _ -> assert_equal 0 0); "third test" >:: (fun _ -> skip_if true "skipped because of me"); "fourth test" >:: (fun _ -> todo "need to make this function"); "fifth test" >:: (fun _ -> raise Not_found); "with symbol" >:: (fun _ -> failwith "this is a bad message: '\"&<>") ] let () = run_test_tt_main suite ounit-2.2.7/test/fakeRunner/000077500000000000000000000000001440660116100157365ustar00rootroot00000000000000ounit-2.2.7/test/fakeRunner/dune000066400000000000000000000001161440660116100166120ustar00rootroot00000000000000(executable (name fakeRunner) (libraries ounit2 ounit2.threads testcommon)) ounit-2.2.7/test/fakeRunner/fakeRunner.ml000066400000000000000000000063251440660116100203760ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* * Fake tests, to test runner behavior in some situation. *) open OUnit2 let sigsegv = Conf.make_bool "sigsegv" false "Fail with SIGSEGV." let timeout = Conf.make_bool "timeout" false "Time out." let suite = "TestFakeRunner" >::: [ "success" >:: (fun _ -> assert_equal 0 0); "failure" >:: (fun _ -> assert_equal 0 1); "skip" >:: (fun _ -> skip_if true "skipped because of me"); "todo" >:: (fun _ -> todo "need to make this function"); "error" >:: (fun _ -> raise Not_found); "SIGSEGV" >:: (fun ctxt -> if sigsegv ctxt then begin Segfault.cause_segfault () end); "Timeout" >: (test_case ~length:(OUnitTest.Custom_length 0.1) (fun ctxt -> if timeout ctxt then Unix.sleep 1)) ] let () = OUnitThreads.init (); run_test_tt_main suite ounit-2.2.7/test/fakeShared/000077500000000000000000000000001440660116100156735ustar00rootroot00000000000000ounit-2.2.7/test/fakeShared/dune000066400000000000000000000001031440660116100165430ustar00rootroot00000000000000(executable (name fakeShared) (libraries ounit2 ounit2.threads)) ounit-2.2.7/test/fakeShared/fakeShared.ml000066400000000000000000000062711440660116100202700ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* * Fake tests, to test mutex behavior with different runner. *) open OUnit2 open OUnitShared let test_mutex ctxt mutex = let shared = ctxt.OUnitTest.shared in Mutex.lock shared mutex; (* On Windows, try_lock will succeed if it has been locked by the thread * itself. *) if Sys.os_type <> "Win32" then assert_bool "Cannot acquire a locked mutex." (not (Mutex.try_lock shared mutex)); Mutex.unlock shared mutex; assert_bool "Can acquire an unlocked mutex." (Mutex.try_lock shared mutex); Mutex.unlock shared mutex let tests = "Shared" >::: [ "MutexGlobal" >:: (fun ctxt -> test_mutex ctxt (Mutex.create ScopeGlobal)); "MutexProcess" >:: (fun ctxt -> test_mutex ctxt (Mutex.create ScopeProcess)); ] let () = OUnitThreads.init (); run_test_tt_main tests ounit-2.2.7/test/libtest/000077500000000000000000000000001440660116100153045ustar00rootroot00000000000000ounit-2.2.7/test/libtest/dune000066400000000000000000000001361440660116100161620ustar00rootroot00000000000000(library (name libtest) (wrapped false) (libraries str ounit2 ounit2.advanced testcommon)) ounit-2.2.7/test/libtest/testCommon.ml000066400000000000000000000105711440660116100177720ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest open OUnit2 let perform_test test = let null_logger = OUnitLogger.null_logger in let conf = OUnitConf.default () in OUnitCore.perform_test conf null_logger OUnitRunner.sequential_runner OUnitChooser.simple test let assert_equal_test_result exp res = let norm lst = let norm_one (path, test_result, pos) = let test_result' = match test_result with | RSuccess -> RSuccess | RFailure (str, _, _) -> RFailure (str, None, None) | RError (str, _) -> RError(str, None) | RSkip str -> RSkip str | RTodo str -> RTodo str | RTimeout test_length -> RTimeout test_length in (path, test_result', pos) in List.sort Stdlib.compare (List.rev_map norm_one lst) in assert_equal ~cmp: (fun a b -> norm a = norm b) ~printer: (fun results -> String.concat "; " (List.map (fun (path, test_result, _) -> let spf fmt = Printf.sprintf fmt in let string_of_backtrace = function | Some str -> spf "Some (%S)" str | None -> "None" in let test_result_string = match test_result with | RSuccess -> "RSuccess" | RFailure (str, _, backtrace) -> spf "RFailure(%S, _, %s)" str (string_of_backtrace backtrace) | RError (str, backtrace) -> spf "RError(%S, %s)" str (string_of_backtrace backtrace) | RSkip str -> spf "RSkip(%S)" str | RTodo str -> spf "RTodo(%S)" str | RTimeout _ -> "RTimeout(_)" in Printf.sprintf "%S, %s" (OUnitTest.string_of_path path) test_result_string) (norm results))) exp res let skip_if_notunix () = skip_if (Sys.os_type <> "Unix") "Only run on Unix." ounit-2.2.7/test/libtest/testConf.ml000066400000000000000000000103221440660116100174210ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 open OUnitConf type t = { vint: OUnitConf.conf -> int; vstring: OUnitConf.conf -> string; } let bracket_ounitconf = bracket (fun _ -> (* TODO: we need a lock here. *) { vint = make_int "int" 0 ""; vstring = make_string "string" "" ""; }) (fun _ _ -> Hashtbl.remove metaconf "int"; Hashtbl.remove metaconf "string"; (* TODO: release the lock. *) ()) let tests = "OUnitConf" >::: [ "CLI" >:: (fun test_ctxt -> let t = bracket_ounitconf test_ctxt in let conf = load ~argv:[|"foo"; "-int"; "2"; "-string"; "foo bar"|] [] in assert_equal ~printer:string_of_int 2 (t.vint conf); assert_equal ~printer:(fun s -> s) "foo bar" (t.vstring conf)); "File" >:: (fun test_ctxt -> let fn, chn = bracket_tmpfile test_ctxt in let t = bracket_ounitconf test_ctxt in let () = output_string chn "int = 1\n\ string = \"abcd ef\""; close_out chn in let conf = load ~argv:[|"foo"; "-conf"; fn|] [] in assert_equal ~printer:string_of_int 1 (t.vint conf); assert_equal ~printer:(fun s -> s) "abcd ef" (t.vstring conf)); "Substitution" >:: (fun test_ctxt -> let _ = bracket_ounitconf test_ctxt in let conf = load ~argv:[|"foo"; "-int"; "10"|] [] in assert_equal ~printer:(fun s -> s) "foo-10" (subst conf [] "foo-$int")); "NoDoubleInject" >:: (fun test_ctxt -> let _ = bracket_ounitconf test_ctxt in try let _option: conf -> string = make_string "string" "" "" in assert_failure "Should not be able to inject duplicate configuration \ option 'string'." with Failure _ -> ()); ] ounit-2.2.7/test/libtest/testOUnit1.ml000066400000000000000000000257031440660116100176640ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit let test_case = TestCase (fun () -> ()) let labeled_test_case = "label" >: test_case let suite_a = "suite_a" >: TestList [test_case] let suite_b = "suite_b" >: TestList [labeled_test_case] let suite_c = "suite_c" >: TestList [test_case; labeled_test_case] let suite_d = "suite_d" >: TestList [suite_a; suite_c] let rec string_of_paths = function [] -> "" | h::t -> (string_of_path h) ^ "\n" ^ (string_of_paths t) (* Test which checks if the test case count function works correctly *) let test_case_count _ = let assert_equal ?msg = assert_equal ?msg ~printer:string_of_int in assert_equal 0 (test_case_count (TestList [])); assert_equal 0 (test_case_count (TestLabel("label", TestList []))); assert_equal 0 (test_case_count (TestList [TestList []; TestList [TestList []]])); assert_equal 1 (test_case_count test_case); assert_equal 1 (test_case_count labeled_test_case); assert_equal 1 (test_case_count suite_a); assert_equal 1 (test_case_count suite_b); assert_equal 1 (test_case_count (TestList [suite_a; TestList []])); assert_equal 1 (test_case_count (TestList [TestList []; TestList [suite_b]])); assert_equal 2 (test_case_count suite_c); assert_equal 3 (test_case_count suite_d) (* Test which checks if the paths are correctly constructed *) let test_case_paths _ = (* A single testcase results in a list countaining an empty list *) let assert_equal ?msg = assert_equal ?msg ~printer:string_of_paths in assert_equal [[]] (test_case_paths test_case); assert_equal [[Label "label"]] (test_case_paths labeled_test_case); assert_equal [[ListItem 0; Label "suite_a"]] (test_case_paths suite_a); assert_equal [[Label "label"; ListItem 0; Label "suite_b"]] (test_case_paths suite_b); assert_equal [[ListItem 0; Label "suite_c"]; [Label "label"; ListItem 1; Label "suite_c"]] (test_case_paths suite_c); assert_equal [[ListItem 0; Label "suite_a"; ListItem 0; Label "suite_d"]; [ListItem 0; Label "suite_c"; ListItem 1; Label "suite_d"]; [Label "label"; ListItem 1; Label "suite_c"; ListItem 1; Label "suite_d"]] (test_case_paths suite_d) let test_assert_raises _ = assert_raises (OUnitTest.OUnit_failure "expected: Failure(\"Boo\") but got: Failure(\"Foo\")") (fun _ -> (assert_raises (Failure "Boo") (fun _ -> raise (Failure "Foo")))); assert_raises (OUnitTest.OUnit_failure "A label\nexpected: Failure(\"Boo\") \ but got: Failure(\"Foo\")") (fun _ -> (assert_raises ~msg:"A label" (Failure "Boo") (fun _ -> raise (Failure "Foo")))); assert_raises (OUnitTest.OUnit_failure "expected exception Failure(\"Boo\"), \ but no exception was raised.") (fun _ -> (assert_raises (Failure "Boo") (fun _ -> ()))); assert_raises (OUnitTest.OUnit_failure "A label\nexpected exception Failure(\"Boo\"), \ but no exception was raised.") (fun _ -> (assert_raises ~msg:"A label" (Failure "Boo") (fun _ -> ()))) (* Test the float compare, and use the cmp label *) let test_cmp_float _ = assert_equal ~cmp: cmp_float 0.0001 0.0001; assert_equal ~cmp: (cmp_float ~epsilon: 0.001) 1.0001 1.00001; assert_raises (OUnitTest.OUnit_failure "not equal") (fun _ -> assert_equal ~cmp: cmp_float 100.0001 101.001); assert_equal ~cmp:cmp_float infinity infinity; assert_equal ~cmp:cmp_float neg_infinity neg_infinity; assert_raises ~msg:"inf <> 0" (OUnitTest.OUnit_failure "not equal") (fun _ -> assert_equal ~cmp: cmp_float infinity 0.0); assert_raises ~msg:"inf <> -inf" (OUnitTest.OUnit_failure "not equal") (fun _ -> assert_equal ~cmp: cmp_float infinity neg_infinity); assert_raises ~msg:"nan <> 0" (OUnitTest.OUnit_failure "not equal") (fun _ -> assert_equal ~cmp: cmp_float nan 0.); assert_raises ~msg:"nan <> nan" (OUnitTest.OUnit_failure "not equal") (fun _ -> assert_equal ~cmp: cmp_float nan nan) let test_assert_string _ = assert_string ""; assert_raises (OUnitTest.OUnit_failure "A string") (fun _ -> assert_string "A string") let test_assert_bool _ = assert_bool "true" true; assert_raises (OUnitTest.OUnit_failure "false") (fun _ -> assert_bool "false" false) let test_case_filter () = let assert_test_case_count res tst_opt = match tst_opt with | Some tst -> assert_equal res (OUnit.test_case_count tst) | None -> assert_failure "Unexpected empty filter result" in assert_equal None (test_filter [] suite_a); assert_equal None (test_filter [] suite_b); assert_equal None (test_filter [] suite_c); assert_equal None (test_filter [] suite_d); assert_test_case_count 1 (test_filter ["suite_a"] suite_a); assert_test_case_count 1 (test_filter ["suite_a:0"] suite_a); assert_test_case_count 1 (test_filter ["suite_b:0:label"] suite_b); assert_test_case_count 1 (test_filter ["suite_c:0"] suite_c); assert_test_case_count 2 (test_filter ["suite_c:0";"suite_c:1:label"] suite_c) let assert_equal_test_result = assert_equal ~printer:(fun tst_results -> String.concat "; " (List.map (function | RSuccess path -> Printf.sprintf "RSuccess %S" (string_of_path path) | RFailure (path, str) -> Printf.sprintf "RFailure(%S, %S)" (string_of_path path) str | RError (path, str) -> Printf.sprintf "RError(%S, %S)" (string_of_path path) str | RSkip (path, str) -> Printf.sprintf "RSkip(%S, %S)" (string_of_path path) str | RTodo (path, str) -> Printf.sprintf "RTodo(%S, %S)" (string_of_path path) str ) tst_results )) let null_logger = OUnitLogger.null_logger let test_case_decorate () = assert_equal_test_result [RSuccess [Label "label"; ListItem 1; Label "suite_c"]; RSuccess [ListItem 0; Label "suite_c"]] (perform_test ignore suite_c); assert_equal_test_result [RFailure([Label "label"; ListItem 1; Label "suite_c"], "fail"); RFailure([ListItem 0; Label "suite_c"], "fail")] (perform_test ignore (test_decorate (fun _ -> (fun () -> assert_failure "fail")) suite_c)) let test_case_skip () = assert_equal_test_result [RSkip ([Label "skip"], "test")] (perform_test ignore ("skip" >:: (fun () -> skip_if true "test"))) let test_case_todo () = assert_equal_test_result [RTodo ([Label "todo"], "test")] (perform_test ignore ("todo" >:: (fun () -> todo "test"))) let test_assert_command () = assert_command Sys.executable_name ["-help"] module EInt = struct type t = int let compare = ( - ) let pp_printer = Format.pp_print_int let pp_print_sep = OUnitDiff.pp_comma_separator end module DiffSetInt = OUnitDiff.SetMake(EInt) module DiffListSimpleInt = OUnitDiff.ListSimpleMake(EInt) let test_diff () = let lst_exp = [1; 2; 3; 4; 5] in let lst_real = [1; 2; 5; 4] in assert_raises (OUnitTest.OUnit_failure "expected: 1, 2, 3, 4, 5 but got: 1, 2, 4, 5\n\ differences: -3") (fun () -> DiffSetInt.assert_equal (DiffSetInt.of_list lst_exp) (DiffSetInt.of_list lst_real)); DiffSetInt.assert_equal (DiffSetInt.of_list lst_exp) (DiffSetInt.of_list lst_exp); assert_raises (OUnitTest.OUnit_failure "expected: 1, 2, 3, 4, 5 but got: 1, 2, 5, 4\n\ differences: element number 2 differ (3 <> 5)") (fun () -> DiffListSimpleInt.assert_equal lst_exp lst_real); DiffListSimpleInt.assert_equal lst_exp lst_exp (* Construct the test suite *) let tests = "OUnit1" >::: [ "test_case_count" >:: test_case_count; "test_case_paths" >:: test_case_paths; "test_assert_raises" >:: test_assert_raises; "test_assert_string" >:: test_assert_string; "test_assert_bool" >:: test_assert_bool; "test_cmp_float" >:: test_cmp_float; "test_case_filter" >:: test_case_filter; "test_case_decorate" >:: test_case_decorate; "test_case_skip" >:: test_case_skip; "test_case_todo" >:: test_case_todo; "test_assert_command" >:: test_assert_command; "test_diff" >:: test_diff; ] ounit-2.2.7/test/libtest/testOUnit2.ml000066400000000000000000000101221440660116100176520ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 let test_normal = "Normal" >:: (fun _ -> ()) let test_assert = "Assert" >:: (fun _ -> assert_equal 1 1) let test_todo = "Todo" >:: (fun _ -> todo "test") let test_skip = "Skip" >:: (fun _ -> skip_if true "to be skipped") let test_fail = "Fail" >:: (fun _ -> assert_equal 1 2) let test_error = "Error" >:: (fun _ -> failwith "Not expected") let test_ounit2 suite test_ctxt = let log_fn, _ = bracket_tmpfile test_ctxt in let conf = OUnitConf.default ~preset:["chooser", "simple"; "runner", "sequential"; "output_file", log_fn; "display", "false"] () in let old_get_conf = (* TODO: acquire lock *) !OUnitCore.run_test_tt_main_conf in let [@warning "-27"] override_conf ?preset ?argv _ = OUnitCore.run_test_tt_main_conf := old_get_conf; (* TODO: release lock *) conf in let exit_code = ref 0 in OUnitCore.run_test_tt_main_conf := override_conf; run_test_tt_main ~exit:(fun i -> exit_code := i) suite; !exit_code, log_fn let test_ok ctxt = let exit_code, _ = test_ounit2 ("OK" >::: [test_normal; test_assert; test_skip]) ctxt in assert_equal ~printer:string_of_int 0 exit_code let test_ko = let one lst ctxt = let exit_code, _ = test_ounit2 ("KO" >::: [test_normal; test_assert; test_skip] @ lst) ctxt in assert_equal ~printer:string_of_int 1 exit_code in List.map (fun lst -> test_case (one lst)) [ [test_todo]; [test_fail]; [test_error]; [test_todo; test_fail; test_error]; ] (* Construct the test suite *) let tests = "OUnit2" >::: [ "test_ok" >:: test_ok; "test_ko" >::: test_ko; ] ounit-2.2.7/test/libtest/testOUnitAssert.ml000066400000000000000000000106451440660116100207640ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest open OUnit2 let test_assert_raises _ = assert_raises (OUnit_failure "expected: Failure(\"Boo\") but got: Failure(\"Foo\")") (fun _ -> (assert_raises (Failure "Boo") (fun _ -> raise (Failure "Foo")))); assert_raises (OUnit_failure "A label\nexpected: Failure(\"Boo\") but got: Failure(\"Foo\")") (fun _ -> (assert_raises ~msg:"A label" (Failure "Boo") (fun _ -> raise (Failure "Foo")))); assert_raises (OUnit_failure "expected exception Failure(\"Boo\"), \ but no exception was raised.") (fun _ -> (assert_raises (Failure "Boo") (fun _ -> ()))); assert_raises (OUnit_failure "A label\nexpected exception Failure(\"Boo\"), \ but no exception was raised.") (fun _ -> (assert_raises ~msg:"A label" (Failure "Boo") (fun _ -> ()))) (* Test the float compare, and use the cmp label *) let test_cmp_float _ = assert_equal ~cmp: cmp_float 0.0001 0.0001; assert_equal ~cmp: (cmp_float ~epsilon: 0.001) 1.0001 1.00001; assert_raises (OUnit_failure "not equal") (fun _ -> assert_equal ~cmp: cmp_float 100.0001 101.001) let test_assert_string _ = assert_string ""; assert_raises (OUnit_failure "A string") (fun _ -> assert_string "A string") let test_assert_bool _ = assert_bool "true" true; assert_raises (OUnit_failure "false") (fun _ -> assert_bool "false" false) let test_case_skip _ = begin try skip_if false "test" with _ -> assert_failure "Should not skip this test." end; assert_raises (Skip "test") (fun _ -> skip_if true "test") let test_case_todo _ = assert_raises (Todo "test") (fun _ -> todo "test") let test_assert_command ctxt = assert_command ~ctxt Sys.executable_name ["-help"] let tests = "OUnitAssert" >::: [ "test_assert_raises" >:: test_assert_raises; "test_assert_string" >:: test_assert_string; "test_assert_bool" >:: test_assert_bool; "test_cmp_float" >:: test_cmp_float; "test_case_skip" >:: test_case_skip; "test_case_todo" >:: test_case_todo; "test_assert_command" >:: test_assert_command; ] ounit-2.2.7/test/libtest/testOUnitBracket.ml000066400000000000000000000114571440660116100211000ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 open OUnitBracket (* Retain bracket return for further testing. *) let with_bracket_holder test_ctxt bracket f = let rres = ref None in with_bracket test_ctxt bracket (fun res _ -> rres := Some res; f res); match !rres with | None -> assert_failure "Bracket holder not initialized." | Some res -> res let tests = "OUnitBracket" >::: [ "tmpfile" >:: (fun test_ctxt -> let fn, _ = with_bracket_holder test_ctxt bracket_tmpfile (fun (fn, _) -> assert_bool "Temporary file exists." (Sys.file_exists fn)) in assert_bool "Temporary file doesn't exist anymore." (not (Sys.file_exists fn))); "tmpdir" >:: (fun test_ctxt -> let dn = with_bracket_holder test_ctxt bracket_tmpdir (fun dn -> assert_bool "Temporary directory exists." (Sys.is_directory dn)) in assert_bool "Temporary directory doesn't exist anymore." (not (Sys.file_exists dn))); "tmpdir_with_symlink" >:: (fun test_ctxt -> let () = TestCommon.skip_if_notunix () in let tmpdn = bracket_tmpdir test_ctxt in let tmpdn2 = Filename.concat tmpdn "bar" in let _ = Unix.mkdir tmpdn2 0700; assert_bool "Directory outside of temporary directory exists." (Sys.file_exists tmpdn2); with_bracket_holder test_ctxt bracket_tmpdir (fun dn -> let target = Filename.concat dn "symlink" in Unix.symlink tmpdn target) in assert_bool "Directory outside of temporary directory still exists." (Sys.file_exists tmpdn2)); "chdir" >:: (fun test_ctxt -> let tmpdn = bracket_tmpdir test_ctxt in let orgdn = Sys.getcwd () in let () = with_bracket test_ctxt (bracket_chdir tmpdn) (fun _ (_ : OUnitTest.ctxt) -> assert_bool (Printf.sprintf "Expected to have changed to a new directory, but still in %s" orgdn) (orgdn <> (Sys.getcwd ()))) in assert_bool (Printf.sprintf "Expected to be back in the original directory, but still in %s" (Sys.getcwd ())) (orgdn = Sys.getcwd ())); ] ounit-2.2.7/test/libtest/testOUnitChooser.ml000066400000000000000000000127761440660116100211340ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 open OUnitChooser open OUnitTest module MapString = Map.Make(String) let choose label = Choose [Label label] let postpone = ChooseToPostpone let skip label = ChooseToSkip [Label label] let check_choices chooser tests expected_choices = let result_of_test = List.fold_left (fun mp (path, _, result) -> MapString.add path result mp) MapString.empty tests in let add_result path result t = {t with tests_passed = (path, result, None) :: t.tests_passed} in let not_planned path t = {t with tests_planned = List.filter ((<>) path) t.tests_planned} in let rec virtual_run choices t = (* Choose with 1+ test still running. *) let choice = chooser t in (* Finish the running test. *) let t = match t.tests_running with | path :: tl -> let result = MapString.find (string_of_path path) result_of_test in let t = add_result path result t in {t with tests_running = tl} | [] -> t in (* Apply the choice. *) let choices = choice :: choices in match choice with | ChooseToSkip path -> virtual_run choices (not_planned path (add_result path (RSkip "") t)) | ChooseToPostpone -> virtual_run choices t | Choose path -> virtual_run choices (not_planned path {t with tests_running = path :: t.tests_running}) | NoChoice -> choices, t in let t = { tests_planned = List.map (fun (path, _, _) -> [Label path]) tests; tests_running = []; tests_passed = []; cache = List.fold_left (fun cache (path, was_result_opt, _) -> match was_result_opt with | Some result -> OUnitCache.add_result [Label path] result cache | None -> cache) OUnitCache.default tests } in let actual_choices, t = virtual_run [] t in assert_equal ~msg:"All tests passed." ~printer:string_of_int (List.length tests) (List.length t.tests_passed); assert_equal ~msg:"Right choices made." ~printer:(fun choices -> String.concat ", " (List.map string_of_choice choices)) (expected_choices @ [NoChoice]) (List.rev actual_choices) let test ?(run=true) ?(failed=false) ?(still=true) label = label, begin if run && failed then Some (RFailure ("", None, None)) else if run then Some RSuccess else None end, begin let now_failed = if still then failed else not failed in if now_failed then RFailure ("", None, None) else RSuccess end let tests = "Chooser" >::: [ "failfirst" >:: (fun _ -> check_choices failfirst [test "foo"] [choose "foo"]; check_choices failfirst [test "foo"; test ~failed:true ~still:false "bar"] [choose "bar"; postpone; choose "foo"]; check_choices failfirst [test "foo"; test ~failed:true "bar"] [choose "bar"; postpone; skip "foo"]) ] ounit-2.2.7/test/libtest/testOUnitDiff.ml000066400000000000000000000067061440660116100203760ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 module EInt = struct type t = int let compare = ( - ) let pp_printer = Format.pp_print_int let pp_print_sep = OUnitDiff.pp_comma_separator end module DiffSetInt = OUnitDiff.SetMake(EInt) module DiffListSimpleInt = OUnitDiff.ListSimpleMake(EInt) let test_diff _ = let lst_exp = [1; 2; 3; 4; 5] in let lst_real = [1; 2; 5; 4] in assert_raises (OUnitTest.OUnit_failure "expected: 1, 2, 3, 4, 5 but got: 1, 2, 4, 5\n\ differences: -3") (fun () -> DiffSetInt.assert_equal (DiffSetInt.of_list lst_exp) (DiffSetInt.of_list lst_real)); DiffSetInt.assert_equal (DiffSetInt.of_list lst_exp) (DiffSetInt.of_list lst_exp); assert_raises (OUnitTest.OUnit_failure "expected: 1, 2, 3, 4, 5 but got: 1, 2, 5, 4\n\ differences: element number 2 differ (3 <> 5)") (fun () -> DiffListSimpleInt.assert_equal lst_exp lst_real); DiffListSimpleInt.assert_equal lst_exp lst_exp (* Construct the test suite *) let tests = "OUnitDiff" >::: ["test_diff" >:: test_diff] ounit-2.2.7/test/libtest/testOUnitTest.ml000066400000000000000000000170101440660116100204330ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnitTest open TestCommon open OUnit2 let test_case = TestCase (Short, fun _ -> ()) let labeled_test_case = TestLabel ("label", test_case) let suite_a = TestLabel ("suite_a", TestList [test_case]) let suite_b = TestLabel ("suite_b", TestList [labeled_test_case]) let suite_c = TestLabel ("suite_c", TestList [test_case; labeled_test_case]) let suite_d = TestLabel ("suite_d", TestList [suite_a; suite_c]) let rec string_of_paths = function [] -> "" | h::t -> (string_of_path h) ^ "\n" ^ (string_of_paths t) let test_case_filter _ = let assert_test_case_count exp tst_opt = match tst_opt with | Some tst -> assert_equal exp (test_case_count tst) | None -> assert_failure "Unexpected empty filter result" in assert_equal None (test_filter [] suite_a); assert_equal None (test_filter [] suite_b); assert_equal None (test_filter [] suite_c); assert_equal None (test_filter [] suite_d); assert_test_case_count 1 (test_filter ["suite_a"] suite_a); assert_test_case_count 1 (test_filter ["suite_a:0"] suite_a); assert_test_case_count 1 (test_filter ["suite_b:0:label"] suite_b); assert_test_case_count 1 (test_filter ["suite_c:0"] suite_c); assert_test_case_count 2 (test_filter ["suite_c:0";"suite_c:1:label"] suite_c) let test_case_decorate _ = assert_equal_test_result [ [Label "label"; ListItem 1; Label "suite_c"], RSuccess, None; [ListItem 0; Label "suite_c"], RSuccess, None ] (perform_test suite_c); assert_equal_test_result [ [Label "label"; ListItem 1; Label "suite_c"], RFailure("fail", None, None), None; [ListItem 0; Label "suite_c"], RFailure("fail", None, None), None; ] (perform_test (test_decorate (fun _ -> (fun _ -> assert_failure "fail")) suite_c)) (* Test which checks if the test case count function works correctly *) let test_case_count _ = let assert_equal ?msg = assert_equal ?msg ~printer:string_of_int in assert_equal 0 (test_case_count (TestList [])); assert_equal 0 (test_case_count (TestLabel("label", TestList []))); assert_equal 0 (test_case_count (TestList [TestList []; TestList [TestList []]])); assert_equal 1 (test_case_count test_case); assert_equal 1 (test_case_count labeled_test_case); assert_equal 1 (test_case_count suite_a); assert_equal 1 (test_case_count suite_b); assert_equal 1 (test_case_count (TestList [suite_a; TestList []])); assert_equal 1 (test_case_count (TestList [TestList []; TestList [suite_b]])); assert_equal 2 (test_case_count suite_c); assert_equal 3 (test_case_count suite_d) (* Test which checks if the paths are correctly constructed *) let test_case_paths _ = (* A single testcase results in a list countaining an empty list *) let assert_equal ?msg = assert_equal ?msg ~printer:string_of_paths in assert_equal [[]] (test_case_paths test_case); assert_equal [[Label "label"]] (test_case_paths labeled_test_case); assert_equal [[ListItem 0; Label "suite_a"]] (test_case_paths suite_a); assert_equal [[Label "label"; ListItem 0; Label "suite_b"]] (test_case_paths suite_b); assert_equal [[ListItem 0; Label "suite_c"]; [Label "label"; ListItem 1; Label "suite_c"]] (test_case_paths suite_c); assert_equal [[ListItem 0; Label "suite_a"; ListItem 0; Label "suite_d"]; [ListItem 0; Label "suite_c"; ListItem 1; Label "suite_d"]; [Label "label"; ListItem 1; Label "suite_c"; ListItem 1; Label "suite_d"]] (test_case_paths suite_d) let test_non_fatal _ = assert_equal_test_result [ [ListItem 0], RSuccess, None; [ListItem 1], RFailure("fail", None, None), None; [ListItem 2], RError("Failure(\"error\")", None), None; [ListItem 2], RFailure("fail", None, None), None; [ListItem 3], RError("Failure(\"error\")", None), None; [ListItem 3], RFailure("fail", None, None), None; ] (perform_test (TestList [ (* success *) TestCase (Short, ignore); (* failure *) TestCase (Short, fun _ -> assert_failure "fail"); (* error + failure *) TestCase (Short, fun ctxt -> OUnitTest.non_fatal ctxt (fun _ -> failwith "error"); assert_failure "fail"); (* failure + error *) TestCase (Short, fun ctxt -> OUnitTest.non_fatal ctxt (fun _ -> assert_failure "fail"); failwith "error"); ])) let tests = "OUnitTest" >::: [ "test_case_count" >:: test_case_count; "test_case_paths" >:: test_case_paths; "test_case_filter" >:: test_case_filter; "test_case_decorate" >:: test_case_decorate; "test_non_fatal" >:: test_non_fatal; ] ounit-2.2.7/test/libtest/testOtherTests.ml000066400000000000000000000163751440660116100206560ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 open OUnitUtils let xmllint = Conf.make_exec "xmllint" let fakeHTML = Conf.make_exec "fakeHTML" let tests = "OtherTests" >::: [ "TestFakeHTML" >:: (fun ctxt -> (* For easier dev. we don't use a temporary directory but a permanent * one, so that we can see the result. *) let () = skip_if (Sys.os_type = "Win32") "Don't run on Win32."; skip_if (Sys.command ((xmllint ctxt)^" --version 2> /dev/null") == 127) "xmllint not found."; in let html_dir = Filename.concat (Sys.getcwd ()) "log-html" in let junit_xml = Filename.concat html_dir "junit.xml" in let index_html = Filename.concat html_dir "index.html" in let junit_xsd = Filename.concat (Sys.getcwd ()) "JUnit.xsd" in let link_to_source bn = Sys.remove (Filename.concat html_dir bn); Unix.symlink (Filename.concat (Sys.getcwd ()) (Filename.concat "src" bn)) (Filename.concat html_dir bn) in let grep_wc fn f = let count = ref 0 in let chn = open_in fn in let () = try while true do let line = input_line chn in if f line then incr count done; with End_of_file -> close_in chn in !count in if not (Sys.file_exists html_dir) then Unix.mkdir html_dir 0o750; assert_command ~ctxt ~exit_code:(Unix.WEXITED 1) (fakeHTML ctxt) ["-output-file"; Filename.concat html_dir "fake-html.log"; "-output-html-dir"; html_dir; "-output-junit-file"; junit_xml]; assert_equal ~msg:"Number of test case in junit.xml." ~printer:string_of_int 6 (grep_wc junit_xml (fun line -> starts_with ~prefix:" starts_with ~prefix:"
if Str.string_match regex line 0 then r := int_of_string (Str.matched_group 1 line) in let cases, fcases = mk "Cases" in let tried, ftried = mk "Tried" in let errors, ferrors = mk "Errors" in let failures, ffailures = mk "Failures" in let skip, fskip = mk "Skip" in let todo, ftodo = mk "Todo" in let timeout, ftimeout = mk "Timeout" in let rrunner = ref "" in let runner_regex = Str.regexp (".* I: Runner: \\([a-z]+\\)$") in let frunner line = if Str.string_match runner_regex line 0 then rrunner := Str.matched_group 1 line in let chn = open_in fn in let () = try while true do let line = input_line chn in List.iter (fun f -> f line) [frunner; fcases; ftried; ferrors; ffailures; fskip; ftodo; ftimeout] done; with End_of_file -> close_in chn in assert_equal ~msg:"runner" ~printer:(fun s -> s) runner !rrunner; assert_bool "Cases initialized." (!cases >= 0); assert_bool "Tried initialized." (!tried >= 0); assert_bool "Errors initialized." (!errors >= 0); assert_bool "Failures initialized." (!failures >= 0); assert_bool "Skip initialized." (!skip >= 0); assert_bool "Todo initialized." (!todo >= 0); assert_bool "Timeout initialized." (!timeout >= 0); { cases = !cases; tried = !tried; errors = !errors; failures = !failures; skip = !skip; todo = !todo; timeout = !timeout; } let check_standard_results ?(extra_errors=0) ?(extra_timeouts=0) test_results = assert_equal ~msg:"test results" ~printer:string_of_test_results { cases = 7; tried = 7; errors = 1 + extra_errors; failures = 1; skip = 1; todo = 1; timeout = extra_timeouts; } test_results let tests = "Runner" >::: [ "Sequential" >:: (fun ctxt -> let test_results = run_test_fake_runner ctxt "sequential" [] in check_standard_results test_results); "Processes" >:: (fun ctxt -> let test_results = skip_if_notunix (); run_test_fake_runner ctxt "processes" [] in check_standard_results test_results); "ProcessesWithBadFinaliser" >:: (fun ctxt -> let () = skip_if_notunix () in let finaliser_token = "1234566789" in let fn, _ = bracket_tmpfile ctxt in let () = TestCommonRunner.run_fake_external_prog ~ctxt ~runner:"processes" ~exit_code:(Unix.WEXITED 1) (fakeBadFinaliser ctxt) ["-shards"; "2"; "-finaliser-token"; finaliser_token] fn in let chn = open_in fn in let str = Str.regexp (Str.quote finaliser_token) in let token_found = ref false in try while true do let line = input_line chn in if Str.string_match str line 0 then token_found := true done; assert_bool "Finaliser token found in the logs." !token_found with End_of_file -> close_in chn); "Processes#1" >:: (fun ctxt -> let test_results = skip_if_notunix (); run_test_fake_runner ctxt "processes" ["-shards"; "1"] in check_standard_results test_results); "Processes#2" >:: (fun ctxt -> let test_results = skip_if_notunix (); run_test_fake_runner ctxt "processes" ["-shards"; "2"] in check_standard_results test_results); "Processes+SIGSEGV" >:: (fun ctxt -> let test_results = skip_if_notunix (); run_test_fake_runner ctxt "processes" ["-shards"; "2"; "-sigsegv" ; "true"; "-health-check-interval"; "0.0"] in check_standard_results ~extra_errors:1 test_results); "Processes+timeout" >:: (fun ctxt -> let test_results = skip_if_notunix (); run_test_fake_runner ctxt "processes" ["-shards"; "2"; "-timeout" ; "true"; "-processes-grace-period"; "0.1"] in check_standard_results ~extra_timeouts:1 test_results); "Threads" >:: (fun ctxt -> let test_results = run_test_fake_runner ctxt "threads" [] in check_standard_results test_results); "Threads#1" >:: (fun ctxt -> let test_results = run_test_fake_runner ctxt "threads" ["-shards"; "1"] in check_standard_results test_results); "Threads#2" >:: (fun ctxt -> let test_results = run_test_fake_runner ctxt "threads" ["-shards"; "2"] in check_standard_results test_results); ] ounit-2.2.7/test/libtest/testShared.ml000066400000000000000000000057111440660116100177500ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 open TestCommon let fakeShared = Conf.make_exec "fakeShared" let run_test_fake_shared ctxt runner args = let fn, _ = bracket_tmpfile ctxt in TestCommonRunner.run_fake_external_prog ~ctxt ~exit_code:(Unix.WEXITED 0) ~runner (fakeShared ctxt) args fn let tests = "Shared" >::: [ "Sequential" >:: (fun ctxt -> run_test_fake_shared ctxt "sequential" []); "Processes" >:: (fun ctxt -> skip_if_notunix (); run_test_fake_shared ctxt "processes" ["-shards"; "2"]); "Threads" >:: (fun ctxt -> run_test_fake_shared ctxt "threads" ["-shards"; "2"]); ] ounit-2.2.7/test/lwt/000077500000000000000000000000001440660116100144445ustar00rootroot00000000000000ounit-2.2.7/test/lwt/dune000066400000000000000000000001241440660116100153170ustar00rootroot00000000000000(test (name test) (package ounit2-lwt) (libraries ounit2 ounit2-lwt testcommon)) ounit-2.2.7/test/lwt/test.ml000066400000000000000000000052111440660116100157540ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) (* * Fake tests, to test HTML output. *) open OUnit2 open Lwt.Infix let suite = "OUnitLwt" >::: [ "SimpleAssertion" >:: (OUnitLwt.lwt_wrapper (fun ctxt -> Lwt.return 4 >>= fun i -> Lwt.return (assert_equal ~ctxt 4 i))) ] let () = run_test_tt_main suite ounit-2.2.7/test/lwt/testRunnerProcesses/000077500000000000000000000000001440660116100205045ustar00rootroot00000000000000ounit-2.2.7/test/lwt/testRunnerProcesses/dune000066400000000000000000000003101440660116100213540ustar00rootroot00000000000000(test (name testRunnerProcesses) (package ounit2-lwt) (deps test.txt) (libraries ounit2 lwt lwt.unix ounit2-lwt) (enabled_if (<> %{os_type} Win32)) (action (run %{test} -runner processes))) ounit-2.2.7/test/lwt/testRunnerProcesses/test.txt000066400000000000000000000000201440660116100222140ustar00rootroot00000000000000this is a test. ounit-2.2.7/test/lwt/testRunnerProcesses/testRunnerProcesses.ml000066400000000000000000000007711440660116100251030ustar00rootroot00000000000000open OUnit2 let test = OUnitTest.TestCase (OUnitTest.Short, let open Lwt.Infix in OUnitLwt.lwt_wrapper (fun _ctxt -> Lwt_io.open_file ~mode:Lwt_io.Input "test.txt" >>= fun channel -> Lwt_io.read_char channel >|= fun _ -> ())) let test = (* Running a lot of tests in parallel allows to check for race conditions * see bug OF#1765 *) "testRunnerProcesses" >::: (Array.to_list (Array.make 50 test)) let () = run_test_tt_main test ounit-2.2.7/test/test.ml000066400000000000000000000054231440660116100151530ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 let () = run_test_tt_main ("OUnit" >::: [ OUnit.ounit2_of_ounit1 TestOUnit1.tests; TestOUnit2.tests; TestConf.tests; TestOUnitTest.tests; TestOUnitAssert.tests; TestOUnitDiff.tests; TestOtherTests.tests; TestRunner.tests; TestShared.tests; TestOUnitBracket.tests; TestOUnitChooser.tests; TestOtherTests.test_assert_code_position; ]) ounit-2.2.7/test/test_byte/000077500000000000000000000000001440660116100156405ustar00rootroot00000000000000ounit-2.2.7/test/test_byte/dune000066400000000000000000000001661440660116100165210ustar00rootroot00000000000000(test (name test_byte) (libraries ounit2 ounit2.advanced str libtest) (package ounit2) (modes exe shared_object)) ounit-2.2.7/test/test_byte/test_byte.ml000066400000000000000000000047241440660116100202030ustar00rootroot00000000000000(**************************************************************************) (* The OUnit library *) (* *) (* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *) (* Copyright (C) 2010 OCamlCore SARL *) (* Copyright (C) 2013 Sylvain Le Gall *) (* *) (* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL *) (* and Sylvain Le Gall. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining *) (* a copy of this document and the OUnit software ("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 Maas-Maarten Zeeman 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. *) (* *) (* See LICENSE.txt for details. *) (**************************************************************************) open OUnit2 let () = run_test_tt_main ("OUnitByte" >::: [ TestOtherTests.test_assert_code_position; ])