1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: compress.lisp
6 ;;;; Purpose: UFFI Example file for zlib compression
7 ;;;; Author: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
14 ;;;; *************************************************************************
16 (in-package #:uffi-tests)
18 (uffi:def-function ("compress" c-compress)
19 ((dest (* :unsigned-char))
26 (defun compress (source)
27 "Returns two values: array of bytes containing the compressed data
28 and the numbe of compressed bytes"
29 (let* ((sourcelen (length source))
30 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
31 (dest (uffi:allocate-foreign-string destsize :unsigned t))
32 (destlen (uffi:allocate-foreign-object :long)))
33 (setf (uffi:deref-pointer destlen :long) destsize)
34 (uffi:with-cstring (source-native source)
35 (let ((result (c-compress dest destlen source-native sourcelen))
36 (newdestlen (uffi:deref-pointer destlen :long)))
39 (values (uffi:convert-from-foreign-string
42 :null-terminated-p nil)
44 (error "zlib error, code ~D" result))
46 (uffi:free-foreign-object destlen)
47 (uffi:free-foreign-object dest)))))))
49 (uffi:def-function ("uncompress" c-uncompress)
50 ((dest (* :unsigned-char))
57 (defun uncompress (source)
58 (let* ((sourcelen (length source))
59 (destsize 200000) ;adjust as needed
60 (dest (uffi:allocate-foreign-string destsize :unsigned t))
61 (destlen (uffi:allocate-foreign-object :long)))
62 (setf (uffi:deref-pointer destlen :long) destsize)
63 (uffi:with-cstring (source-native source)
64 (let ((result (c-uncompress dest destlen source-native sourcelen))
65 (newdestlen (uffi:deref-pointer destlen :long)))
68 (uffi:convert-from-foreign-string
71 :null-terminated-p nil)
72 (error "zlib error, code ~D" result))
74 (uffi:free-foreign-object destlen)
75 (uffi:free-foreign-object dest)))))))
77 (deftest compress.1 (map 'list #'char-code (compress ""))
78 (120 156 3 0 0 0 0 1))
79 (deftest compress.2 (map 'list #'char-code (compress "test"))
80 (120 156 43 73 45 46 1 0 4 93 1 193))
81 (deftest compress.3 (map 'list #'char-code (compress "test2"))
82 (120 156 43 73 45 46 49 2 0 6 80 1 243))
84 (defun compress-uncompress (str)
85 (multiple-value-bind (compressed len) (compress str)
86 (declare (ignore len))
87 (multiple-value-bind (uncompressed len2) (uncompress compressed)
88 (declare (ignore len2))
92 (deftest uncompress.1 "" "")
93 (deftest uncompress.2 "test" "test")
94 (deftest uncompress.3 "test2" "test2")