;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: compress.cl
+;;;; Name: compress.lisp
;;;; Purpose: UFFI Example file for zlib compression
-;;;; Programmer: Kevin M. Rosenberg
+;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: compress.lisp,v 1.3 2002/12/09 16:30:20 kevin Exp $
+;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package :cl-user)
+(in-package #:uffi-tests)
-(eval-when (:load-toplevel :execute)
- (unless (uffi:load-foreign-library
- #-(or macosx darwin)
- (uffi:find-foreign-library
- "libz"
- '("/usr/local/lib/" "/usr/lib/" "/zlib/")
- :types '("so" "a"))
- #+(or macosx darwin)
- (uffi:find-foreign-library "z"
- `(,(pathname-directory *load-pathname*)))
- :module "zlib"
- :supporting-libraries '("c"))
- (warn "Unable to load zlib")))
-
(uffi:def-function ("compress" c-compress)
((dest (* :unsigned-char))
(destlen (* :long))
(source-len :long))
:returning :int
:module "zlib")
-
+
(defun compress (source)
"Returns two values: array of bytes containing the compressed data
and the numbe of compressed bytes"
(let* ((sourcelen (length source))
- (destsize (+ 12 (ceiling (* sourcelen 1.01))))
- (dest (uffi:allocate-foreign-string destsize :unsigned t))
- (destlen (uffi:allocate-foreign-object :long)))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
(setf (uffi:deref-pointer destlen :long) destsize)
(uffi:with-cstring (source-native source)
(let ((result (c-compress dest destlen source-native sourcelen))
- (newdestlen (uffi:deref-pointer destlen :long)))
- (unwind-protect
- (if (zerop result)
- (values (uffi:convert-from-foreign-string
- dest
- :length newdestlen
- :null-terminated-p nil)
- newdestlen)
- (error "zlib error, code ~D" result))
- (progn
- (uffi:free-foreign-object destlen)
- (uffi:free-foreign-object dest)))))))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-usb8
+ dest newdestlen)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
(uffi:def-function ("uncompress" c-uncompress)
((dest (* :unsigned-char))
(defun uncompress (source)
(let* ((sourcelen (length source))
- (destsize 200000) ;adjust as needed
- (dest (uffi:allocate-foreign-string destsize :unsigned t))
- (destlen (uffi:allocate-foreign-object :long)))
+ (destsize 200000) ;adjust as needed
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
(setf (uffi:deref-pointer destlen :long) destsize)
(uffi:with-cstring (source-native source)
(let ((result (c-uncompress dest destlen source-native sourcelen))
- (newdestlen (uffi:deref-pointer destlen :long)))
- (unwind-protect
- (if (zerop result)
- (uffi:convert-from-foreign-string
- dest
- :length newdestlen
- :null-terminated-p nil)
- (error "zlib error, code ~D" result))
- (progn
- (uffi:free-foreign-object destlen)
- (uffi:free-foreign-object dest)))))))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(deftest :compress.1 (compress "")
+ #(120 156 3 0 0 0 0 1) 8)
+(deftest :compress.2 (compress "test")
+ #(120 156 43 73 45 46 1 0 4 93 1 193) 12)
+(deftest :compress.3 (compress "test2")
+ #(120 156 43 73 45 46 49 2 0 6 80 1 243) 13)
-#+examples-uffi
-(progn
- (flet ((print-results (str)
- (multiple-value-bind (compressed len) (compress str)
- (format t "~&(compress ~S) => " str)
- (dotimes (i len)
- (format t "~X" (char-code (char compressed i))))
- (format t ",~D" len))))
- (print-results "")
- (print-results "test")
- (print-results "test2")))
+(defun compress-uncompress (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (declare (ignore len))
+ (multiple-value-bind (uncompressed len2) (uncompress compressed)
+ (declare (ignore len2))
+ uncompressed)))
-#+test-uffi
-(progn
- (flet ((test-compress (str)
- (multiple-value-bind (compressed len) (compress str)
- (multiple-value-bind (uncompressed len2) (uncompress compressed)
- (util.test:test str uncompressed :test #'string=
- :fail-info "Error uncompressing a compressed string")))))
- (test-compress "")
- (test-compress "test")
- (test-compress "test2")))
-;; Results of the above on my system:
-;; (compress "") => 789c300001,8
-;; (compress "test") => 789c2b492d2e1045d1c1,12
-;; (compress "test2") => 789c2b492d2e31206501f3,13
+(deftest :uncompress.1 "" "")
+(deftest :uncompress.2 "test" "test")
+(deftest :uncompress.3 "test2" "test2")