source: trunk/tests/ansi-tests/upgraded-array-element-type.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: 4.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Jan 22 20:43:55 2003
4;;;; Contains: Tests of UPGRADED-ARRAY-ELEMENT-TYPE
5
6(in-package :cl-test)
7
8(deftest upgraded-array-element-type.1
9  (let ((upgraded-bit (upgraded-array-element-type 'bit)))
10    (and (empirical-subtypep 'bit upgraded-bit)
11         (empirical-subtypep upgraded-bit 'bit)))
12  t)
13
14(deftest upgraded-array-element-type.2
15  (let ((upgraded-base-char (upgraded-array-element-type 'base-char)))
16    (and (empirical-subtypep 'base-char upgraded-base-char)
17         (empirical-subtypep upgraded-base-char 'base-char)))
18  t)
19
20(deftest upgraded-array-element-type.3
21  (let ((upgraded-character (upgraded-array-element-type 'character)))
22    (and (empirical-subtypep 'character upgraded-character)
23         (empirical-subtypep upgraded-character 'character)))
24  t)
25
26(defparameter *upgraded-array-types-to-check*
27  `(boolean
28    base-char
29    character
30    t
31    ,@(loop for i from 0 to 32 collect `(eql ,(ash 1 i)))
32    ,@(loop for i from 0 to 32 collect `(eql ,(1- (ash 1 i))))
33    (eql -1)
34    ,@(loop for i from 0 to 32
35            collect `(integer 0 (,(ash 1 i))))
36    symbol
37    ,@(loop for i from 0 to 32
38            collect `(integer ,(- (ash 1 i)) (,(ash 1 i))))
39    (integer -10000000000000000000000000000000000
40             10000000000000000000000000000000000)
41    float
42    short-float
43    single-float
44    double-float
45    complex
46    rational
47    fixnum
48    function
49    sequence
50    list
51    cons
52    atom
53    symbol))
54
55(deftest upgraded-array-element-type.4
56  (loop for type in *upgraded-array-types-to-check*
57        for upgraded-type = (upgraded-array-element-type type)
58        unless (empirical-subtypep type upgraded-type)
59        collect (list type upgraded-type))
60  nil)
61
62;; Include an environment (NIL, denoting the default null lexical
63;; environment)
64
65(deftest upgraded-array-element-type.5
66  (loop for type in *upgraded-array-types-to-check*
67        for upgraded-type = (upgraded-array-element-type type nil)
68        unless (empirical-subtypep type upgraded-type)
69        collect (list type upgraded-type))
70  nil)
71
72(deftest upgraded-array-element-type.6
73  (macrolet
74      ((%foo (&environment env)
75             (empirical-subtypep
76              'bit
77              (upgraded-array-element-type 'bit env))))
78    (%foo))
79  t)
80
81(deftest upgraded-array-element-type.7
82  (let ((upgraded-types (mapcar #'upgraded-array-element-type
83                                *upgraded-array-types-to-check*)))
84    (loop for type in *upgraded-array-types-to-check*
85          for upgraded-type in upgraded-types
86          append
87          (loop for type2 in *upgraded-array-types-to-check*
88                for upgraded-type2 in upgraded-types
89                when (and (subtypep type type2)
90                          (equal (subtypep* upgraded-type upgraded-type)
91                                 '(nil t)))
92                collect (list type type2))))
93  nil)
94
95;;; Tests that if Tx is a subtype of Ty, then UAET(Tx) is a subtype
96;;;  of UAET(Ty)  (see section 15.1.2.1, paragraph 3)
97
98#+bogus-test ;; This requirement is unsatisfiable in any implementation that
99;; has two upgraded array element types U1 and U2, not subtypes of each
100;; other and with a non-empty intersection. Given an object x in the
101;; intersection, the UAET of `(eql ,x) is either U1 or U2, say U1.
102;; Then `(eql ,x) is a subtype of U2 but its UAET is not a subtype of U2.
103;; Example: U1 = (unsigned-byte 8), U2 = (signed-byte 8)
104(deftest upgraded-array-element-type.8
105  (let ((upgraded-types (mapcar #'upgraded-array-element-type
106                                *upgraded-array-types-to-check*)))
107    (loop for type1 in *upgraded-array-types-to-check*
108          for uaet1 in upgraded-types
109          append
110          (loop for type2 in *upgraded-array-types-to-check*
111                for uaet2 in upgraded-types
112                when (and (subtypep type1 type2)
113                        (not (empirical-subtypep uaet1 uaet2)))
114                collect (list type1 type2))))
115  nil)
116
117;;; Tests of upgrading NIL (it should be type equivalent to NIL)
118
119#+bogus-test
120(deftest upgraded-array-element-type.nil.1
121  (let ((uaet-nil (upgraded-array-element-type nil)))
122    (check-predicate (typef `(not ,uaet-nil))))
123  nil)
124   
125;;; Error tests
126
127(deftest upgraded-array-element-type.error.1
128  (signals-error (upgraded-array-element-type) program-error)
129  t)
130
131(deftest upgraded-array-element-type.error.2
132  (signals-error (upgraded-array-element-type 'bit nil nil) program-error)
133  t)
Note: See TracBrowser for help on using the repository browser.