├── .github └── workflows │ └── workflow.yml ├── .gitignore ├── ChangeLog ├── LICENSE ├── README.md ├── dune-project ├── js ├── dune ├── webtest_js.ml └── webtest_js.mli ├── lib ├── dune ├── webtest.ml └── webtest.mli ├── test ├── common │ ├── dune │ ├── test_assert.ml │ ├── test_async.ml │ ├── test_sync.ml │ └── test_utils.ml ├── common_js │ ├── dune │ └── test_js.ml ├── dune ├── helpers │ ├── firefox_test_page.html │ ├── run_firefox_tests.py │ └── run_tests.sh ├── run_tests_browser.ml ├── run_tests_nodejs.ml └── run_tests_ocaml.ml ├── webtest-js.opam └── webtest.opam /.github/workflows/workflow.yml: -------------------------------------------------------------------------------- 1 | name: Main workflow 2 | 3 | on: 4 | - pull_request 5 | - push 6 | 7 | jobs: 8 | build: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - ubuntu-latest 14 | ocaml-compiler: 15 | - 4.12.x 16 | - 4.11.x 17 | - 4.10.x 18 | - 4.9.x 19 | - 4.8.x 20 | - 4.7.x 21 | 22 | runs-on: ${{ matrix.os }} 23 | 24 | steps: 25 | - name: Checkout code 26 | uses: actions/checkout@v2 27 | 28 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 29 | uses: ocaml/setup-ocaml@v2 30 | with: 31 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 32 | 33 | - run: opam install . --deps-only --with-doc --with-test 34 | 35 | - run: opam exec -- dune build 36 | 37 | - run: opam exec -- dune runtest 38 | 39 | - name: Install nodejs 40 | run: sudo apt install nodejs 41 | 42 | - name: Set up Python 3.8.2 43 | uses: actions/setup-python@v2 44 | with: 45 | python-version: 3.8.2 46 | 47 | - name: Install selenium 48 | run: pip install selenium==3.141.0 49 | 50 | - name: Run extra tests 51 | run: ./test/helpers/run_tests.sh 52 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .merlin 3 | geckodriver.log 4 | 5 | *.swp 6 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 2.0.0 (16-May-2020): 2 | * Convert build to dune 3 | * Split into two opam packages, webtest and webtest-js 4 | 5 | 1.2.0 (02-Jul-2017): 6 | * Convert to js_of_ocaml 3.0.0 7 | 8 | 1.1.0 (31-Mar-2017): 9 | * Add support for running a test suite under nodejs 10 | * Add logging of test run times 11 | 12 | 1.0.2 (16-Jan-2017): 13 | * Add internal modules to installed package 14 | 15 | 1.0.1 (15-Jan-2017): 16 | * Add support for custom equality functions in assert_equal 17 | 18 | 1.0.0 (02-Nov-2016): 19 | * first public release 20 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (C) 2016 John Else 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights to 6 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 7 | of the Software, and to permit persons to whom the Software is furnished to do 8 | so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ocaml-webtest 2 | ============= 3 | 4 | [![Build status](https://github.com/johnelse/ocaml-webtest/actions/workflows/workflow.yml/badge.svg)](https://github.com/johnelse/ocaml-webtest/actions) 5 | [![API reference](https://img.shields.io/badge/docs-API_reference-blue.svg)](https://johnelse.github.io/ocaml-webtest) 6 | 7 | A unit test framework, fully compatible with 8 | [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml), and written with 9 | in-browser testing of JavaScript code in mind. 10 | 11 | Heavily influenced by [oUnit](http://ounit.forge.ocamlcore.org/). 12 | 13 | You may find this helpful if you want to 14 | 15 | * test OCaml bindings to a JavaScript library 16 | * write tests for a JavaScript library compiled from OCaml 17 | 18 | You could even use this library to test normal OCaml code, but in that case 19 | you're probably better off just using oUnit for the extra features it provides. 20 | 21 | ## Library contents 22 | 23 | `ocaml-webtest` consists of two libraries: 24 | 25 | * `webtest` 26 | 27 | This has no dependencies, and contains code for creating tests and suites. 28 | 29 | * `webtest-js` 30 | 31 | This depends on `js_of_ocaml`, and contains code used for running tests in a 32 | browser. 33 | 34 | ## Creating test suites 35 | 36 | `ocaml-webtest` supports two kinds of test cases - synchronous and asynchronous. 37 | 38 | Both kinds of test cases can use the assertion functions `assert_true`, 39 | `assert_equal` and `assert_raises` to check for expected behaviour. 40 | 41 | Synchronous test cases are functions of type `unit -> unit`, and in order to 42 | pass should return cleanly without throwing an exception. 43 | 44 | Some examples of simple synchronous test cases: 45 | 46 | ``` 47 | let sync_test1 () = Webtest.Suite.assert_equal (get_five ()) 5 48 | 49 | let sync_test2 () = Webtest.Suite.assert_true (get_value ()) 50 | 51 | let sync_test3 () = Webtest.Suite.assert_raises MyExn (exception_thrower ()) 52 | ``` 53 | 54 | Asynchronous test cases are functions of type 55 | `((unit -> unit) -> unit) -> unit`. When run they are passed a wrapper function 56 | which must be used to wrap any asynchronous code which should be triggered as 57 | part of the test. In order to pass, an asynchronous test case should not only 58 | return cleanly, it should also make sure that the wrapped code runs 59 | successfully. Asynchronous test cases can be used to check that an event handler 60 | associated with a JavaScript object has been called. 61 | 62 | An example of an asynchronous test case: 63 | 64 | ``` 65 | let async_test wrapper = 66 | let js_object = create_object () in 67 | 68 | js_object##onclose := 69 | Dom_html.handler (fun _ -> 70 | wrapper (fun () -> 71 | assert_true "Object has been closed" (is_closed js_object)); 72 | Js._false); 73 | 74 | js_object##close 75 | ``` 76 | 77 | If you don't need to perform any assertions in the asynchronous code but just 78 | need to check that a handler fired, you can call the wrapper function with 79 | `Async.noop`, which is just an alias for `fun () -> ()`. 80 | 81 | Synchronous and asynchronous test cases can be combined into suites using the 82 | functions `>::`, `>:~` and `>:::` - for example: 83 | 84 | ``` 85 | open Webtest.Suite 86 | 87 | let suite = 88 | "suite" >::: [ 89 | "sync_test1" >:: sync_test1; 90 | "sync_test2" >:: sync_test2; 91 | "sync_test3" >:: sync_test3; 92 | "async_test" >:~ async_test; 93 | ] 94 | ``` 95 | 96 | ## In-browser testing 97 | 98 | Once you've created a suite, you can integrate it into an HTML document using 99 | `Webtest_js.Runner.setup`: 100 | 101 | ``` 102 | let () = Webtest_js.Runner.setup suite 103 | ``` 104 | 105 | This will create the global JavaScript object `webtest` which exposes a simple 106 | API for running the test suite. 107 | 108 | * `webtest.run` is a function with no arguments - calling it will run the test 109 | suite. 110 | * `webtest.finished` is a boolean indicating whether the suite run has finished. 111 | * `webtest.passed` is a boolean indicating whether all the tests passed. 112 | * `webtest.log` contains the log produced by running the tests. 113 | 114 | This API can be used by browser automation tools such as 115 | [Selenium WebDriver](http://www.seleniumhq.org/projects/webdriver/). For an 116 | example implementation in Python, see [test_driver.py](test/test_driver.py). 117 | 118 | A "known good" setup for automating browser tests is: 119 | 120 | * Firefox 89 121 | * Python 3.8.5 with version 3.141.0 of the Selenium bindings 122 | * geckodriver 0.29.1 123 | * Xvfb (optional, unless running on a headless machine) 124 | 125 | ## Examples 126 | 127 | `ocaml-webtest` tests itself in both OCaml 128 | ([run_tests_ocaml.ml](test/run_tests_ocaml.ml)), in JavaScript 129 | ([run_tests_browser.ml](test/run_tests_browser.ml)) and in Node.js 130 | ([run_tests_nodejs.ml](test/run_tests_nodejs.ml)). 131 | 132 | For a more real-world example, see 133 | [ocaml-webaudio](https://github.com/johnelse/ocaml-webaudio). 134 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1) 2 | -------------------------------------------------------------------------------- /js/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name webtest_js) 3 | (public_name webtest-js) 4 | (wrapped false) 5 | (modules webtest_js) 6 | (preprocess (pps js_of_ocaml-ppx)) 7 | (libraries js_of_ocaml webtest)) 8 | -------------------------------------------------------------------------------- /js/webtest_js.ml: -------------------------------------------------------------------------------- 1 | open Js_of_ocaml 2 | 3 | module Runner = struct 4 | let paint color string = match color with 5 | | `Red -> "\027[31m" ^ string ^ "\027[0m" 6 | | `Green -> "\027[32m" ^ string ^ "\027[0m" 7 | | `Yellow -> "\027[33m" ^ string ^ "\027[0m" 8 | | _ -> string 9 | 10 | let colored_string_of_result r = 11 | let s = Webtest.Suite.string_of_result r in 12 | let c = match r with 13 | | Webtest.Suite.Error _ -> `Yellow 14 | | Webtest.Suite.Fail _ -> `Red 15 | | Webtest.Suite.Pass -> `Green 16 | in 17 | paint c s 18 | 19 | let show v = 20 | Printf.kprintf 21 | (fun b -> Firebug.console##info (Js.string b)) 22 | v 23 | 24 | let run ?(with_colors=true) suite = 25 | let open Webtest.Suite in 26 | let open Webtest.Utils in 27 | run 28 | suite (fun {log=_; outcomes} -> 29 | show "Tests results:"; 30 | let raw_summary = summarise_raw outcomes in 31 | List.iter 32 | (fun {label; result; time_s} -> 33 | let sresult = 34 | if with_colors 35 | then colored_string_of_result result 36 | else string_of_result result 37 | in 38 | show "Test %s ... %s (took %.4fs)" label sresult time_s) 39 | outcomes; 40 | let test_result = 41 | if raw_summary.passed 42 | then paint `Green "Pass" 43 | else paint `Red "Failed" in 44 | show ""; 45 | show 46 | "Test result: %s. %d in total; %d passed; %d failed; %d errored." 47 | test_result raw_summary.total raw_summary.passes 48 | raw_summary.failures raw_summary.errors; 49 | exit (if raw_summary.passed then 0 else 1)) 50 | 51 | let install_webtest suite = 52 | let webtest = Js.Unsafe.obj [||] in 53 | webtest##.finished := Js._false; 54 | webtest##.log := Js.string ""; 55 | webtest##.passed := Js._false; 56 | webtest##.run := Js.wrap_callback 57 | (fun () -> 58 | let open Webtest in 59 | Utils.run suite (fun {Utils.log; outcomes} -> 60 | let {Utils.report; passed} = Utils.summarise outcomes in 61 | webtest##.log := Js.string ((String.concat "\n" log) ^ "\n" ^ report); 62 | webtest##.passed := if passed then Js._true else Js._false; 63 | webtest##.finished := Js._true)); 64 | Js.Unsafe.global##.webtest := webtest 65 | 66 | let setup suite = 67 | let module Html = Dom_html in 68 | Html.window##.onload := Html.handler 69 | (fun _ -> 70 | let () = install_webtest suite in 71 | Js._false) 72 | end 73 | -------------------------------------------------------------------------------- /js/webtest_js.mli: -------------------------------------------------------------------------------- 1 | (** Library for in-browser testing, dependent on js_of_ocaml. *) 2 | 3 | (** Types and functions for running tests in a browser. *) 4 | module Runner : sig 5 | 6 | val setup : Webtest.Suite.t -> unit 7 | (** [setup test] sets up a test runner and attaches it to the document's onLoad 8 | handler. *) 9 | 10 | val run : ?with_colors:bool -> Webtest.Suite.t -> unit 11 | (** [run suite] runs tests and displays results on stdout *) 12 | end 13 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name webtest) 3 | (public_name webtest) 4 | (wrapped false) 5 | (modules webtest)) 6 | -------------------------------------------------------------------------------- /lib/webtest.ml: -------------------------------------------------------------------------------- 1 | module Suite = struct 2 | exception TestFailure of string 3 | 4 | type result = 5 | | Error of exn 6 | | Fail of string 7 | | Pass 8 | 9 | type outcome = { 10 | label: string; 11 | result: result; 12 | time_s: float; 13 | } 14 | 15 | let string_of_result = function 16 | | Error e -> Printf.sprintf "Error: %s" (Printexc.to_string e) 17 | | Fail msg -> Printf.sprintf "Fail: %s" msg 18 | | Pass -> "Pass" 19 | 20 | let finally f cleanup = 21 | let result = 22 | try f () 23 | with e -> 24 | cleanup (); 25 | raise e 26 | in 27 | cleanup (); 28 | result 29 | 30 | module Sync = struct 31 | type test_fun = unit -> unit 32 | 33 | let bracket setup test teardown () = 34 | let state = setup () in 35 | finally 36 | (fun () -> test state) 37 | (fun () -> teardown state) 38 | end 39 | 40 | module Async = struct 41 | type callback = unit -> unit 42 | let noop () = () 43 | 44 | type wrapper = callback -> unit 45 | type test_fun = wrapper -> unit 46 | 47 | let bracket setup test teardown = 48 | (fun wrapper -> 49 | let state = setup () in 50 | let wrapper' f = 51 | wrapper (fun () -> finally f (fun () -> teardown state)) in 52 | try 53 | test state wrapper' 54 | with e -> 55 | teardown state; 56 | raise e) 57 | 58 | let run_one label test log handle_outcome = 59 | (* Make sure we only handle one result per test. This prevents a successful 60 | callback from triggering a continuation of the tests if the synchronous 61 | code has already failed or errored. *) 62 | let handled = ref false in 63 | let start_time = ref 0.0 in 64 | let handle_result_once result = 65 | if not !handled 66 | then begin 67 | handled := true; 68 | log "End"; 69 | log (string_of_result result); 70 | handle_outcome {label; result; time_s = Sys.time () -. !start_time} 71 | end 72 | in 73 | let catch_all f = 74 | try f () 75 | with 76 | | TestFailure msg -> handle_result_once (Fail msg) 77 | | e -> handle_result_once (Error e) 78 | in 79 | (* This catch_all will catch failures and errors coming from the 80 | synchronous part of the test case, i.e. before the callback has been 81 | triggered. *) 82 | catch_all (fun () -> 83 | log "Start"; 84 | start_time := Sys.time (); 85 | test 86 | (fun callback -> 87 | (* This catch_all will catch failures and errors coming from the 88 | asynchronous callback. *) 89 | catch_all (fun () -> 90 | callback (); 91 | handle_result_once Pass))) 92 | 93 | let of_sync test wrapper = 94 | test (); 95 | wrapper noop 96 | end 97 | 98 | type t = 99 | | TestCase of string * Async.test_fun 100 | | TestList of string * t list 101 | 102 | let (>::) label test_fun = TestCase (label, Async.of_sync test_fun) 103 | let (>:~) label test_fun = TestCase (label, test_fun) 104 | let (>:::) label tests = TestList (label, tests) 105 | 106 | let string_of_opt = function 107 | | Some value -> Printf.sprintf " (%s)" value 108 | | None -> "" 109 | 110 | let assert_true ?label value = 111 | if not value then begin 112 | let msg = Printf.sprintf "test value was false%s" (string_of_opt label) in 113 | raise (TestFailure msg) 114 | end 115 | 116 | let assert_equal ?(equal = (=)) ?label ?printer a b = 117 | if not (equal a b) 118 | then begin 119 | let values = match printer with 120 | | Some printer -> Printf.sprintf ": %s %s" (printer a) (printer b) 121 | | None -> "" 122 | in 123 | let msg = Printf.sprintf "not equal%s%s" (string_of_opt label) values in 124 | raise (TestFailure msg) 125 | end 126 | 127 | let assert_raises ?label expected_exn task = 128 | match 129 | try task (); None 130 | with raised_exn -> Some raised_exn 131 | with 132 | | None -> 133 | let msg = 134 | Printf.sprintf 135 | "expected exception not raised%s" (string_of_opt label) 136 | in 137 | raise (TestFailure msg) 138 | | Some raised_exn when raised_exn = expected_exn -> () 139 | | Some raised_exn -> 140 | let msg = 141 | Printf.sprintf 142 | "unexpected exception raised%s: %s" 143 | (string_of_opt label) 144 | (Printexc.to_string raised_exn) 145 | in 146 | raise (TestFailure msg) 147 | 148 | let assert_raises_string ?label expected_exn_string task = 149 | match 150 | try task (); None 151 | with raised_exn -> Some raised_exn 152 | with 153 | | None -> 154 | let msg = 155 | Printf.sprintf 156 | "expected exception not raised%s" (string_of_opt label) 157 | in 158 | raise (TestFailure msg) 159 | | Some raised_exn 160 | when (Printexc.to_string raised_exn) = expected_exn_string -> () 161 | | Some raised_exn -> 162 | let msg = 163 | Printf.sprintf 164 | "unexpected exception raised%s: %s" 165 | (string_of_opt label) 166 | (Printexc.to_string raised_exn) 167 | in 168 | raise (TestFailure msg) 169 | end 170 | 171 | module Zipper = struct 172 | type crumb = { 173 | left: Suite.t list; 174 | label: string; 175 | right: Suite.t list; 176 | } 177 | 178 | type t = { 179 | crumbs: crumb list; 180 | location: Suite.t; 181 | } 182 | 183 | let of_suite suite = { 184 | crumbs = []; 185 | location = suite; 186 | } 187 | 188 | let to_suite {location; _} = location 189 | 190 | let move_up {crumbs; location} = 191 | match crumbs with 192 | (* Already at the top of the tree, so nowhere to go. *) 193 | | [] -> None 194 | (* Move to the head of the list of crumbs. *) 195 | | {left; label; right} :: other_crumbs -> Some { 196 | crumbs = other_crumbs; 197 | location = 198 | Suite.TestList (label, List.rev_append (location :: left) right); 199 | } 200 | 201 | let move_down {crumbs; location} = 202 | match location with 203 | (* A TestCase has no children. *) 204 | | Suite.TestCase _ -> None 205 | (* A TestList may not have any children to move down to. *) 206 | | Suite.TestList (_, []) -> None 207 | (* Move down to the first child of the TestList. *) 208 | | Suite.TestList (label, first_child :: other_children) -> Some { 209 | crumbs = { 210 | left = []; 211 | label; 212 | right = other_children; 213 | } :: crumbs; 214 | location = first_child; 215 | } 216 | 217 | let move_right {crumbs; location} = 218 | match crumbs with 219 | (* At the top of the tree, so no siblings. *) 220 | | [] -> None 221 | (* Already at the rightmost sibling. *) 222 | | {right = []; _} :: _ -> None 223 | (* Move to the next sibling to the right. *) 224 | | {left; label; right = first_right :: other_right} :: other_crumbs -> Some { 225 | crumbs = { 226 | left = location :: left; 227 | label; 228 | right = other_right; 229 | } :: other_crumbs; 230 | location = first_right; 231 | } 232 | 233 | let rec next_sibling zipper = 234 | match move_right zipper with 235 | (* Move to the next sibling to the right. *) 236 | | (Some _) as result -> result 237 | (* No more siblings, so try to move up. *) 238 | | None -> begin 239 | match move_up zipper with 240 | (* If moving up succeeds, try moving right again. *) 241 | | Some zipper' -> next_sibling zipper' 242 | (* We can't move up, so we must be at the top of the tree. *) 243 | | None -> None 244 | end 245 | 246 | let next_location zipper = 247 | match move_down zipper with 248 | | Some _ as result -> result 249 | | None -> next_sibling zipper 250 | 251 | let get_labels {crumbs; location} = 252 | let location_label = match location with 253 | | Suite.TestCase (label, _) -> label 254 | | Suite.TestList (label, _) -> label 255 | in 256 | location_label :: (List.map (fun crumb -> crumb.label) crumbs) |> List.rev 257 | end 258 | 259 | module Utils = struct 260 | type output = { 261 | log: string list; 262 | outcomes: Suite.outcome list; 263 | } 264 | 265 | type raw_summary = { 266 | total: int; 267 | errors: int; 268 | failures: int; 269 | passes: int; 270 | passed: bool 271 | } 272 | 273 | type summary = { 274 | report: string; 275 | passed: bool; 276 | } 277 | 278 | let run suite callback = 279 | let log = ref [] in 280 | let log_with_prefix prefix msg = 281 | let line = Printf.sprintf "%s:%s" prefix msg in 282 | log := (line :: !log) 283 | in 284 | let zipper = Zipper.of_suite suite in 285 | let rec run' ({Zipper.location; _} as zipper) outcomes = 286 | let continue zipper outcomes' = 287 | match Zipper.next_location zipper with 288 | | Some zipper' -> run' zipper' outcomes' 289 | | None -> 290 | callback { 291 | log = List.rev !log; 292 | outcomes = List.rev outcomes' 293 | } 294 | in 295 | match location with 296 | | Suite.TestCase (_, test_fun) -> 297 | let prefix = Zipper.get_labels zipper |> String.concat ":" in 298 | let log = log_with_prefix prefix in 299 | Suite.Async.run_one 300 | prefix test_fun log 301 | (fun outcome -> continue zipper (outcome :: outcomes)) 302 | | Suite.TestList (_, _) -> continue zipper outcomes 303 | in 304 | run' zipper [] 305 | 306 | let summarise_raw outcomes = 307 | let total, errors, failures, passes = 308 | List.fold_left 309 | (fun (total, errors, failures, passes) outcome -> 310 | let open Suite in 311 | match outcome.result with 312 | | Error _ -> total + 1, errors + 1, failures, passes 313 | | Fail _ -> total + 1, errors, failures + 1, passes 314 | | Pass -> total + 1, errors, failures, passes + 1) 315 | (0, 0, 0, 0) outcomes 316 | in 317 | { 318 | total; errors; failures; passes; 319 | passed = (total = passes) 320 | } 321 | 322 | let summary_of_raw raw = 323 | let report = 324 | String.concat "\n" 325 | [ 326 | Printf.sprintf "%d tests run" raw.total; 327 | Printf.sprintf "%d errors" raw.errors; 328 | Printf.sprintf "%d failures" raw.failures; 329 | Printf.sprintf "%d passes" raw.passes; 330 | ] 331 | in 332 | { 333 | report; 334 | passed = raw.passed; 335 | } 336 | 337 | let summarise outcomes = 338 | summarise_raw outcomes 339 | |> summary_of_raw 340 | end 341 | -------------------------------------------------------------------------------- /lib/webtest.mli: -------------------------------------------------------------------------------- 1 | (** Dependency-free library for creating and running tests. *) 2 | 3 | (** Types and functions for creating and structuring unit test suites. *) 4 | module Suite : sig 5 | 6 | exception TestFailure of string 7 | (** The exception thrown by failing tests. *) 8 | 9 | type result = 10 | | Error of exn (** An unexpected error occurred in the test. *) 11 | | Fail of string (** An assertion failed in the test. *) 12 | | Pass (** The test passed. *) 13 | (** The result of running a single testcase. *) 14 | 15 | type outcome = { 16 | label: string; 17 | result: result; 18 | time_s: float; 19 | } 20 | (** The outcome of a test: its label, result, and time taken to run.*) 21 | 22 | val string_of_result : result -> string 23 | 24 | module Sync : sig 25 | type test_fun = unit -> unit 26 | (** A synchronous test function. *) 27 | 28 | val bracket : (unit -> 'a) -> ('a -> unit) -> ('a -> unit) -> test_fun 29 | (** [bracket setup test teardown] generates a {{:#TYPEtest_fun}test_fun} 30 | which will use [setup] to create state needed for the test, then pass 31 | that state to [test], and finally will pass that state to [teardown]. *) 32 | end 33 | 34 | module Async : sig 35 | type callback = unit -> unit 36 | (** The type of an asynchronous callback which will run as part of an 37 | asynchronous test. *) 38 | 39 | val noop : callback 40 | (** The noop callback - this is just an alias for [fun () -> ()]. *) 41 | 42 | type wrapper = callback -> unit 43 | (** A wrapper function to be passed to an asynchronous test. *) 44 | 45 | type test_fun = wrapper -> unit 46 | (** An asynchronous test function. When run it will be passed a wrapper 47 | function - this should be used to wrap any asynchronous code which the 48 | test case is expected to run. *) 49 | 50 | val bracket : 51 | (unit -> 'a) -> ('a -> wrapper -> unit) -> ('a -> unit) -> test_fun 52 | (** [bracket setup test teardown] generates a {{:#TYPEtest_fun}test_fun} 53 | which will use [setup] to create state needed for the test, then pass 54 | that state to [test], and finally will pass that state to [teardown]. *) 55 | 56 | val run_one : 57 | string -> test_fun -> (string -> unit ) -> (outcome -> unit) -> unit 58 | (** Run an asynchronous test and pass its result to a callback. *) 59 | 60 | val of_sync : Sync.test_fun -> test_fun 61 | (** Convert a synchronous test into an asynchronous test. *) 62 | end 63 | 64 | type t = 65 | | TestCase of string * Async.test_fun (** A labelled single test. *) 66 | | TestList of string * t list (** A labelled list of tests. *) 67 | (** A labelled wrapper around a test or list of suites. *) 68 | 69 | val (>::) : string -> Sync.test_fun -> t 70 | (** Convenience function to create a suite from a label and a 71 | {{:Webtest.Suite.Sync.html#TYPEtest_fun}Sync.test_fun}. *) 72 | 73 | val (>:~) : string -> Async.test_fun -> t 74 | (** Convenience function to create a suite from a label and an 75 | {{:Webtest.Suite.Async.html#TYPEtest_fun}Async.test_fun}. *) 76 | 77 | val (>:::) : string -> t list -> t 78 | (** Convenience function to create a suite from a label and a list of 79 | suites. *) 80 | 81 | val assert_true : ?label:string -> bool -> unit 82 | (** [assert_bool label value] returns unit if [value] is true, and otherwise 83 | raises {{:#EXCEPTIONTestFailure}TestFailure}. *) 84 | 85 | val assert_equal : 86 | ?equal:('a -> 'a -> bool) -> ?label:string -> 87 | ?printer:('a -> string) -> 'a -> 'a -> unit 88 | (** [assert_equal a b] returns unit if [a] is equal to [b], and otherwise 89 | raises {{:#EXCEPTIONTestFailure}TestFailure}. *) 90 | 91 | val assert_raises : ?label:string -> exn -> (unit -> unit) -> unit 92 | (** [assert_raises e task] returns unit if [task ()] raises [e], and otherwise 93 | raises {{:#EXCEPTIONTestFailure}TestFailure}. *) 94 | 95 | val assert_raises_string : ?label:string -> string -> (unit -> unit) -> unit 96 | (** [assert_raises_string str task] returns unit if [task ()] raises an 97 | exception [e] for which [Printexc.to_string e = str], and otherwise 98 | raises {{:#EXCEPTIONTestFailure}TestFailure}. *) 99 | end 100 | 101 | (** A zipper implementation based on {{:Webtest.Suite.html#TYPEt}Suite.t}, which 102 | represents the current location in the tree as well as the path used to 103 | reach the current location from the root. 104 | 105 | Generally this module should not be used directly; instead 106 | {{:Webtest.Utils.html#VALrun}Utils.run} can be used to traverse the test 107 | tree and report results. *) 108 | module Zipper : sig 109 | 110 | type crumb = { 111 | left: Suite.t list; 112 | (** The list of siblings to the left of the current location. *) 113 | label: string; 114 | (** The label of the parent of the current location. *) 115 | right: Suite.t list; 116 | (** The list of siblings to the right of the current location. *) 117 | } 118 | (** A type representing the path through a 119 | {{:Webtest.Suite.html#TYPEt}Webtest.Suite.t} from the root to the current 120 | location. *) 121 | 122 | type t = { 123 | crumbs: crumb list; 124 | (** The list of crumbs which leads to the current location in the tree. *) 125 | location: Suite.t; 126 | (** The current location in the tree. *) 127 | } 128 | (** A zipper implementation based on {{:Webtest.Suite.html#TYPEt}Suite.t}. *) 129 | 130 | val of_suite : Suite.t -> t 131 | (** Convert a {{:Webtest.Suite.html#TYPEt}Suite.t} into a 132 | {{:#TYPEt}Zipper.t}. *) 133 | 134 | val to_suite : t -> Suite.t 135 | (** Convert a {{:#TYPEt}Zipper.t} into a {{:Webtest.Suite.html#TYPEt}Suite.t}. 136 | Note that this does not include the crumbs, only the subtree at the 137 | current location. *) 138 | 139 | val move_up : t -> t option 140 | (** Attempt to move up to the parent node. *) 141 | 142 | val move_down : t -> t option 143 | (** Attempt to move down to the first child node. *) 144 | 145 | val move_right : t -> t option 146 | (** Attempt to move right to the next sibling. *) 147 | 148 | val next_location : t -> t option 149 | (** Attempt to move to the next location while traversing the tree. Return 150 | None if we're already at the last location to be traversed. *) 151 | 152 | val get_labels : t -> string list 153 | (** Get the list of labels from all crumbs plus that of the current 154 | location, starting at the root of the tree. *) 155 | end 156 | 157 | (** Types and functions for running unit tests. *) 158 | module Utils : sig 159 | 160 | type output = { 161 | log: string list; (** The logging produced while running the 162 | tests. *) 163 | outcomes: Suite.outcome list; (** The results of running the tests. *) 164 | } 165 | (** The output generated by running a test. *) 166 | 167 | type raw_summary = { 168 | total: int; 169 | errors: int; 170 | failures: int; 171 | passes: int; 172 | passed: bool 173 | } 174 | (** Raw summary of test run with the total number of tests, and 175 | failed/passed tests. *) 176 | 177 | type summary = { 178 | report: string; (** A report summarising the test results. *) 179 | passed: bool; (** A flag indicating whether all the tests 180 | passed. *) 181 | } 182 | (** A summary of a test run: short description of results plus a flag 183 | indicating whether all the tests passed. *) 184 | 185 | val run : Suite.t -> (output -> unit) -> unit 186 | (** [run suite callback] runs [suite], passes the output to [callback]. *) 187 | 188 | val summarise_raw : Suite.outcome list -> raw_summary 189 | (** [summarise outcomes] converts a list of test outcomes into a raw 190 | summary. *) 191 | 192 | val summary_of_raw : raw_summary -> summary 193 | (** [summary_of_raw] creates a basic summary from a raw summary. *) 194 | 195 | val summarise : Suite.outcome list -> summary 196 | (** [summarise outcomes] converts a list of test outcomes into a summary. *) 197 | end 198 | -------------------------------------------------------------------------------- /test/common/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name test_common) 3 | (modules test_assert test_async test_sync test_utils) 4 | (wrapped false) 5 | (libraries webtest)) 6 | -------------------------------------------------------------------------------- /test/common/test_assert.ml: -------------------------------------------------------------------------------- 1 | (* Test the assert functions. *) 2 | 3 | open Webtest.Suite 4 | 5 | exception MyException of int 6 | 7 | let test_assert_true_ok () = 8 | assert_true ~label:"should pass" true 9 | 10 | let test_assert_true_fail () = 11 | try 12 | assert_true ~label:"test_bool" false; 13 | failwith "assert_true should have failed" 14 | with TestFailure "test value was false (test_bool)" -> () 15 | 16 | let test_assert_equal_ok () = 17 | assert_equal 5 5 18 | 19 | let test_assert_equal_fail () = 20 | try 21 | assert_equal 5 6; 22 | failwith "assert_equal should have failed" 23 | with TestFailure "not equal" -> () 24 | 25 | let test_assert_equal_label () = 26 | try 27 | assert_equal ~label:"assert_equal" 5 6; 28 | failwith "assert_equal should have failed" 29 | with TestFailure "not equal (assert_equal)" -> () 30 | 31 | let test_assert_equal_printer () = 32 | try 33 | assert_equal ~printer:string_of_int 5 6; 34 | failwith "assert_equal should have failed" 35 | with TestFailure "not equal: 5 6" -> () 36 | 37 | let test_assert_equal_label_printer () = 38 | try 39 | assert_equal ~label:"assert_equal" ~printer:string_of_int 5 6; 40 | failwith "assert_equal should have failed" 41 | with TestFailure "not equal (assert_equal): 5 6" -> () 42 | 43 | let equal_float a b = abs_float (a -. b) < 0.01 44 | 45 | let test_assert_custom_equal_ok () = 46 | assert_equal ~equal:equal_float 5.0 5.001 47 | 48 | let test_assert_custom_equal_fail () = 49 | try 50 | assert_equal ~equal:equal_float 5.0 6.0; 51 | failwith "assert_equal should have failed" 52 | with TestFailure "not equal" -> () 53 | 54 | let test_assert_raises_ok () = 55 | assert_raises (MyException 0) (fun () -> raise (MyException 0)) 56 | 57 | let test_assert_raises_no_exn () = 58 | try assert_raises (MyException 0) (fun () -> ()) 59 | with TestFailure "expected exception not raised" -> () 60 | 61 | let test_assert_raises_wrong_exn () = 62 | try assert_raises (MyException 0) (fun () -> raise (MyException 1)) 63 | with 64 | | TestFailure "unexpected exception raised: Test_assert.MyException(1)" -> () 65 | 66 | let test_assert_raises_no_exn_label () = 67 | try 68 | assert_raises ~label:"assert_raises" (MyException 0) (fun () -> ()) 69 | with 70 | | TestFailure "expected exception not raised (assert_raises)" -> () 71 | 72 | let test_assert_raises_wrong_exn_label () = 73 | try 74 | assert_raises 75 | ~label:"assert_raises" 76 | (MyException 0) 77 | (fun () -> raise (MyException 1)) 78 | with 79 | | TestFailure 80 | "unexpected exception raised (assert_raises): Test_assert.MyException(1)" 81 | -> () 82 | 83 | let test_assert_raises_string_ok () = 84 | assert_raises_string 85 | "Test_assert.MyException(0)" 86 | (fun () -> raise (MyException 0)) 87 | 88 | let test_assert_raises_string_no_exn () = 89 | try assert_raises_string "Test_assert.MyException(0)" (fun () -> ()) 90 | with TestFailure "expected exception not raised" -> () 91 | 92 | let test_assert_raises_string_wrong_exn () = 93 | try 94 | assert_raises_string 95 | "Test_assert.MyException(0)" 96 | (fun () -> raise (MyException 1)) 97 | with 98 | | TestFailure "unexpected exception raised: Test_assert.MyException(1)" -> () 99 | 100 | let suite = 101 | "assert" >::: [ 102 | "test_assert_true_ok" >:: test_assert_true_ok; 103 | "test_assert_true_fail" >:: test_assert_true_fail; 104 | "test_assert_equal_ok" >:: test_assert_equal_ok; 105 | "test_assert_equal_fail" >:: test_assert_equal_fail; 106 | "test_assert_equal_label" >:: test_assert_equal_label; 107 | "test_assert_equal_printer" >:: test_assert_equal_printer; 108 | "test_assert_equal_label_printer" >:: test_assert_equal_label_printer; 109 | "test_assert_custom_equal_ok" >:: test_assert_custom_equal_ok; 110 | "test_assert_custom_equal_fail" >:: test_assert_custom_equal_fail; 111 | "test_assert_raises_ok" >:: test_assert_raises_ok; 112 | "test_assert_raises_no_exn" >:: test_assert_raises_no_exn; 113 | "test_assert_raises_wrong_exn" >:: test_assert_raises_wrong_exn; 114 | "test_assert_raises_no_exn_label" >:: test_assert_raises_no_exn_label; 115 | "test_assert_raises_wrong_exn_label" >:: test_assert_raises_wrong_exn_label; 116 | "test_assert_raises_string_ok" >:: test_assert_raises_string_ok; 117 | "test_assert_raises_string_no_exn" >:: test_assert_raises_string_no_exn; 118 | "test_assert_raises_string_wrong_exn" >:: 119 | test_assert_raises_string_wrong_exn; 120 | ] 121 | -------------------------------------------------------------------------------- /test/common/test_async.ml: -------------------------------------------------------------------------------- 1 | (* Test handling of asynchronous test cases. *) 2 | 3 | open Test_utils 4 | open Webtest.Suite 5 | 6 | let test_wrapper wrapper = wrapper Async.noop 7 | 8 | let test_run_one_ok () = 9 | assert_equal 10 | (run_one_sync (fun wrapper -> wrapper Async.noop)) 11 | (Some Pass) 12 | 13 | let test_run_one_fail () = 14 | assert_equal 15 | (run_one_sync (fun _ -> assert_equal 5 6)) 16 | (Some (Fail "not equal")) 17 | 18 | let test_run_one_error () = 19 | assert_equal 20 | (run_one_sync (fun _ -> failwith "fail")) 21 | (Some (Error (Failure "fail"))) 22 | 23 | let test_run_one_fail_in_callback () = 24 | assert_equal 25 | (run_one_sync (fun wrapper -> wrapper (fun () -> assert_equal 5 6))) 26 | (Some (Fail "not equal")) 27 | 28 | let test_run_one_error_in_callback () = 29 | assert_equal 30 | (run_one_sync (fun wrapper -> wrapper (fun () -> failwith "fail"))) 31 | (Some (Error (Failure "fail"))) 32 | 33 | let test_of_sync_ok () = 34 | let async_test = Async.of_sync Async.noop in 35 | assert_equal 36 | (run_one_sync async_test) 37 | (Some Pass) 38 | 39 | let test_of_sync_fail () = 40 | let async_test = Async.of_sync (fun () -> assert_equal 5 6) in 41 | assert_equal 42 | (run_one_sync async_test) 43 | (Some (Fail "not equal")) 44 | 45 | let test_of_sync_error () = 46 | let async_test = Async.of_sync (fun () -> failwith "fail") in 47 | assert_equal 48 | (run_one_sync async_test) 49 | (Some (Error (Failure "fail"))) 50 | 51 | let test_bracket_ok () = 52 | let state = ref `uninitialised in 53 | let setup () = state := `test_start; state in 54 | let teardown state = 55 | assert_equal !state `test_end; 56 | state := `torn_down 57 | in 58 | let async_test = Async.bracket 59 | setup 60 | (fun state wrapper -> 61 | wrapper (fun () -> 62 | assert_equal !state `test_start; 63 | state := `test_end)) 64 | teardown 65 | in 66 | assert_equal 67 | (run_one_sync async_test) 68 | (Some Pass); 69 | assert_equal !state `torn_down 70 | 71 | let test_bracket_fail_in_sync () = 72 | let state = ref `uninitialised in 73 | let setup () = state := `test_start; state in 74 | let teardown state = 75 | state := `torn_down 76 | in 77 | let async_test = Async.bracket 78 | setup 79 | (fun _ _ -> assert_equal 5 6) 80 | teardown 81 | in 82 | assert_equal 83 | (run_one_sync async_test) 84 | (Some (Fail "not equal")); 85 | assert_equal !state `torn_down 86 | 87 | let test_bracket_fail_in_async () = 88 | let state = ref `uninitialised in 89 | let setup () = state := `test_start; state in 90 | let teardown state = 91 | state := `torn_down 92 | in 93 | let async_test = Async.bracket 94 | setup 95 | (fun _ wrapper -> wrapper (fun () -> assert_equal 5 6)) 96 | teardown 97 | in 98 | assert_equal 99 | (run_one_sync async_test) 100 | (Some (Fail "not equal")); 101 | assert_equal !state `torn_down 102 | 103 | exception TestException 104 | 105 | let test_bracket_error_in_sync () = 106 | let state = ref `uninitialised in 107 | let setup () = state := `test_start; state in 108 | let teardown state = 109 | state := `torn_down 110 | in 111 | let async_test = Async.bracket 112 | setup 113 | (fun _ _ -> raise TestException) 114 | teardown 115 | in 116 | assert_equal 117 | (run_one_sync async_test) 118 | (Some (Error TestException)); 119 | assert_equal !state `torn_down 120 | 121 | let test_bracket_error_in_async () = 122 | let state = ref `uninitialised in 123 | let setup () = state := `test_start; state in 124 | let teardown state = 125 | state := `torn_down 126 | in 127 | let async_test = Async.bracket 128 | setup 129 | (fun _ wrapper -> wrapper (fun () -> raise TestException)) 130 | teardown 131 | in 132 | assert_equal 133 | (run_one_sync async_test) 134 | (Some (Error TestException)); 135 | assert_equal !state `torn_down 136 | 137 | let suite = 138 | "async" >::: [ 139 | "test_wrapper" >:~ test_wrapper; 140 | "test_run_one_ok" >:: test_run_one_ok; 141 | "test_run_one_fail" >:: test_run_one_fail; 142 | "test_run_one_error" >:: test_run_one_error; 143 | "test_run_one_fail_in_callback" >:: test_run_one_fail_in_callback; 144 | "test_run_one_error_in_callback" >:: test_run_one_error_in_callback; 145 | "test_of_sync_ok" >:: test_of_sync_ok; 146 | "test_of_sync_fail" >:: test_of_sync_fail; 147 | "test_of_sync_error" >:: test_of_sync_error; 148 | "test_bracket_ok" >:: test_bracket_ok; 149 | "test_bracket_fail_in_sync" >:: test_bracket_fail_in_sync; 150 | "test_bracket_fail_in_async" >:: test_bracket_fail_in_async; 151 | "test_bracket_error_in_sync" >:: test_bracket_error_in_sync; 152 | "test_bracket_error_in_async" >:: test_bracket_error_in_async; 153 | ] 154 | -------------------------------------------------------------------------------- /test/common/test_sync.ml: -------------------------------------------------------------------------------- 1 | (* Test handling of synchronous test cases. *) 2 | 3 | open Webtest.Suite 4 | 5 | let test_bracket_succeed () = 6 | let state = ref `uninitialised in 7 | let setup () = state := `test_start; state in 8 | let teardown state = 9 | assert_equal !state `test_end; 10 | state := `torn_down 11 | in 12 | Sync.bracket 13 | setup 14 | (fun state -> 15 | assert_equal !state `test_start; 16 | state := `test_end) 17 | teardown (); 18 | assert_equal !state `torn_down 19 | 20 | let test_bracket_fail () = 21 | let state = ref `uninitialised in 22 | let setup () = state := `test_start; state in 23 | let teardown state = 24 | state := `torn_down 25 | in 26 | try 27 | Sync.bracket 28 | setup 29 | (fun state -> 30 | assert_equal !state `test_start; 31 | assert_equal 5 6) 32 | teardown (); 33 | with TestFailure "not equal" -> 34 | assert_equal !state `torn_down 35 | 36 | exception TestException 37 | let test_bracket_error () = 38 | let state = ref `uninitialised in 39 | let setup () = state := `test_start; state in 40 | let teardown state = 41 | state := `torn_down 42 | in 43 | try 44 | Sync.bracket 45 | setup 46 | (fun state -> 47 | assert_equal !state `test_start; 48 | raise TestException) 49 | teardown (); 50 | with TestException -> 51 | assert_equal !state `torn_down 52 | 53 | let suite = 54 | "sync" >::: [ 55 | "test_bracket_succeed" >:: test_bracket_succeed; 56 | "test_bracket_fail" >:: test_bracket_fail; 57 | "test_bracket_error" >:: test_bracket_error; 58 | ] 59 | -------------------------------------------------------------------------------- /test/common/test_utils.ml: -------------------------------------------------------------------------------- 1 | (* Common test helper functions. *) 2 | 3 | let run_one_sync async_test = 4 | let result_ref = ref None in 5 | Webtest.Suite.Async.run_one "" 6 | async_test 7 | (fun _ -> ()) 8 | (fun result -> result_ref := Some result); 9 | match !result_ref with 10 | | Some x -> Some x.Webtest.Suite.result 11 | | None -> None 12 | -------------------------------------------------------------------------------- /test/common_js/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name test_common_js) 3 | (modules test_js) 4 | (wrapped false) 5 | (libraries js_of_ocaml test_common webtest)) 6 | -------------------------------------------------------------------------------- /test/common_js/test_js.ml: -------------------------------------------------------------------------------- 1 | (* Javascript-specific tests. *) 2 | 3 | open Js_of_ocaml 4 | open Test_utils 5 | open Webtest.Suite 6 | 7 | let test_async_wrapper wrapper = 8 | let (_:Dom_html.timeout_id_safe) = 9 | Dom_html.setTimeout (fun () -> wrapper Async.noop) 0.5 in () 10 | 11 | let test_run_one_failure_in_sync_path () = 12 | assert_equal 13 | (run_one_sync (fun wrapper -> 14 | let (_:Dom_html.timeout_id_safe) = 15 | Dom_html.setTimeout (fun () -> wrapper Async.noop) 0.5 in 16 | 17 | assert_equal 5 6)) 18 | (Some (Fail "not equal")) 19 | 20 | let test_run_one_error_in_sync_path () = 21 | assert_equal 22 | (run_one_sync (fun wrapper -> 23 | let (_:Dom_html.timeout_id_safe) = 24 | Dom_html.setTimeout (fun () -> wrapper Async.noop) 0.5 in 25 | 26 | failwith "fail")) 27 | (Some (Error (Failure "fail"))) 28 | 29 | let suite = 30 | "js" >::: [ 31 | "test_async_wrapper" >:~ test_async_wrapper; 32 | "test_run_one_failure_in_sync_path" >:: test_run_one_failure_in_sync_path; 33 | "test_run_one_error_in_sync_path" >:: test_run_one_error_in_sync_path; 34 | ] 35 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name run_tests_ocaml) 3 | (modules run_tests_ocaml) 4 | (libraries test_common)) 5 | 6 | (executable 7 | (name run_tests_nodejs) 8 | (modes js) 9 | (modules run_tests_nodejs) 10 | (preprocess (pps js_of_ocaml-ppx)) 11 | (libraries test_common test_common_js webtest-js)) 12 | 13 | (alias 14 | (name nodetest) 15 | (deps 16 | (:x run_tests_nodejs.bc.js) 17 | (source_tree helpers)) 18 | (action (run node run_tests_nodejs.bc.js))) 19 | 20 | (executable 21 | (name run_tests_browser) 22 | (modes js) 23 | (modules run_tests_browser) 24 | (preprocess (pps js_of_ocaml-ppx)) 25 | (libraries test_common test_common_js webtest-js)) 26 | 27 | (alias 28 | (name firefoxtest) 29 | (deps 30 | (:x run_tests_browser.bc.js) 31 | (source_tree helpers)) 32 | (action (run helpers/run_firefox_tests.py))) 33 | -------------------------------------------------------------------------------- /test/helpers/firefox_test_page.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | ocaml-webtest tests 6 | 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /test/helpers/run_firefox_tests.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | """ 4 | Selenium test runner. 5 | """ 6 | 7 | import os 8 | import sys 9 | 10 | from selenium import webdriver 11 | from selenium.webdriver.firefox.options import Options 12 | from selenium.webdriver.support.ui import WebDriverWait 13 | 14 | 15 | def main(): 16 | """ 17 | Main program. 18 | """ 19 | options = Options() 20 | options.add_argument('-headless') 21 | 22 | driver = webdriver.Firefox(firefox_options=options) 23 | driver.get( 24 | "file://%s" % (os.path.join(os.getcwd(), "helpers/firefox_test_page.html"))) 25 | 26 | WebDriverWait(driver, 10).until( 27 | lambda driver: 28 | driver.execute_script("return (window.webtest != undefined)")) 29 | 30 | driver.execute_script("webtest.run()") 31 | 32 | WebDriverWait(driver, 10).until( 33 | lambda driver: driver.execute_script("return webtest.finished")) 34 | 35 | webtest = driver.execute_script("return webtest") 36 | print(webtest["log"]) 37 | 38 | driver.quit() 39 | 40 | if not webtest["passed"]: 41 | sys.exit(1) 42 | 43 | if __name__ == "__main__": 44 | main() 45 | -------------------------------------------------------------------------------- /test/helpers/run_tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | export OPAMYES=1 4 | eval $(opam config env) 5 | 6 | opam pin add -n webtest-js . 7 | opam install --deps-only webtest-js 8 | dune build @nodetest 9 | dune build @firefoxtest 10 | -------------------------------------------------------------------------------- /test/run_tests_browser.ml: -------------------------------------------------------------------------------- 1 | (* Test suite which runs in the browser as Javascript. *) 2 | 3 | let suite = 4 | let open Webtest.Suite in 5 | "browser_suite" >::: [ 6 | Test_assert.suite; 7 | Test_async.suite; 8 | Test_js.suite; 9 | Test_sync.suite; 10 | ] 11 | 12 | let () = Webtest_js.Runner.setup suite 13 | -------------------------------------------------------------------------------- /test/run_tests_nodejs.ml: -------------------------------------------------------------------------------- 1 | (* Test suite which runs under nodejs as Javascript. *) 2 | 3 | let suite = 4 | let open Webtest.Suite in 5 | "nodejs_suite" >::: [ 6 | Test_assert.suite; 7 | Test_async.suite; 8 | Test_js.suite; 9 | Test_sync.suite; 10 | ] 11 | 12 | let () = Webtest_js.Runner.run suite 13 | -------------------------------------------------------------------------------- /test/run_tests_ocaml.ml: -------------------------------------------------------------------------------- 1 | (* Test suite which runs as OCaml. *) 2 | 3 | open Webtest 4 | 5 | let suite = 6 | let open Webtest.Suite in 7 | "ocaml_suite" >::: [ 8 | Test_assert.suite; 9 | Test_async.suite; 10 | Test_sync.suite; 11 | ] 12 | 13 | let () = 14 | Utils.run suite 15 | (fun {Utils.log; outcomes} -> 16 | let {Utils.report; passed} = Utils.summarise outcomes in 17 | let log = (String.concat "\n" log) in 18 | print_endline log; 19 | print_endline report; 20 | if not passed 21 | then exit 1) 22 | -------------------------------------------------------------------------------- /webtest-js.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | authors: "John Else" 3 | homepage: "https://github.com/johnelse/ocaml-webtest" 4 | bug-reports: "https://github.com/johnelse/ocaml-webtest/issues" 5 | dev-repo: "git://github.com/johnelse/ocaml-webtest" 6 | maintainer: "john.else@gmail.com" 7 | synopsis: "An in-browser js_of_ocaml testing framework - js_of_ocaml integration" 8 | build: [ 9 | [ "dune" "build" "-p" name "-j" jobs ] 10 | [ "dune" "runtest" ] {with-test} 11 | ] 12 | 13 | depends: [ 14 | "dune" {>= "1.1"} 15 | "js_of_ocaml" {>= "3.4.0"} 16 | "js_of_ocaml-ppx" {>= "3.4.0"} 17 | "ocaml" {>= "4.02.1"} 18 | "webtest" {=version} 19 | ] 20 | -------------------------------------------------------------------------------- /webtest.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | authors: "John Else" 3 | homepage: "https://github.com/johnelse/ocaml-webtest" 4 | bug-reports: "https://github.com/johnelse/ocaml-webtest/issues" 5 | dev-repo: "git://github.com/johnelse/ocaml-webtest" 6 | maintainer: "john.else@gmail.com" 7 | synopsis: "An in-browser js_of_ocaml testing framework - core library" 8 | build: [ 9 | [ "dune" "build" "-p" name "-j" jobs ] 10 | [ "dune" "runtest" ] {with-test} 11 | ] 12 | 13 | depends: [ 14 | "dune" {>= "1.1"} 15 | "ocaml" {>= "4.02.1"} 16 | ] 17 | --------------------------------------------------------------------------------