-;;;; -*- 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.11 2003/05/02 02:50:12 kevin Exp $\r
-;;;;\r
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg\r
-;;;;\r
-;;;; UFFI users are granted the rights to distribute and use this software\r
-;;;; as governed by the terms of the Lisp Lesser GNU Public License\r
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.\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
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.lisp
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id$
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(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-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))
+ (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)))))))
+
+(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)
+
+(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)))
+
+
+(deftest :uncompress.1 "" "")
+(deftest :uncompress.2 "test" "test")
+(deftest :uncompress.3 "test2" "test2")
projects / uffi.git / blobdiff