-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: compress.cl
-;;;; Purpose: UFFI Example file for zlib compression
-;;;; Programmer: 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 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)
-
-(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 :cstring)
- (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)))
- (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)))))))
-
-(uffi:def-function ("uncompress" c-uncompress)
- ((dest (* :unsigned-char))
- (destlen (* :long))
- (source :cstring)
- (source-len :long))
- :returning :int
- :module "zlib")
-
-(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)))
- (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)))))))
-
-#+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")))
-
-#+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
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
+;;;; *************************************************************************\r
+;;;; FILE IDENTIFICATION\r
+;;;;\r
+;;;; Name: compress.lisp\r
+;;;; Purpose: UFFI Example file for zlib compression\r
+;;;; Author: Kevin M. Rosenberg\r
+;;;; Date Started: Feb 2002\r
+;;;;\r
+;;;; $Id: compress.lisp,v 1.12 2003/08/13 18:53:42 kevin Exp $\r
+;;;;\r
+;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg\r
+;;;;\r
+;;;; *************************************************************************\r
+\r
+(in-package #:uffi-tests)\r
+\r
+(uffi:def-function ("compress" c-compress)\r
+ ((dest (* :unsigned-char))\r
+ (destlen (* :long))\r
+ (source :cstring)\r
+ (source-len :long))\r
+ :returning :int\r
+ :module "zlib")\r
+ \r
+(defun compress (source)\r
+ "Returns two values: array of bytes containing the compressed data\r
+ and the numbe of compressed bytes"\r
+ (let* ((sourcelen (length source))\r
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))\r
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
+ (destlen (uffi:allocate-foreign-object :long)))\r
+ (setf (uffi:deref-pointer destlen :long) destsize)\r
+ (uffi:with-cstring (source-native source)\r
+ (let ((result (c-compress dest destlen source-native sourcelen))\r
+ (newdestlen (uffi:deref-pointer destlen :long)))\r
+ (unwind-protect\r
+ (if (zerop result)\r
+ (values (uffi:convert-from-foreign-string \r
+ dest\r
+ :length newdestlen\r
+ :null-terminated-p nil)\r
+ newdestlen)\r
+ (error "zlib error, code ~D" result))\r
+ (progn\r
+ (uffi:free-foreign-object destlen)\r
+ (uffi:free-foreign-object dest)))))))\r
+\r
+(uffi:def-function ("uncompress" c-uncompress)\r
+ ((dest (* :unsigned-char))\r
+ (destlen (* :long))\r
+ (source :cstring)\r
+ (source-len :long))\r
+ :returning :int\r
+ :module "zlib")\r
+\r
+(defun uncompress (source)\r
+ (let* ((sourcelen (length source))\r
+ (destsize 200000) ;adjust as needed\r
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
+ (destlen (uffi:allocate-foreign-object :long)))\r
+ (setf (uffi:deref-pointer destlen :long) destsize)\r
+ (uffi:with-cstring (source-native source)\r
+ (let ((result (c-uncompress dest destlen source-native sourcelen))\r
+ (newdestlen (uffi:deref-pointer destlen :long)))\r
+ (unwind-protect\r
+ (if (zerop result)\r
+ (uffi:convert-from-foreign-string \r
+ dest\r
+ :length newdestlen\r
+ :null-terminated-p nil)\r
+ (error "zlib error, code ~D" result))\r
+ (progn\r
+ (uffi:free-foreign-object destlen)\r
+ (uffi:free-foreign-object dest)))))))\r
+\r
+(deftest compress.1 (map 'list #'char-code (compress ""))\r
+ (120 156 3 0 0 0 0 1))\r
+(deftest compress.2 (map 'list #'char-code (compress "test"))\r
+ (120 156 43 73 45 46 1 0 4 93 1 193))\r
+(deftest compress.3 (map 'list #'char-code (compress "test2"))\r
+ (120 156 43 73 45 46 49 2 0 6 80 1 243))\r
+\r
+(defun compress-uncompress (str)\r
+ (multiple-value-bind (compressed len) (compress str)\r
+ (declare (ignore len))\r
+ (multiple-value-bind (uncompressed len2) (uncompress compressed)\r
+ (declare (ignore len2))\r
+ uncompressed)))\r
+\r
+\r
+(deftest uncompress.1 "" "")\r
+(deftest uncompress.2 "test" "test")\r
+(deftest uncompress.3 "test2" "test2")\r