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
10 ;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; *************************************************************************
14 (in-package #:uffi-tests)
16 (uffi:def-function ("compress" c-compress)
17 ((dest (* :unsigned-char))
24 (defun compress (source)
25 "Returns two values: array of bytes containing the compressed data
26 and the numbe of compressed bytes"
27 (let* ((sourcelen (length source))
28 (destsize (+ 12 (ceiling (* sourcelen 1.01))))
29 (dest (uffi:allocate-foreign-string destsize :unsigned t))
30 (destlen (uffi:allocate-foreign-object :long)))
31 (setf (uffi:deref-pointer destlen :long) destsize)
32 (uffi:with-cstring (source-native source)
33 (let ((result (c-compress dest destlen source-native sourcelen))
34 (newdestlen (uffi:deref-pointer destlen :long)))
37 (values (uffi:convert-from-foreign-usb8
40 (error "zlib error, code ~D" result))
42 (uffi:free-foreign-object destlen)
43 (uffi:free-foreign-object dest)))))))
45 (uffi:def-function ("uncompress" c-uncompress)
46 ((dest (* :unsigned-char))
53 (defun uncompress (source)
54 (let* ((sourcelen (length source))
55 (destsize 200000) ;adjust as needed
56 (dest (uffi:allocate-foreign-string destsize :unsigned t))
57 (destlen (uffi:allocate-foreign-object :long)))
58 (setf (uffi:deref-pointer destlen :long) destsize)
59 (uffi:with-cstring (source-native source)
60 (let ((result (c-uncompress dest destlen source-native sourcelen))
61 (newdestlen (uffi:deref-pointer destlen :long)))
64 (uffi:convert-from-foreign-string
67 :null-terminated-p nil)
68 (error "zlib error, code ~D" result))
70 (uffi:free-foreign-object destlen)
71 (uffi:free-foreign-object dest)))))))
73 (deftest :compress.1 (compress "")
74 #(120 156 3 0 0 0 0 1) 8)
75 (deftest :compress.2 (compress "test")
76 #(120 156 43 73 45 46 1 0 4 93 1 193) 12)
77 (deftest :compress.3 (compress "test2")
78 #(120 156 43 73 45 46 49 2 0 6 80 1 243) 13)
80 (defun compress-uncompress (str)
81 (multiple-value-bind (compressed len) (compress str)
82 (declare (ignore len))
83 (multiple-value-bind (uncompressed len2) (uncompress compressed)
84 (declare (ignore len2))
88 (deftest :uncompress.1 "" "")
89 (deftest :uncompress.2 "test" "test")
90 (deftest :uncompress.3 "test2" "test2")