3 ;;; Test for the charbuf scanner
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible Object Design, an object system for C.
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26 ;;; The charbuf scanner is a hairy beast and in need of a thorough going
29 (cl:in-package #:sod-test)
31 ;;;--------------------------------------------------------------------------
32 ;;; Tests of the low-level seeking and fetching machinery.
34 (defclass charbuf-test (test-case) (scanner))
35 (add-test *sod-test-suite* (get-suite charbuf-test))
37 (defparameter *background-pattern*
38 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789."
39 "Basic pattern underlying our initial buffer contents.
41 The pattern is one character short of the base-64 sequence `A-Za-z0-9./',
42 with the aim of making its length be prime to the actual buffer length --
43 so that the pattern doesn't repeat exactly for many buffers.")
44 (assert (= (gcd (length *background-pattern*) charbuf-size) 1))
46 (defun make-pattern-string (start end)
47 "Return a string containing the buffer pattern between START and END.
49 The most interesting cases occur at the boundaries between buffers; so we
50 shall want to put recognizable patterns there. The buffers are quite big
51 (we import `charbuf-size' off the books so that we don't actually have to
52 know exactly) but we should still fill with a repeating pattern so that we
53 can detect synchronization failures.
55 We fill most of the buffer with the `*background-pattern*', which has been
56 chosen so as not to align nicely with the buffer size. Across the joins,
57 we write a string `<<N][N+1>>', where the boundary is between `]' and `[',
58 and the numbers N and N + 1 are the numbers, in words, of the respective
61 (with-output-to-string (out)
62 (multiple-value-bind (n0 i0) (floor start charbuf-size)
63 (multiple-value-bind (n1 i1) (floor end charbuf-size)
65 (do ((n n0 (1+ n))) ((> n n1))
66 (let* ((l (format nil "[~R>>" n))
67 (r (format nil "<<~R]" n))
69 (q (length *background-pattern*))
70 (i (if (= n n0) i0 0))
71 (e (if (= n n1) i1 charbuf-size))
72 (k (min (- charbuf-size m) e)))
73 (when (< i (length l))
74 (write-string l out :start i :end (min e m))
76 (do ((o (mod (+ (* charbuf-size n) i) q) 0))
78 (let ((p (min (- k i) (- q o))))
79 (write-string *background-pattern* out :start o :end (+ o p))
82 (write-string r out :start (- i k) :end (- e k)))))))))
84 (defparameter *test-pattern* (make-pattern-string 0 10000)
85 "The pattern that our test scanner is reading.")
87 (defmethod set-up ((test charbuf-test))
88 (with-slots (scanner) test
89 (let ((stream (make-string-input-stream *test-pattern*)))
90 (setf scanner (make-instance 'charbuf-scanner
92 :filename "<magic test>")))))
94 (defun skip (scanner n)
96 (charbuf-scanner-map scanner
97 (lambda (buf start end)
98 (declare (ignore buf))
99 (let ((d (- end start)))
101 (values t (+ start n))
102 (progn (decf n d) (values nil 0)))))))
104 (defun assert-string-next (scanner pos len)
105 "Assert that the next LEN characters from SCANNER are correct.
107 That is, that they match the corresponding LEN characters starting at
108 position POS as returned by `make-pattern-string'."
109 (let ((want (make-pattern-string pos (+ pos len))))
111 (assert-false (scanner-at-eof-p scanner))
112 (assert-eql (scanner-current-char scanner) (char want i))
113 (scanner-step scanner))))
115 (def-test-method test-pattern ((test charbuf-test) :run nil)
116 ;; Make sure the pattern is what we expect. This is a completely different
117 ;; (and considerably more stupid) way of generating the basic pattern up to
118 ;; a particular length.
119 (let* ((len (length *background-pattern*))
121 (loop while (< (length string) len)
122 do (setf string (concatenate 'string string *test-pattern*)))
124 for i from 0 by charbuf-size below len
125 for l = (format nil "[~R>>" n) and r = (format nil "<<~R]" n)
126 for e = (- (+ i charbuf-size) (length r))
127 do (setf (subseq string i) l)
128 when (< e len) do (setf (subseq string e) r))
129 (assert-equal (subseq string 0 len)
130 (make-pattern-string 0 len))))
132 (def-test-method test-read ((test charbuf-test) :run nil)
133 ;; Test reading from various places.
134 (with-slots (scanner) test
135 (loop for prev = 0 then (+ pos len)
136 for (pos len) in '((0 10) (50 250) (4086 20)
137 (5000 3192) (9800 200)) do
138 (assert (>= pos prev))
139 (skip scanner (- pos prev))
140 (assert-string-next scanner pos len))
141 (assert-true (scanner-at-eof-p scanner))))
143 (def-test-method test-unread ((test charbuf-test) :run nil)
144 ;; Torture test for `scanner-unread', which is distressingly hairy.
145 (with-slots (scanner) test
147 (flet ((test (here next skip there note)
148 (assert-eql (scanner-current-char scanner) here
149 (format nil "Here (~A)." note))
150 (scanner-step scanner)
151 (assert-eql (scanner-current-char scanner) next
152 (format nil "Next (~A)." note))
153 (scanner-unread scanner here)
154 (with-scanner-place (place scanner)
155 (assert-eql (scanner-current-char scanner) here
156 (format nil "Here again (~A)." note))
157 (scanner-step scanner)
158 (assert-eql (scanner-current-char scanner) next
159 (format nil "Next again (~A)." note))
161 (assert-eql (scanner-current-char scanner) there
162 (format nil "There (~A)." note))
163 (scanner-unread scanner there)
164 (with-scanner-place (another-place scanner)
165 (scanner-restore-place scanner place)
166 (assert-eql (scanner-current-char scanner) here
167 (format nil "Here restored (~A)." note))))))
169 (test #\[ #\z 51 #\0 "start")
171 (test #\] #\[ 4096 #\[ "edge")
173 ;; Check behaviour at EOF. Ought to test behaviour when EOF is on a
174 ;; buffer boundary too.
176 (assert-false (scanner-at-eof-p scanner))
177 (assert-eql (scanner-current-char scanner) #\t "EOF.")
178 (scanner-step scanner)
179 (assert-true (scanner-at-eof-p scanner))
180 (scanner-unread scanner #\t)
181 (assert-false (scanner-at-eof-p scanner))
182 (assert-eql (scanner-current-char scanner) #\t "EOF again."))))
184 (def-test-method test-rewind ((test charbuf-test) :run nil)
185 ;; Test reading, like before, but this time with rewinding.
186 (with-slots (scanner) test
187 (let* ((list '((0 10) (0 10000) (50 250) (4086 20)
188 (4095 4097) (5000 3192) (9999 1)))
189 (places (loop for prev = 0 then pos
191 do (skip scanner (- pos prev))
192 collect (scanner-capture-place scanner))))
193 (loop for (pos len) in list
194 for place in places do
195 (scanner-restore-place scanner place)
196 (assert-string-next scanner pos len))
197 (assert-true (scanner-at-eof-p scanner)))))
199 (def-test-method test-interval ((test charbuf-test) :run nil)
200 ;; Test fetching intervals of text.
201 (with-slots (scanner) test
202 (let* ((posns '(0 12 4080 4110 5000 9000 10000))
203 (places (loop for prev = 0 then pos
205 do (skip scanner (- pos prev))
206 collect (scanner-capture-place scanner))))
207 (loop for p0 in places
209 (loop for p1 in places
212 (assert-condition 'error (scanner-interval p0 p1))
213 (assert-equal (scanner-interval scanner p0 p1)
214 (make-pattern-string i0 i1)
215 (format nil "Mismatch interval ~A .. ~A."
217 (assert-true (scanner-at-eof-p scanner)))))))
219 ;;;--------------------------------------------------------------------------
220 ;;; Tests of the position tracking machinery.
222 (defparameter *position-test-text*
223 ;; Use a roundabout method of getting tabs in there, so that they don't get
224 ;; screwed by strange editors and suchlike.
225 (substitute #\tab #\@ "Line one
226 Line two is rather longer, but not noticeably more interesting.
227 Line three explains that line four contains column numbers mod 10.
228 012345678@6789@@2345678@012
229 @@Line five is indented somewhat.")
230 "Text for the position-tracking test.
232 The text should /look/ like the following. Note that this text here may
233 get trashed by tab/space conversions and whatever, and I've indented it so
234 that it doesn't look daft in the source; but the columns should remain
238 0123456789012345678901234567890123456789012345678901234567890123456789012
240 Line two is rather longer, but not noticeably more interesting.
241 Line three explains that line four contains column numbers mod 10.
242 012345678 6789 2345678 012
243 Line five is indented somewhat.
245 It would be nice at some point to add additional tests for edge cases
246 around buffer boundaries. This isn't completely essential, though: the
247 current implementation manages positions fairly independently of the
250 (defparameter *known-positions*
252 ;; The first few line aren't actually very interesting. We'll
253 ;; check the start and end positions, and maybe a few in the
254 ;; middle. Note that a newline character is logically a part of
255 ;; the preceding line.
256 (0 #\L 1 0 #\i 1 1 0) (5 #\o 1 5 #\n 1 6 5) (8 #\newline 1 8 #\L 2 0 0)
257 (9 #\L 2 0 #\i 2 1 0) (72 #\newline 2 63 #\L 3 0 0)
258 (73 #\L 3 0 #\i 3 1 0) (139 #\newline 3 66 #\0 4 0 0)
260 ;; Now for the line with the fancy tabbings.
261 (140 #\0 4 0 #\1 4 1 0)
262 (148 #\8 4 8 #\tab 4 9 8) ; nothing so far
263 (149 #\tab 4 9 #\6 4 16 15) ; the tab itself just follows on
264 (150 #\6 4 16 #\7 4 17 16) ; but the char after is tabbed
265 (154 #\tab 4 20 #\tab 4 24 23) ; next tab position
266 (155 #\tab 4 24 #\2 4 32 31) ; two in a row
267 (156 #\2 4 32 #\3 4 33 32) ; should be here now
268 (162 #\8 4 38 #\tab 4 39 38) ; skip to the next bit
269 (163 #\tab 4 39 #\0 4 40 39) ; tab is here
270 (164 #\0 4 40 #\1 4 41 40) ; and doesn't move us much
271 (166 #\2 4 42 #\newline 4 43 42) ; last actual character on the line
272 (167 #\newline 4 43 #\tab 5 0 0) ; and the ending newline
274 ;; And the final line.
275 (168 #\tab 5 0 #\tab 5 8 7) ; first tab on next line
276 (169 #\tab 5 8 #\L 5 16 15) ; and the second
277 (170 #\L 5 16 #\i 5 17 16) ; beginning of the text
278 (200 #\. 5 46 :eof 5 47 46) ; last character in the stream
279 (201 :eof 5 47)) ; but eof has a position too
280 "List of character positions, characters and line/column numbers.
282 The characters are there for sanity-checking purposes. The format is
284 (INDEX CHAR LINE COLUMN NEXT-CHAR
285 NEXT-LINE NEXT-COLUMN REWIND-COLUMN)
287 which asserts that the character at INDEX is CHAR, found at the given LINE
288 and COLUMN, that the next character is NEXT-CHAR, at the NEXT-LINE and
289 NEXT-COLUMN, and if one unreads from there, it will be (possibly
290 erroneously) claimed that the character at INDEX is at REWIND-COLUMN.
291 (Restoring a captured place shouldn't get the column wrong -- only
294 The symbol `:eof' means that there is no character at the given INDEX,
295 because the file has already ended. However, EOF has a position which
296 should be correct, and it should be possible to unread from EOF.")
298 (defclass charbuf-position-test (test-case) (scanner))
299 (add-test *sod-test-suite* (get-suite charbuf-position-test))
301 (defmethod set-up ((test charbuf-position-test))
302 (with-slots (scanner) test
303 (let ((stream (make-string-input-stream *position-test-text*)))
304 (setf scanner (make-instance 'charbuf-scanner
306 :filename "<position test>")))))
308 (defun check-position (scanner pos char line column note)
310 (assert-true (scanner-at-eof-p scanner)
311 (format nil "EOF, position ~A (~A)." pos note))
312 (assert-eql char (scanner-current-char scanner)
313 (format nil "Character, position ~A (~A)." pos note)))
314 (assert-eql line (scanner-line scanner)
315 (format nil "Line number, position ~A (~A)." pos note))
316 (assert-eql column (scanner-column scanner)
317 (format nil "Column number, position ~A (~A)." pos note)))
319 (def-test-method test-simple-positions
320 ((test charbuf-position-test) :run nil)
321 (with-slots (scanner) test
322 (loop for prev = 0 then pos
323 for (pos char line column) in *known-positions* do
324 (loop repeat (- pos prev) do (scanner-step scanner))
325 (check-position scanner pos char line column "simple"))))
327 (def-test-method test-rewind-positions
328 ((test charbuf-position-test) :run nil)
329 (with-slots (scanner) test
330 (let ((places (loop for prev = 0 then pos
331 for (pos char line column) in *known-positions* do
332 (skip scanner (- pos prev))
333 (check-position scanner pos char line column "skip")
334 collect (scanner-capture-place scanner))))
335 (loop for place in places
336 for (pos char line column
337 next-char next-line next-column
339 in *known-positions* do
340 (scanner-restore-place scanner place)
341 (check-position scanner pos char line column "rewind")
342 (unless (eq char :eof)
343 (scanner-step scanner)
344 (check-position scanner (1+ pos) next-char
345 next-line next-column "step")
346 (scanner-unread scanner char)
347 (check-position scanner pos char line rewind-column
349 (scanner-step scanner)
350 (check-position scanner (1+ pos) next-char
351 next-line next-column "restep"))))))
353 ;;;----- That's all, folks --------------------------------------------------