1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Tests of foreign variables
7 ;;;; Authors: Kevin M. Rosenberg and Edi Weitz
8 ;;;; Date Started: Aug 2003
12 ;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
14 ;;;; *************************************************************************
16 (in-package #:uffi-tests)
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")
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)
36 (uffi:def-foreign-var ("fvar_addend" *fvar-addend*) :int "uffi_tests")
38 (uffi:def-struct fvar-struct
42 (uffi:def-foreign-var ("fvar_struct" *fvar-struct*) fvar-struct
45 (uffi:def-function ("fvar_struct_int" fvar-struct-int)
50 (uffi:def-function ("fvar_struct_double" fvar-struct-double)
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))
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)
67 (let ((orig *fvar-addend*))
68 (incf *fvar-addend* 3)
71 (setf *fvar-addend* orig)))
75 (let ((orig *fvar-addend*))
76 (incf *fvar-addend* 3)
79 (setf *fvar-addend* orig)))
83 (let ((orig (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i)))
84 (decf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 10)
87 (setf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) orig)))