1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sun May 8 12:54:34 2005 |
---|
4 | ;;;; Contains: Tests of ENCODE-UNIVERSAL-TIME |
---|
5 | |
---|
6 | ;;; See also the tests in decode-universal-time.lsp |
---|
7 | |
---|
8 | (in-package :cl-test) |
---|
9 | |
---|
10 | (deftest encode-universal-time.1 |
---|
11 | (loop with count = 0 |
---|
12 | for year = (+ 1900 (random 1000)) |
---|
13 | ;; Gregorian leap year algorithm |
---|
14 | for leap? = (and (= (mod year 4) 0) |
---|
15 | (or (/= (mod year 100) 0) |
---|
16 | (= (mod year 400) 0))) |
---|
17 | for month = (1+ (random 12)) |
---|
18 | for date = (1+ (random (elt (if leap? |
---|
19 | #(0 31 29 31 30 31 30 31 31 30 31 30 31) |
---|
20 | #(0 31 28 31 30 31 30 31 31 30 31 30 31)) |
---|
21 | month))) |
---|
22 | for hour = (random 24) |
---|
23 | for minute = (random 60) |
---|
24 | for second = (random 60) |
---|
25 | for tz = (if (and (= year 1900) (= date 0) (= month 0)) |
---|
26 | (random 25) |
---|
27 | (- (random 49) 24)) |
---|
28 | for time = (encode-universal-time second minute hour date month year tz) |
---|
29 | for decoded-vals = (multiple-value-list (decode-universal-time time tz)) |
---|
30 | for vals = (list second minute hour date month year (elt decoded-vals 6) |
---|
31 | nil tz) |
---|
32 | repeat 20000 |
---|
33 | unless (equal vals decoded-vals) |
---|
34 | collect (progn (incf count) (list vals time decoded-vals)) |
---|
35 | until (>= count 100)) |
---|
36 | nil) |
---|
37 | |
---|
38 | #| |
---|
39 | (deftest encode-universal-time.2 |
---|
40 | (loop with count = 0 |
---|
41 | for year = (+ 1901 (random 1000)) |
---|
42 | ;; Gregorian leap year algorithm |
---|
43 | for leap? = (and (= (mod year 4) 0) |
---|
44 | (or (/= (mod year 100) 0) |
---|
45 | (= (mod year 400) 0))) |
---|
46 | for month = (1+ (random 12)) |
---|
47 | for date = (1+ (random (elt (if leap? |
---|
48 | #(0 31 29 31 30 31 30 31 31 30 31 30 31) |
---|
49 | #(0 31 28 31 30 31 30 31 31 30 31 30 31)) |
---|
50 | month))) |
---|
51 | for hour = (random 24) |
---|
52 | for minute = (random 60) |
---|
53 | for second = (random 60) |
---|
54 | for time = (encode-universal-time second minute hour date month year) |
---|
55 | for decoded-vals = (multiple-value-list (decode-universal-time time)) |
---|
56 | for vals = (list second minute hour date month year (elt decoded-vals 6) |
---|
57 | (elt decoded-vals 7) (elt decoded-vals 8)) |
---|
58 | repeat 20000 |
---|
59 | unless (equal vals decoded-vals) |
---|
60 | collect (progn (incf count) (list vals time decoded-vals)) |
---|
61 | until (>= count 100)) |
---|
62 | nil) |
---|
63 | |# |
---|
64 | |
---|
65 | (deftest encode-universal-time.3 |
---|
66 | (loop with count = 0 |
---|
67 | for year = (+ 1900 (random 1000)) |
---|
68 | ;; Gregorian leap year algorithm |
---|
69 | for leap? = (and (= (mod year 4) 0) |
---|
70 | (or (/= (mod year 100) 0) |
---|
71 | (= (mod year 400) 0))) |
---|
72 | for month = (1+ (random 12)) |
---|
73 | for date = (1+ (random (elt (if leap? |
---|
74 | #(0 31 29 31 30 31 30 31 31 30 31 30 31) |
---|
75 | #(0 31 28 31 30 31 30 31 31 30 31 30 31)) |
---|
76 | month))) |
---|
77 | for hour = (random 24) |
---|
78 | for minute = (random 60) |
---|
79 | for second = (random 60) |
---|
80 | for tz = (/ (if (and (= year 1900) (= date 0) (= month 0)) |
---|
81 | (random (1+ (* 24 3600))) |
---|
82 | (- (random (1+ (* 48 3600))) (* 24 3600))) |
---|
83 | 3600) |
---|
84 | for time = (encode-universal-time second minute hour date month year tz) |
---|
85 | for decoded-vals = (multiple-value-list (decode-universal-time time tz)) |
---|
86 | for vals = (list second minute hour date month year (elt decoded-vals 6) |
---|
87 | nil tz) |
---|
88 | repeat 20000 |
---|
89 | unless (equal vals decoded-vals) |
---|
90 | collect (progn (incf count) (list vals time decoded-vals)) |
---|
91 | until (>= count 100)) |
---|
92 | nil) |
---|
93 | |
---|
94 | ;;; Error cases |
---|
95 | |
---|
96 | (deftest encode-universal-time.error.1 |
---|
97 | (signals-error (encode-universal-time 0 0 0 1 1) program-error) |
---|
98 | t) |
---|
99 | |
---|
100 | (deftest encode-universal-time.error.2 |
---|
101 | (signals-error (encode-universal-time 0 0 0 1 1 1901 0 nil) program-error) |
---|
102 | t) |
---|