file-position.lsp 4.79 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Jan 22 03:02:31 2004
;;;; Contains: Tests of FILE-POSITION

(in-package :cl-test)

(deftest file-position.1
  (with-open-file (is "file-position.lsp":direction :input)
sds's avatar
sds committed
10
                  (file-position is))
pfdietz's avatar
pfdietz committed
11 12 13 14
  0)

(deftest file-position.2
  (with-open-file (is "file-position.lsp":direction :input)
sds's avatar
sds committed
15 16 17 18 19
                  (values
                   (multiple-value-list
                    (notnot-mv (file-position is :start)))
                   (file-position is)))

pfdietz's avatar
pfdietz committed
20 21 22 23
  (t) 0)

(deftest file-position.3
  (with-open-file (is "file-position.lsp":direction :input)
sds's avatar
sds committed
24 25 26 27
                  (values
                   (multiple-value-list
                    (notnot-mv (file-position is :end)))
                   (notnot (> (file-position is) 0))))
pfdietz's avatar
pfdietz committed
28 29 30 31 32 33 34 35 36 37 38
  (t) t)

(deftest file-position.4
  (with-open-file
   (is "file-position.lsp":direction :input)
   (values
    (file-position is)
    (read-char is)
    (notnot (> (file-position is) 0))))
  0 #\; t)

pfdietz's avatar
pfdietz committed
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
(deftest file-position.5
  (with-open-file
   (os "tmp.dat":direction :output
       :if-exists :supersede)
   (values
    (file-position os)
    (write-char #\x os)
    (notnot (> (file-position os) 0))))
  0 #\x t)

(deftest file-position.6
  (with-open-file
   (os "tmp.dat":direction :output
       :if-exists :supersede)
   (let ((p1 (file-position os))
sds's avatar
sds committed
54
         (delta (file-string-length os #\x)))
pfdietz's avatar
pfdietz committed
55 56 57
     (write-char #\x os)
     (let ((p2 (file-position os)))
       (or (null p1) (null p2) (null delta)
sds's avatar
sds committed
58
           (=t (+ p1 delta) p2)))))
pfdietz's avatar
pfdietz committed
59 60 61 62 63 64
  t)

;;; Byte streams

(deftest file-position.7
  (loop for len from 1 to 32
sds's avatar
sds committed
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
        for n = (ash 1 len)
        do (with-open-file
            (os "tmp.dat" :direction :output
                :if-exists :supersede
                :element-type `(unsigned-byte ,len))
            (loop for i from 0 below 100
                  for r = (logand (1- n) i)
                  for pos = (file-position os)
                  do (assert (or (not pos) (eql pos i)))
                  do (write-byte r os)))
        do (with-open-file
            (is "tmp.dat" :direction :input
                :element-type `(unsigned-byte ,len))
            (loop for i from 0 below 100
                  for pos = (file-position is)
                  do (assert (or (not pos) (eql pos i)))
                  do (let ((byte (read-byte is)))
                       (assert (eql byte (logand (1- n) i)))))))
pfdietz's avatar
pfdietz committed
83 84 85 86
  nil)

(deftest file-position.8
  (loop for len from 33 to 100
sds's avatar
sds committed
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
        for n = (ash 1 len)
        do (with-open-file
            (os "tmp.dat" :direction :output
                :if-exists :supersede
                :element-type `(unsigned-byte ,len))
            (loop for i from 0 below 100
                  for r = (logand (1- n) i)
                  for pos = (file-position os)
                  do (assert (or (not pos) (eql pos i)))
                  do (write-byte r os)))
        do (with-open-file
            (is "tmp.dat" :direction :input
                :element-type `(unsigned-byte ,len))
            (loop for i from 0 below 100
                  for pos = (file-position is)
                  do (assert (or (not pos) (eql pos i)))
                  do (let ((byte (read-byte is)))
                       (assert (eql byte (logand (1- n) i)))))))
pfdietz's avatar
pfdietz committed
105 106
  nil)

pfdietz's avatar
pfdietz committed
107 108 109 110
(deftest file-position.9
  (with-input-from-string
   (s "abcdefghijklmnopqrstuvwxyz")
   (loop repeat 26
sds's avatar
sds committed
111 112 113 114 115 116 117
         for p = (file-position s)
         unless (or (not p)
                    (progn
                      (file-position s p)
                      (eql (file-position s) p)))
         collect p
         do (read-char s)))
pfdietz's avatar
pfdietz committed
118
  nil)
pfdietz's avatar
pfdietz committed
119

pfdietz's avatar
pfdietz committed
120 121 122 123
(deftest file-position.10
  (with-output-to-string
   (s)
   (loop repeat 26
sds's avatar
sds committed
124 125 126 127 128 129 130
         for p = (file-position s)
         unless (or (not p)
                    (progn
                      (file-position s p)
                      (eql (file-position s) p)))
         collect p
         do (write-char #\x s)))
pfdietz's avatar
pfdietz committed
131
  "xxxxxxxxxxxxxxxxxxxxxxxxxx")
pfdietz's avatar
pfdietz committed
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155

;;; Error tests

(deftest file-position.error.1
  (signals-error (file-position) program-error)
  t)

(deftest file-position.error.2
  (signals-error
   (file-position (make-string-input-stream "abc") :start nil)
   program-error)
  t)

;;; It's not clear what 'too large' means -- can we set the
;;; file position to a point where the file may later be extended
;;; by some other writer?
#|
(deftest file-position.error.3
  (signals-error
   (with-open-file
    (is "file-position.lsp" :direction :input)
    (flet ((%fail () (error 'type-error)))
      (unless (file-position is :end) (%fail))
      (let ((fp (file-position is)))
sds's avatar
sds committed
156 157
        (unless fp (%fail))
        (file-position is (+ 1000000 fp)))))
pfdietz's avatar
pfdietz committed
158 159 160 161 162 163 164 165 166 167 168 169
   error)
  t)

(deftest file-position.error.4
  (signals-error
   (with-open-file
    (is "file-position.lsp" :direction :input)
    (file-position is 1000000000000000000000))
   error)
  t)
|#

sds's avatar
sds committed
170