source: trunk/tests/ansi-tests/file-position.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:  Thu Jan 22 03:02:31 2004
4;;;; Contains: Tests of FILE-POSITION
5
6(in-package :cl-test)
7
8(deftest file-position.1
9  (with-open-file (is "file-position.lsp":direction :input)
10                  (file-position is))
11  0)
12
13(deftest file-position.2
14  (with-open-file (is "file-position.lsp":direction :input)
15                  (values
16                   (multiple-value-list
17                    (notnot-mv (file-position is :start)))
18                   (file-position is)))
19                             
20  (t) 0)
21
22(deftest file-position.3
23  (with-open-file (is "file-position.lsp":direction :input)
24                  (values
25                   (multiple-value-list
26                    (notnot-mv (file-position is :end)))
27                   (notnot (> (file-position is) 0))))
28  (t) t)
29
30(deftest file-position.4
31  (with-open-file
32   (is "file-position.lsp":direction :input)
33   (values
34    (file-position is)
35    (read-char is)
36    (notnot (> (file-position is) 0))))
37  0 #\; t)
38
39(deftest file-position.5
40  (with-open-file
41   (os "tmp.dat":direction :output
42       :if-exists :supersede)
43   (values
44    (file-position os)
45    (write-char #\x os)
46    (notnot (> (file-position os) 0))))
47  0 #\x t)
48
49(deftest file-position.6
50  (with-open-file
51   (os "tmp.dat":direction :output
52       :if-exists :supersede)
53   (let ((p1 (file-position os))
54         (delta (file-string-length os #\x)))
55     (write-char #\x os)
56     (let ((p2 (file-position os)))
57       (or (null p1) (null p2) (null delta)
58           (=t (+ p1 delta) p2)))))
59  t)
60
61;;; Byte streams
62
63(deftest file-position.7
64  (loop for len from 1 to 32
65        for n = (ash 1 len)
66        do (with-open-file
67            (os "tmp.dat" :direction :output
68                :if-exists :supersede
69                :element-type `(unsigned-byte ,len))
70            (loop for i from 0 below 100
71                  for r = (logand (1- n) i)
72                  for pos = (file-position os)
73                  do (assert (or (not pos) (eql pos i)))
74                  do (write-byte r os)))
75        do (with-open-file
76            (is "tmp.dat" :direction :input
77                :element-type `(unsigned-byte ,len))
78            (loop for i from 0 below 100
79                  for pos = (file-position is)
80                  do (assert (or (not pos) (eql pos i)))
81                  do (let ((byte (read-byte is)))
82                       (assert (eql byte (logand (1- n) i)))))))
83  nil)
84
85#+known-bug-280
86(deftest file-position.8
87  (loop for len from 33 to 100
88        for n = (ash 1 len)
89        do (with-open-file
90            (os "tmp.dat" :direction :output
91                :if-exists :supersede
92                :element-type `(unsigned-byte ,len))
93            (loop for i from 0 below 100
94                  for r = (logand (1- n) i)
95                  for pos = (file-position os)
96                  do (assert (or (not pos) (eql pos i)))
97                  do (write-byte r os)))
98        do (with-open-file
99            (is "tmp.dat" :direction :input
100                :element-type `(unsigned-byte ,len))
101            (loop for i from 0 below 100
102                  for pos = (file-position is)
103                  do (assert (or (not pos) (eql pos i)))
104                  do (let ((byte (read-byte is)))
105                       (assert (eql byte (logand (1- n) i)))))))
106  nil)
107
108(deftest file-position.9
109  (with-input-from-string
110   (s "abcdefghijklmnopqrstuvwxyz")
111   (loop repeat 26
112         for p = (file-position s)
113         unless (or (not p)
114                    (progn
115                      (file-position s p)
116                      (eql (file-position s) p)))
117         collect p
118         do (read-char s)))
119  nil)
120
121(deftest file-position.10
122  (with-output-to-string
123   (s)
124   (loop repeat 26
125         for p = (file-position s)
126         unless (or (not p)
127                    (progn
128                      (file-position s p)
129                      (eql (file-position s) p)))
130         collect p
131         do (write-char #\x s)))
132  "xxxxxxxxxxxxxxxxxxxxxxxxxx")
133
134;;; Error tests
135
136(deftest file-position.error.1
137  (signals-error (file-position) program-error)
138  t)
139
140(deftest file-position.error.2
141  (signals-error
142   (file-position (make-string-input-stream "abc") :start nil)
143   program-error)
144  t)
145
146;;; It's not clear what 'too large' means -- can we set the
147;;; file position to a point where the file may later be extended
148;;; by some other writer?
149#|
150(deftest file-position.error.3
151  (signals-error
152   (with-open-file
153    (is "file-position.lsp" :direction :input)
154    (flet ((%fail () (error 'type-error)))
155      (unless (file-position is :end) (%fail))
156      (let ((fp (file-position is)))
157        (unless fp (%fail))
158        (file-position is (+ 1000000 fp)))))
159   error)
160  t)
161
162(deftest file-position.error.4
163  (signals-error
164   (with-open-file
165    (is "file-position.lsp" :direction :input)
166    (file-position is 1000000000000000000000))
167   error)
168  t)
169|#
170
171 
Note: See TracBrowser for help on using the repository browser.