tests/compress.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-\r
   2 ;;;; *************************************************************************\r
   3 ;;;; FILE IDENTIFICATION\r
   4 ;;;;\r
   5 ;;;; Name:          compress.lisp\r
   6 ;;;; Purpose:       UFFI Example file for zlib compression\r
   7 ;;;; Author:        Kevin M. Rosenberg\r
   8 ;;;; Date Started:  Feb 2002\r
   9 ;;;;\r
  10 ;;;; $Id: compress.lisp,v 1.12 2003/08/13 18:53:42 kevin Exp $\r
  11 ;;;;\r
  12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg\r
  13 ;;;;\r
  14 ;;;; *************************************************************************\r
  15 \r
  16 (in-package #:uffi-tests)\r
  17 \r
  18 (uffi:def-function ("compress" c-compress)\r
  19     ((dest (* :unsigned-char))\r
  20      (destlen (* :long))\r
  21      (source :cstring)\r
  22      (source-len :long))\r
  23   :returning :int\r
  24   :module "zlib")\r
  25   \r
  26 (defun compress (source)\r
  27   "Returns two values: array of bytes containing the compressed data\r
  28  and the numbe of compressed bytes"\r
  29   (let* ((sourcelen (length source))\r
  30          (destsize (+ 12 (ceiling (* sourcelen 1.01))))\r
  31          (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
  32          (destlen (uffi:allocate-foreign-object :long)))\r
  33     (setf (uffi:deref-pointer destlen :long) destsize)\r
  34     (uffi:with-cstring (source-native source)\r
  35       (let ((result (c-compress dest destlen source-native sourcelen))\r
  36             (newdestlen (uffi:deref-pointer destlen :long)))\r
  37         (unwind-protect\r
  38             (if (zerop result)\r
  39                 (values (uffi:convert-from-foreign-string \r
  40                          dest\r
  41                          :length newdestlen\r
  42                          :null-terminated-p nil)\r
  43                         newdestlen)\r
  44               (error "zlib error, code ~D" result))\r
  45           (progn\r
  46             (uffi:free-foreign-object destlen)\r
  47             (uffi:free-foreign-object dest)))))))\r
  48 \r
  49 (uffi:def-function ("uncompress" c-uncompress)\r
  50     ((dest (* :unsigned-char))\r
  51      (destlen (* :long))\r
  52      (source :cstring)\r
  53      (source-len :long))\r
  54   :returning :int\r
  55   :module "zlib")\r
  56 \r
  57 (defun uncompress (source)\r
  58   (let* ((sourcelen (length source))\r
  59          (destsize 200000)  ;adjust as needed\r
  60          (dest (uffi:allocate-foreign-string destsize :unsigned t))\r
  61          (destlen (uffi:allocate-foreign-object :long)))\r
  62     (setf (uffi:deref-pointer destlen :long) destsize)\r
  63     (uffi:with-cstring (source-native source)\r
  64       (let ((result (c-uncompress dest destlen source-native sourcelen))\r
  65             (newdestlen (uffi:deref-pointer destlen :long)))\r
  66         (unwind-protect\r
  67              (if (zerop result)\r
  68                  (uffi:convert-from-foreign-string \r
  69                   dest\r
  70                   :length newdestlen\r
  71                   :null-terminated-p nil)\r
  72                  (error "zlib error, code ~D" result))\r
  73           (progn\r
  74             (uffi:free-foreign-object destlen)\r
  75             (uffi:free-foreign-object dest)))))))\r
  76 \r
  77 (deftest compress.1 (map 'list #'char-code (compress ""))\r
  78   (120 156 3 0 0 0 0 1))\r
  79 (deftest compress.2 (map 'list #'char-code  (compress "test"))\r
  80   (120 156 43 73 45 46 1 0 4 93 1 193))\r
  81 (deftest compress.3 (map 'list #'char-code (compress "test2"))\r
  82   (120 156 43 73 45 46 49 2 0 6 80 1 243))\r
  83 \r
  84 (defun compress-uncompress (str)\r
  85   (multiple-value-bind (compressed len) (compress str)\r
  86     (declare (ignore len))\r
  87     (multiple-value-bind (uncompressed len2) (uncompress compressed)\r
  88       (declare (ignore len2))\r
  89       uncompressed)))\r
  90 \r
  91 \r
  92 (deftest uncompress.1 "" "")\r
  93 (deftest uncompress.2 "test" "test")\r
  94 (deftest uncompress.3 "test2" "test2")\r