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

[eweitz at common-lisp.net]

Author: eweitz
Date: Sat May 10 11:18:54 2008
New Revision: 16

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	Sat May 10 11:18:54 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.17 2007/12/29 22:58:44 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.19 2008/05/10 14:32:13 edi Exp $
 
 ;;; Copyright (c) 2006-2007, Dr. Edmund Weitz.  All rights reserved.
 
@@ -89,13 +89,17 @@
                                            (append args `(:eol-style ,eol-style
                                                           :little-endian ,little-endian))))))))
 
-(defun create-test-combinations (file-name symbols)
-  "For a name suffix FILE-NAME and a list of symbols SYMBOLS
-denoting different encodings of the corresponding file returns a
-list of lists which can be used as arglists for COMPARE-FILES."
+(defun create-test-combinations (file-name symbols &optional simplep)
+  "For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting
+different encodings of the corresponding file returns a list of lists
+which can be used as arglists for COMPARE-FILES.  If SIMPLEP is true,
+a list which can be used for the string tests below is returned."
   (let ((file-variants (loop for symbol in symbols
                              nconc (create-file-variants file-name symbol))))
     (loop for (name-in . external-format-in) in file-variants
+          when simplep
+          collect (list name-in external-format-in)
+          else
           nconc (loop for (name-out . external-format-out) in file-variants
                       collect (list name-in external-format-in name-out external-format-out)))))
                       
@@ -200,6 +204,27 @@
         #+:lispworks
         (terpri *error-output*)))))
 
+(defun file-as-octet-vector (pathspec)
+  "Returns the contents of the file denoted by PATHSPEC as a vector of
+octets."
+  (with-open-file (in pathspec :element-type 'octet)
+    (let ((vector (make-array (file-length in) :element-type 'octet)))
+      (read-sequence vector in)
+      vector)))
+
+(defun file-as-string (pathspec external-format)
+  "Reads the contents of the file denoted by PATHSPEC using the
+external format EXTERNAL-FORMAT and returns the result as a string."
+  (with-open-file (in pathspec :element-type 'octet)
+    (let* ((number-of-octets (file-length in))
+           (in (make-flexi-stream in :external-format external-format))
+           (string (make-array number-of-octets
+                               :element-type #+:lispworks 'lw:simple-char
+                                             #-:lispworks 'character
+                               :fill-pointer t)))
+      (setf (fill-pointer string) (read-sequence string in))
+      string)))
+
 (defmacro with-test ((test-description) &body body)
   "Defines a test.  Two utilities are available inside of the body of
 the maco: The function FAIL, and the macro CHECK.  FAIL, the lowest
@@ -231,6 +256,21 @@
            (terpri *error-output*))
          ,successp))))
 
+(defun string-test (pathspec external-format)
+  "Tests whether conversion from strings to octets and vice versa
+using the external format EXTERNAL-FORMAT works as expected, using the
+contents of the file denoted by PATHSPEC as test data and assuming
+that the stream conversion functions work."
+  (let* ((full-path (merge-pathnames pathspec *this-file*))
+         (octets-vector (file-as-octet-vector full-path))
+         (octets-list (coerce octets-vector 'list))
+         (string (file-as-string full-path external-format)))
+    (with-test ((format nil "String tests with format ~S."
+                        (flex::normalize-external-format external-format)))
+      (check (string= (octets-to-string octets-vector :external-format external-format) string))
+      (check (string= (octets-to-string octets-list :external-format external-format) string))
+      (check (equalp (string-to-octets string :external-format external-format) octets-vector)))))
+
 (defmacro using-values ((&rest values) &body body)
   "Executes BODY and feeds an element from VALUES to the USE-VALUE
 restart each time a FLEXI-STREAM-ENCODING-ERROR is signalled.  Signals
@@ -262,6 +302,9 @@
 (defun encoding-error-handling-test ()
   "Tests several possible encoding errors and how they are handled."
   (with-test ("Handling of encoding errors.")
+    ;; handling of EOF in the middle of CRLF
+    (check (string= #.(string #\Return)
+                    (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf))))
     (let ((*substitution-char* #\?))
       ;; :ASCII doesn't have characters with char codes > 127
       (check (string= "a??" (read-flexi-line `(,(char-code #\a) 128 200) :ascii)))
@@ -326,13 +369,18 @@
 CREATE-TEST-COMBINATIONS, runs test for handling of encoding errors,
 and shows simple statistics at the end."
   (let* ((*test-success-counter* 0)
-         (args-list (loop for (file-name symbols) in *test-files*
-                          nconc (create-test-combinations file-name symbols)))
-         (no-tests (* 4 (length args-list))))
+         (compare-files-args-list (loop for (file-name symbols) in *test-files*
+                                        nconc (create-test-combinations file-name symbols)))
+         (no-tests (* 4 (length compare-files-args-list))))
     #+:lispworks
     (setq no-tests (* 2 no-tests))
-    (dolist (args args-list)
-      (apply #'compare-files args))
+    (dolist (args compare-files-args-list)
+      (apply 'compare-files args))
+    (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)))
     (incf no-tests)
     (encoding-error-handling-test)
     (incf no-tests)