source: trunk/tests/ansi-tests/encode-universal-time.lsp @ 9045

Last change on this file since 9045 was 9045, checked in by gz, 12 years ago

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

File size: 3.6 KB
Line 
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#+known-bug-268
66(deftest encode-universal-time.3
67  (loop with count = 0
68        for year = (+ 1900 (random 1000))
69        ;; Gregorian leap year algorithm
70        for leap? = (and (= (mod year 4) 0)
71                         (or (/= (mod year 100) 0)
72                             (= (mod year 400) 0)))
73        for month = (1+ (random 12))
74        for date = (1+ (random (elt (if leap?
75                                        #(0 31 29 31 30 31 30 31 31 30 31 30 31)
76                                      #(0 31 28 31 30 31 30 31 31 30 31 30 31))
77                                    month)))
78        for hour = (random 24)
79        for minute = (random 60)
80        for second = (random 60)
81        for tz = (/ (if (and (= year 1900) (= date 0) (= month 0))
82                        (random (1+ (* 24 3600)))
83                      (- (random (1+ (* 48 3600))) (* 24 3600)))
84                    3600)
85        for time = (encode-universal-time second minute hour date month year tz)
86        for decoded-vals = (multiple-value-list (decode-universal-time time tz))
87        for vals = (list second minute hour date month year (elt decoded-vals 6)
88                         nil tz)
89        repeat 20000
90        unless (equal vals decoded-vals)
91        collect (progn (incf count) (list vals time decoded-vals))
92        until (>= count 100))
93  nil)
94
95#+known-bug-268 ;; specific case, for more reliable testing.
96(deftest encode-universal-time.3.1
97    (let* ((tz 1787/360)
98           (time (encode-universal-time 59 23 11 1 1 2000 tz)))
99      (multiple-value-bind (second minute hour) (decode-universal-time time tz)
100        (list second minute hour)))
101  (59 23 11))
102
103;;; Error cases
104
105(deftest encode-universal-time.error.1
106  (signals-error (encode-universal-time 0 0 0 1 1) program-error)
107  t)
108
109(deftest encode-universal-time.error.2
110  (signals-error (encode-universal-time 0 0 0 1 1 1901 0 nil) program-error)
111  t)
Note: See TracBrowser for help on using the repository browser.