tests/fsbv.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; fsbv.lisp --- Tests of foreign structure by value calls.
   4 ;;;
   5 ;;; Copyright (C) 2011, Liam M. Healy
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person
   8 ;;; obtaining a copy of this software and associated documentation
   9 ;;; files (the "Software"), to deal in the Software without
  10 ;;; restriction, including without limitation the rights to use, copy,
  11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  12 ;;; of the Software, and to permit persons to whom the Software is
  13 ;;; furnished to do so, subject to the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  25 ;;; DEALINGS IN THE SOFTWARE.
  26 ;;;
  27
  28 (in-package #:cffi-tests)
  29
  30 ;; Requires struct.lisp
  31
  32 (defcfun "sumpair" :int
  33   (p (:struct struct-pair)))
  34
  35 (defcfun "doublepair" (:struct struct-pair)
  36   (p (:struct struct-pair)))
  37
  38 (defcfun "prodsumpair" :double
  39   (p (:struct struct-pair+double)))
  40
  41 (defcfun "doublepairdouble" (:struct struct-pair+double)
  42   (p (:struct struct-pair+double)))
  43
  44 ;;; Call struct by value
  45 (deftest fsbv.1
  46     (sumpair '(1 . 2))
  47   3)
  48
  49 ;;; Call and return struct by value
  50 (deftest fsbv.2
  51     (doublepair '(1 . 2))
  52   (2 . 4))
  53
  54 ;;; Call recursive structure by value
  55 (deftest fsbv.3
  56     (prodsumpair '(pr (a 4 b 5) dbl 2.5d0))
  57   22.5d0)
  58
  59 ;;; Call and return recursive structure by value
  60 (deftest fsbv.4
  61     (let ((ans (doublepairdouble '(pr (a 4 b 5) dbl 2.5d0))))
  62       (values (getf (getf ans 'pr) 'a)
  63               (getf (getf ans 'pr) 'b)
  64               (getf ans 'dbl)))
  65   8
  66   10
  67   5.0d0)
  68
  69 ;;; Typedef fsbv test
  70
  71 (defcfun ("sumpair" sumpair2) :int
  72   (p struct-pair-typedef1))
  73
  74 (deftest fsbv.5
  75     (sumpair2 '(1 . 2))
  76   3)
  77
  78 ;;; Test ulonglong on no-long-long implementations.
  79
  80 (defcfun "ullsum" :unsigned-long-long
  81   (a :unsigned-long-long) (b :unsigned-long-long))
  82
  83 (deftest fsbv.6
  84     (ullsum #x10DEADBEEF #x2300000000)
  85   #x33DEADBEEF)
  86
  87 ;;; Combine structures by value with a string argument
  88 (defcfun "stringlenpair" (:struct struct-pair)
  89   (s :string)
  90   (p (:struct struct-pair)))
  91
  92 (deftest fsbv.7
  93   (stringlenpair "abc" '(1 . 2))
  94   (3 . 6))