Added dlfcn to MinGW temporary repository.
[fedora-mingw.git] / ocaml-calendar / test_fcalendar.ml
1 (*i $Id: test_fcalendar.ml,v 1.3 2008/02/08 10:36:14 signoles Exp $ i*)
2
3 Printf.printf "Tests of Fcalendar:\n";;
4
5 open CalendarLib;;
6 open Fcalendar;;
7 include Gen_test;;
8 reset ();;
9
10 let eps = 0.000001;;
11
12 Time_Zone.change Time_Zone.UTC;;
13
14 (* Fcalendar *)
15
16 test_exn (lazy (make (-4712) 1 1 12 0 (-1.))) "-4713-12-31-23-59-59";;
17 test (make (-4712) 1 1 12 0 0. = make (-4712) 1 0 36 0 0.) "calendar coercion";;
18 test (from_jd 0. = make (-4712) 1 1 12 0 0.) "from_jd 0 = 4713 BC-1-1";;
19 test (from_mjd 0. = make 1858 11 17 0 0 0.) "from_mjd 0 = 1858-11-17";;
20
21 Time_Zone.change (Time_Zone.UTC_Plus 5);;
22
23 test (abs_float (to_jd (from_jd 12345.6789) -. 12345.6789) < eps) 
24   "to_jd (from_jd x) = x";;
25 test (abs_float (to_mjd (from_mjd 12345.6789) -. 12345.6789) < eps) 
26   "to_mjd (from_mjd x) = x";;
27 test (Period.to_date (Period.hour 60) = Date.Period.day 2) 
28   "period(60h) = period(2d)";;
29 test (Period.compare (Period.day 2) (Period.hour 60) < 0) "Period.compare <";;
30 test (Period.compare (Period.day 3) (Period.hour 60) > 0) "Period.compare >";;
31 test (Period.compare 
32         (Period.add (Period.day 2) (Period.hour 12)) 
33         (Period.hour 60) = 0) "Period.compare =";;
34 test 
35   (add (make 1 2 3 4 5 6.) (Period.make 9 8 7 6 5 4.5) = 
36       make 10 10 10 10 10 10.5) 
37   "add 1-2-3-4-5-6 9-8-7-6-5-4.5";;
38 test 
39   (add (make 3 1 1 0 0 0.7) (Period.make 0 0 0 (-25) 0 (-1.3)) =
40   make 2 12 30 22 59 59.4)
41   "add 3-1-1-0-0-0.7 0-0-0-(-25)-0-(-1.3)";;
42
43 test 
44   (equal (rem (make 9 8 7 6 5 4.9) (Period.make 1 2 3 4 5 6.4)) 
45      (make 8 6 4 1 59 58.5))
46   "rem 9-8-7-6-5-4 1-2-3-4-5-6";;
47
48 test (Period.equal 
49         (sub (make 0 0 7 6 5 4.) (make 0 0 3 54 5 6.)) 
50         (Period.make 0 0 1 23 59 58.))
51   "sub 0-0-7-6-5-4 0-0-3-54-5-6";;
52
53 test (Period.equal 
54         (Period.opp (Period.make 0 0 2 3 0 0.)) 
55         (Period.make 0 0 (-2) (-3) 0 0.))
56   "period opp";;
57
58 (* Date *)
59
60 let d = make 2003 12 31 12 24 48.;;
61 test (next d `Month = make 2004 1 31 12 24 48.) "2003-12-31 + 1 mois";;
62 test (add d (Period.month 2) = make 2004 3 2 12 24 48.) "2003-12-31 + 2 mois";;
63 let d2 = make (-3000) 1 1 6 12 24.5;;
64 test (equal (rem d (sub d d2)) d2) "rem x (sub x y) = y";;
65 test (is_leap_day (make 2000 2 24 0 0 0.)) "2000-2-24 leap day";;
66 test (not (is_leap_day (make 2000 2 25 0 0 0.))) "2000-2-25 not leap day";;
67 test (is_gregorian (make 1600 1 1 0 0 0.4)) "1600-1-1 gregorian";;
68 test (not (is_gregorian (make 1400 1 1 0 0 0.1))) "1400-1-1 not gregorian";;
69 test (is_julian (make 1582 1 1 0 0 0.1)) "1582-1-1 julian";;
70 test (not (is_julian (make 1583 1 1 0 0 0.9832))) "1583-1-1 not julian";;
71
72 (* Time *)
73
74 test (let n = Unix.gmtime (Unix.time ()) in 
75       hour (from_unixtm n) = n.Unix.tm_hour) "from_unixtm invariant UTC";;
76 test (let n = Unix.time () in 
77       hour (from_unixfloat n) = (Unix.gmtime n).Unix.tm_hour) 
78   "from_unixfloat invariant UTC";;
79
80 Time_Zone.change (Time_Zone.UTC_Plus 10);;
81
82 test (let n = Unix.gmtime (Unix.time ()) in 
83       hour (from_unixtm n) = n.Unix.tm_hour) "from_unixtm invariant +10";;
84 test (let n = Unix.time () in 
85       hour (from_unixfloat n) = (Unix.gmtime n).Unix.tm_hour) 
86   "from_unixfloat invariant +10";;
87
88 test (equal (add (make 0 0 0 10 0 0.1) (Period.hour 30)) (make 0 0 1 16 0 0.1))
89   "add 0-0-0-20-0-0 30h";;
90 test (equal 
91         (next (make 1999 12 31 23 59 59.43) `Second) 
92         (make 2000 1 1 0 0 0.43))
93   "next 1999-31-12-23-59-59 `Second";;
94 let n = now ();;
95 test (equal (prev (next n `Minute) `Minute) n) "prev next = id";;
96 test (equal 
97         (convert 
98            (make 0 0 0 23 0 0.1234) 
99            (Time_Zone.UTC_Plus 2) 
100            (Time_Zone.UTC_Plus 4))
101         (make 0 0 1 1 0 0.1234)) "convert";;
102
103 (* Loss of precision *)
104 test (hour (make 0 0 0 20 0 0.) = 19) "hour";;
105 test (hour (make 0 0 0 20 0 0.2) = 20) "hour";;
106
107 test (minute (make 0 0 0 20 10 0.2) = 10) "minute";;
108
109 (* Loss of precision *)
110 test (Utils.Float.equal (second (make 0 0 0 20 10 5.123)) 5.123004) "second";;
111
112 test (is_pm (make 0 0 0 10 0 0.1)) "is_pm 10-0-0";;
113 test (is_pm (make 0 0 0 34 0 0.)) "is_pm 34-0-0";;
114 test (not (is_pm (make 0 0 0 (- 10) 0 0.))) "not (is_pm (- 10) 0 0)";;
115 test (is_am (make 0 0 0 20 0 0.)) "is_am 20-0-0";;
116 test (is_am (make 0 0 0 (- 34) 0 0.)) "is_am (- 34) 0 0";;
117 test (not (is_am (make 0 0 0 34 0 0.))) "not (is_pm 34 0 0)";;
118
119 Time_Zone.change Time_Zone.UTC;;
120
121 test (let n = Unix.gmtime (Unix.time ()) in 
122       hour (from_unixtm n) = n.Unix.tm_hour) "from_unixtm invariant UTC2";;
123 test (let n = Unix.time () in
124       hour (from_unixfloat n) = (Unix.gmtime n).Unix.tm_hour) 
125   "from_unixfloat invariant UTC2";;
126
127 test (to_unixfloat (make 1970 1 1 0 0 0.) = 0.) "to_unixfloat 1 Jan 1970";;
128 test (from_unixfloat 0. = make 1970 1 1 0 0 0.) "from_unixfloat 1 Jan 1970";;
129 test (Utils.Float.equal (to_unixfloat (make 2004 11 13 19 17 9.)) 1100373429.)
130   "to_unixfloat";;
131 test (equal (from_unixfloat 1100373429.) (make 2004 11 13 19 17 9.)) 
132   "from_unixfloat";;
133
134 (* Loss of precision *)
135 test (equal
136         (from_unixtm (to_unixtm (make 2003 7 16 23 22 21.)))
137         (make 2003 7 16 23 22 20.)) 
138   "from_unixtm to_unixtm = id";;
139
140 test (Period.to_time (Period.second 30.12) = Time.Period.second 30.12) 
141   "Period.to_time second";;
142 test (Period.to_time (Period.day 6) = Time.Period.second 518400.) 
143   "Period.to_time day";;
144 test_exn (lazy (Period.to_time (Period.year 1))) "Period.to_time year";;
145 test (Period.ymds (Period.make 1 2 3 1 2 3.1) = (1, 2, 3, 3723.1)) 
146   "Period.ymds";;
147 test
148   (Period.ymds (Period.make (-1) (-2) (-3) (-1) (-2) (-3.)) = (-1,-2,-4,82677.))
149   "Period.ymds neg";;
150
151 let ok = nb_ok ();;
152 let bug = nb_bug ();;
153 Printf.printf "tests ok : %d; tests ko : %d\n" ok bug;;
154 flush stdout;;