Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

rfe10416: add minimal tests suite

Move test functions jkf wrote from deflate.cl to t-gzip.cl.

Change-Id: Ia8ee1070000499844c0527c9be5fd103405a7d75
  • Loading branch information...
commit 8045482efdabc5dcf63e47d8368e398a8b5e0373 1 parent 9c69a73
@dklayer dklayer authored
Showing with 73 additions and 27 deletions.
  1. +2 −27 deflate.cl
  2. +71 −0 t-gzip.cl
View
29 deflate.cl
@@ -60,6 +60,8 @@
(defvar *zlib-dll-loaded* nil)
+(eval-when (compile load eval) (require :util-string))
+
(if* (not *zlib-dll-loaded*)
then (handler-case
@@ -491,33 +493,6 @@ condition: ~a~%" c)))
-;;;;;;;;; test code
-
-(defun deflate-file (input-filename output-filename)
- (with-open-file (in input-filename :direction :input)
- (with-open-file (out output-filename
- :direction :output
- :if-exists :supersede)
- (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8)))
- (deflate (make-instance 'deflate-stream
- :target out
- :compression :gzip)))
- (loop
- (let ((bytes (read-vector buffer in)))
-
- (if* (zerop bytes) then (return))
-
- (let ((pos 0))
-
- (loop
- (setq pos (write-vector buffer deflate :start pos :end bytes))
- (if* (>= pos bytes) then (return)))
- )))
-
- ; finish compression
- (close deflate)))))
-
-
;; we'll resource the buffers we need to speed up allocation
View
71 t-gzip.cl
@@ -0,0 +1,71 @@
+;; copyright (c) 2011 Franz Inc, Oakland, CA - All rights reserved.
+;;
+;; The software, data and information contained herein are proprietary
+;; to, and comprise valuable trade secrets of, Franz, Inc. They are
+;; given in confidence by Franz, Inc. pursuant to a written license
+;; agreement, and may be stored and used only in accordance with the terms
+;; of such license.
+;;
+;; Restricted Rights Legend
+;; ------------------------
+;; Use, duplication, and disclosure of the software, data and information
+;; contained herein by any agency, department or entity of the U.S.
+;; Government are subject to restrictions of Restricted Rights for
+;; Commercial Software developed at private expense as specified in
+;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
+
+(eval-when (compile load eval)
+ (require :deflate)
+ (require :test))
+
+(in-package :test)
+
+(defun deflate-file (input-filename output-filename)
+ (with-open-file (in input-filename :direction :input)
+ (with-open-file (out output-filename
+ :direction :output
+ :if-exists :supersede)
+ (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8)))
+ (deflate (make-instance 'util.zip::deflate-stream
+ :target out
+ :compression :gzip)))
+ (loop
+ (let ((bytes (read-vector buffer in)))
+
+ (if* (zerop bytes) then (return))
+
+ (let ((pos 0))
+
+ (loop
+ (setq pos (write-vector buffer deflate :start pos :end bytes))
+ (if* (>= pos bytes) then (return)))
+ )))
+
+ ; finish compression
+ (close deflate)))))
+
+(defun deflate-test (input-filename)
+ ;; compress input-file to temp-file1, uncompress it back to temp-file2
+ ;; and compare temp-file2 to input-filename, error if not same.
+ (let (temp-file1 temp-file2)
+ (unwind-protect
+ (progn
+ (setq temp-file1 (sys:make-temp-file-name "deflate1x"))
+ (setq temp-file2 (sys:make-temp-file-name "deflate2x"))
+ (format t "; compress test on ~a~%"
+ (enough-namestring input-filename))
+ (deflate-file input-filename temp-file1)
+ ;;(format t "; uncompress ~a to ~a~%" temp-file1 temp-file2)
+ (or (eql 0 (run-shell-command
+ (format nil "gunzip -d < ~a > ~a"
+ temp-file1 temp-file2)))
+ (error "gunzip failed on ~a" temp-file1))
+ ;;(format t "; compare ~a to ~a~%" input-filename temp-file2)
+ (test-t (excl::compare-files input-filename temp-file2)))
+ (when temp-file1 (ignore-errors (delete-file temp-file1)))
+ (when temp-file2 (ignore-errors (delete-file temp-file2))))))
+
+(defun test-gzip ()
+ (map-over-directory (lambda (p) (deflate-test p)) "./" :recurse nil))
+
+(when *do-test* (do-test "gzip" #'test-gzip))
Please sign in to comment.
Something went wrong with that request. Please try again.