/web_js/js_of_ocaml/tests/tests.ml
OCaml | 245 lines | 183 code | 38 blank | 24 comment | 10 complexity | d8372ef31f6d7e5e3db3e49a15e387f8 MD5 | raw file
Possible License(s): Apache-2.0, LGPL-2.0, LGPL-2.1, MIT, WTFPL
- (* Js_of_ocaml example
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2010 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
- let success_count = ref 0
- let test_count = ref 0
- let log_success () = incr success_count; incr test_count
- let log_failure s =
- incr test_count;
- Firebug.console##log_2 (Js.string "\tFAILURE: ", Js.string s)
- let log_start s =
- Firebug.console##log_2 (Js.string "START: ", Js.string s)
- let log_stop s =
- Firebug.console##log_2 (Js.string "STOP: ", Js.string s)
- let raw_log x =
- Firebug.console##log_2 (Js.string "\t\t", x)
- let log s = raw_log (Js.string s)
- (* TEST Url *)
- let () = log_start "Url test suite"
- let url_string_url u = Url.url_of_string (Url.string_of_url u)
- let () = match Url.Current.get () with
- | None -> log_failure "can't parse current url"
- | Some u -> match url_string_url u with
- | None -> log_failure "can't parse pretty-printed url"
- | Some v ->
- if u = v then
- log_success ()
- else
- log_failure "no fixpoint"
- let () =
- let t1 = Url.urlencode "/toto+ blah&tutu" in
- let t2 = Url.urlencode ~with_plus:false "/toto+ blah&tutu" in
- if t1 = "/toto%2B%20blah%26tutu" && t2 = "/toto+%20blah%26tutu" then
- log_success ()
- else
- log_failure "escaping error"
- let () = log_stop "Url test suite"
- (* Tests Regexp *)
- let () = log_start "Regexp test suite"
- let () =
- let re1 = Regexp.regexp "ab?" in
- let re2 = Regexp.regexp "\\." in
- let re3 = Regexp.regexp_string "(.)\\(.)" in
- let s1 = "totobtutua" in
- let s2 = "rr.ee.ab.a.b.bb.a.ee." in
- begin match Regexp.string_match re1 s1 0 with
- | None -> log_failure "Can't match 1 1"
- | Some r ->
- let x = Regexp.matched_string r in
- if x = "a" then
- log_success ()
- else
- log_failure ("Wrong match 1 1: " ^ x)
- end;
- begin match Regexp.string_match re1 s2 0 with
- | None -> log_failure "Can't match 1 2"
- | Some r ->
- let x = Regexp.matched_string r in
- if x = "ab" then
- log_success ()
- else
- log_failure ("Wrong match 1 2: " ^ x)
- end;
- begin
- let l = Regexp.split re2 s2 in
- if l = ["rr";"ee";"ab";"a";"b";"bb";"a";"ee";""] then
- log_success ()
- else
- log_failure "Wrong split 2 2"
- end ;
- begin
- let x = Regexp.global_replace re2 s2 "" in
- if x = "rreeababbbaee" then
- log_success ()
- else
- log_failure ("Wrong replacement 2 2: " ^ x)
- end ;
- begin match Regexp.string_match re3 "(.)\\(.)" 0 with
- | None -> log_failure "Quote 3 3"
- | Some x -> log_success ()
- end
- let () = log_stop "Regexp test suite"
- (* Tests Colors *)
- let () = log_start "CSS.Colors test suite"
- let () =
- let cols = [
- CSS.Color.RGB(120, 3, 56);
- CSS.Color.RGBA(120, 3, 56,1.);
- CSS.Color.RGB_percent(10, 3,60);
- CSS.Color.RGBA_percent(100,53,60,0.45);
- CSS.Color.HSL(120,75,56);
- CSS.Color.HSLA(180, 3,56,0.2);
- CSS.Color.RGB (CSS.Color.rgb_of_name CSS.Color.Dodgerblue);
- CSS.Color.RGB (CSS.Color.rgb_of_name CSS.Color.Pink);
- CSS.Color.Name CSS.Color.Hotpink;
- CSS.Color.Name CSS.Color.Cornsilk;
- ]
- in
- List.iter
- (fun c ->
- try
- let js = CSS.Color.js c in
- let ml = CSS.Color.ml js in
- if c = ml then
- log_success ()
- else
- log_failure (Printf.sprintf "%s %s"
- (CSS.Color.string_of_t c)
- (CSS.Color.string_of_t ml)
- )
- with
- | Invalid_argument s -> log_failure s
- | Failure s -> log_failure s
- )
- cols
- let () = log_stop "CSS.Colors test suite"
- (* CSS.Length testing *)
- let () = log_start "CSS.Length test suite"
- let () =
- let ls =
- [ CSS.Length.Em 0.1
- ; CSS.Length.Ex 0.12
- ; CSS.Length.Px 5.4
- ; CSS.Length.Gd 0.
- ; CSS.Length.Rem 10.0
- ; CSS.Length.Vw 0.10
- ; CSS.Length.Vh 0.1
- ; CSS.Length.Vm 0.5
- ; CSS.Length.Ch 20.6
- ; CSS.Length.Zero
- ; CSS.Length.Mm 100.
- ; CSS.Length.Cm 10.1
- ; CSS.Length.In 0.1
- ; CSS.Length.Pt 10.2
- ; CSS.Length.Pc 103.1
- ]
- in
- List.iter
- (fun c ->
- try
- let js = CSS.Length.js c in
- let ml = CSS.Length.ml js in
- if c = ml then
- log_success ()
- else
- log_failure (Printf.sprintf "%s %s"
- (CSS.Length.string_of_t c)
- (CSS.Length.string_of_t ml)
- )
- with
- | Invalid_argument s -> log_failure s
- | Failure s -> log_failure s
- )
- ls
- let () = log_stop "CSS.Length test suite"
- (*CSS.Angle test suite*)
- let () = log_start "CSS.Angle test suite"
- let () =
- let a =
- [ CSS.Angle.Rad 0.1
- ; CSS.Angle.Turns 0.12
- ; CSS.Angle.Deg 5.4
- ; CSS.Angle.Turns 0.
- ; CSS.Angle.Grad 10.0
- ; CSS.Angle.Grad 0.10
- ]
- in
- List.iter
- (fun c ->
- try
- let js = CSS.Angle.js c in
- let ml = CSS.Angle.ml js in
- if c = ml then
- log_success ()
- else
- log_failure (Printf.sprintf "%s %s"
- (CSS.Angle.string_of_t c)
- (CSS.Angle.string_of_t ml)
- )
- with
- | Invalid_argument s -> log_failure s
- | Failure s -> log_failure s
- )
- a
- let () = log_stop "CSS.Angle test suite"
- let () =
- Firebug.console##log(
- Js.string (
- Printf.sprintf "Test results: %d sucesses out of %d tests"
- !success_count !test_count
- )
- )