tests/foreign-var.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          foreign-var
   6 ;;;; Purpose:       Tests of foreign variables
   7 ;;;; Authors:       Kevin M. Rosenberg and Edi Weitz
   8 ;;;; Date Started:  Aug 2003
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
  13 ;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package #:uffi-tests)
  17
  18 (def-foreign-var "uchar_13" :unsigned-byte "uffi_tests")
  19 (def-foreign-var "schar_neg_120" :byte "uffi_tests")
  20 (def-foreign-var "uword_257" :unsigned-short "uffi_tests")
  21 (def-foreign-var "sword_neg_321" :short "uffi_tests")
  22 (def-foreign-var "uint_1234567" :int "uffi_tests")
  23 (def-foreign-var "sint_neg_123456" :int "uffi_tests")
  24 (def-foreign-var "float_neg_4_5" :float "uffi_tests")
  25 (def-foreign-var "double_3_1" :double "uffi_tests")
  26
  27 (deftest :fvar.1 uchar-13 13)
  28 (deftest :fvar.2 schar-neg-120 -120)
  29 (deftest :fvar.3 uword-257 257)
  30 (deftest :fvar.4 sword-neg-321 -321)
  31 (deftest :fvar.5 uint-1234567 1234567)
  32 (deftest :fvar.6 sint-neg-123456 -123456)
  33 (deftest :fvar.7 float-neg-4-5 -4.5f0)
  34 (deftest :fvar.8 double-3-1 3.1d0)
  35
  36 (uffi:def-foreign-var ("fvar_addend" *fvar-addend*) :int "uffi_tests")
  37
  38 (uffi:def-struct fvar-struct
  39     (i :int)
  40   (d :double))
  41
  42 (uffi:def-foreign-var ("fvar_struct" *fvar-struct*) fvar-struct
  43   "uffi_tests")
  44
  45 (uffi:def-function ("fvar_struct_int" fvar-struct-int)
  46     ()
  47   :returning :int
  48   :module "uffi_tests")
  49
  50   (uffi:def-function ("fvar_struct_double" fvar-struct-double)
  51       ()
  52     :returning :double
  53     :module "uffi_tests")
  54
  55 (deftest :fvarst.1 *fvar-addend* 3)
  56 (deftest :fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42)
  57 (deftest :fvarst.3 (= (+ *fvar-addend*
  58                         (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i))
  59                      (fvar-struct-int))
  60   t)
  61 (deftest :fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0)
  62 (deftest :fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd)
  63                      (fvar-struct-double))
  64   t)
  65
  66 (deftest fvarst.6
  67     (let ((orig *fvar-addend*))
  68       (incf *fvar-addend* 3)
  69       (prog1
  70           *fvar-addend*
  71         (setf *fvar-addend* orig)))
  72   6)
  73
  74 (deftest fvarst.7
  75     (let ((orig *fvar-addend*))
  76       (incf *fvar-addend* 3)
  77       (prog1
  78           (fvar-struct-int)
  79         (setf *fvar-addend* orig)))
  80   48)
  81
  82 (deftest fvarst.8
  83     (let ((orig (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i)))
  84       (decf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 10)
  85       (prog1
  86           (fvar-struct-int)
  87         (setf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) orig)))
  88   35)