X-Git-Url: http://git.kpe.io/?p=uffi.git;a=blobdiff_plain;f=tests%2Fcompress.lisp;h=d6f5178fc4ea4b9ebb3d7df1c8068f219226c24e;hp=02c8cd292fe5500a655f48bff9ee87c368856a47;hb=b86fdf882156aa45dc6e8e93a158dedf506f4233;hpb=35ddd15fad42a60b445284900020d5b5a7edad8c diff --git a/tests/compress.lisp b/tests/compress.lisp index 02c8cd2..d6f5178 100644 --- a/tests/compress.lisp +++ b/tests/compress.lisp @@ -1,119 +1,90 @@ -;;;; -*- 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.4 2003/03/10 17:37:05 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) - (let ((*print-length* nil)) - (format t "~&(compress ~S) => " str) - (format t "~S~%" (map 'list #'char-code compressed)))))) - (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 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: compress.lisp +;;;; Purpose: UFFI Example file for zlib compression +;;;; Author: Kevin M. Rosenberg +;;;; Date Started: Feb 2002 +;;;; +;;;; This file, part of UFFI, is Copyright (c) 2002-2010 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")