[flexi-streams-cvs] r34 - branches/edi/test

[eweitz at common-lisp.net]

Author: eweitz
Date: Mon May 19 19:55:12 2008
New Revision: 34

Modified:
   branches/edi/test/test.lisp
Log:
More tests


Modified: branches/edi/test/test.lisp
==============================================================================
--- branches/edi/test/test.lisp	(original)
+++ branches/edi/test/test.lisp	Mon May 19 19:55:12 2008
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.27 2008/05/19 19:47:17 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.28 2008/05/19 23:54:55 edi Exp $
 
 ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz.  All rights reserved.
 
@@ -323,6 +323,64 @@
       (check (string= (old-octets-to-string octets-list :external-format external-format) string))
       (check (equalp (old-string-to-octets string :external-format external-format) octets-vector)))))
 
+(defun sequence-equal (seq1 seq2)
+  "Whether the two sequences have the same elements."
+  (and (= (length seq1) (length seq2))
+       (loop for i below (length seq1)
+             always (eql (elt seq1 i) (elt seq2 i)))))
+
+(defun read-sequence-test (pathspec external-format)
+  "Several tests to confirm that READ-SEQUENCE behaves as expected."
+  (with-test ((format nil "READ-SEQUENCE tests with format ~S."
+                      (flex::normalize-external-format external-format)))
+    (let* ((full-path (merge-pathnames pathspec *this-file*))
+           (file-string (file-as-string full-path external-format))
+           (string-length (length file-string))
+           (octets (file-as-octet-vector full-path))
+           (octet-length (length octets)))
+      (when (external-format-equal external-format (make-external-format :utf8))
+        (with-open-file (in full-path :element-type 'octet)
+          (let* ((in (make-flexi-stream in :external-format external-format))
+                 (list (make-list octet-length)))
+            (setf (flexi-stream-element-type in) 'octet)
+            (read-sequence list in)
+            (check (sequence-equal list octets))))
+        (with-open-file (in full-path :element-type 'octet)
+          (let* ((in (make-flexi-stream in :external-format external-format))
+                 (third (floor octet-length 3))
+                 (half (floor octet-length 2))
+                 (vector (make-array half :element-type 'octet)))
+            (check (sequence-equal (loop repeat third
+                                         collect (read-byte in))
+                                   (subseq octets 0 third)))
+            (read-sequence vector in)
+            (check (sequence-equal vector (subseq octets third (+ third half)))))))
+      (with-open-file (in full-path :element-type 'octet)
+        (let* ((in (make-flexi-stream in :external-format external-format))
+               (string (make-string (- string-length 10) :element-type 'flex::char*)))
+          (setf (flexi-stream-element-type in) 'octet)
+          (check (sequence-equal (loop repeat 10
+                                       collect (read-char in))
+                                 (subseq file-string 0 10)))
+          (read-sequence string in)
+          (check (sequence-equal string (subseq file-string 10)))))
+      (with-open-file (in full-path :element-type 'octet)
+        (let* ((in (make-flexi-stream in :external-format external-format))
+               (list (make-list (- string-length 100))))
+          (check (sequence-equal (loop repeat 100
+                                       collect (read-char in))
+                                 (subseq file-string 0 100)))
+          (read-sequence list in)
+          (check (sequence-equal list (subseq file-string 100)))))
+      (with-open-file (in full-path :element-type 'octet)
+        (let* ((in (make-flexi-stream in :external-format external-format))
+               (array (make-array (- string-length 50))))
+          (check (sequence-equal (loop repeat 50
+                                       collect (read-char in))
+                                 (subseq file-string 0 50)))
+          (read-sequence array in)
+          (check (sequence-equal array (subseq file-string 50))))))))
+
 (defmacro using-values ((&rest values) &body body)
   "Executes BODY and feeds an element from VALUES to the USE-VALUE
 restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled.
@@ -456,17 +514,26 @@
          (no-tests (* 8 (length compare-files-args-list))))
     #+:lispworks
     (setq no-tests (* 2 no-tests))
+    #+(or)
     (dolist (*copy-function* '(copy-stream copy-stream*))
       (dolist (args compare-files-args-list)
         (apply 'compare-files args)))
+    #+(or)
     (let ((string-test-args-list (loop for (file-name symbols) in *test-files*
                                        nconc (create-test-combinations file-name symbols t))))
       (incf no-tests (length string-test-args-list))
       (dolist (args string-test-args-list)
         (apply 'string-test args)))
+    (let ((read-sequence-test-args-list (loop for (file-name symbols) in *test-files*
+                                              nconc (create-test-combinations file-name symbols t))))
+      (incf no-tests (length read-sequence-test-args-list))
+      (dolist (args read-sequence-test-args-list)
+        (apply 'read-sequence-test args)))
     (incf no-tests)
+    #+(or)
     (error-handling-test)
     (incf no-tests)
+    #+(or)
     (unread-char-test)
     (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%"
             (= no-tests *test-success-counter*) (- no-tests *test-success-counter*) no-tests)))