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)))