X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Funion.lisp;h=f1f6b781e854af90fbc1178cbfe75d7d425164c8;hb=HEAD;hp=aefbaaf581ea4e81e6717bf9639de6aa9ff951d9;hpb=bdb966b22ea563a7dfa1f464a1b6cb6d8b5a712c;p=uffi.git diff --git a/tests/union.lisp b/tests/union.lisp index aefbaaf..f1f6b78 100644 --- a/tests/union.lisp +++ b/tests/union.lisp @@ -2,23 +2,18 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: union.cl +;;;; Name: union.lisp ;;;; Purpose: UFFI Example file to test unions ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: union.lisp,v 1.4 2003/04/29 14:08:02 kevin Exp $ +;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg ;;;; -;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; UFFI users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package :uffi-tests) +(in-package #:uffi-tests) -(uffi:def-union tunion1 +(uffi:def-union tunion1 (char :char) (int :int) (uint :unsigned-int) @@ -29,21 +24,50 @@ (setf (uffi:get-slot-value *u* 'tunion1 'uint) #-(or sparc sparc-v9 powerpc ppc) (+ (* 1 (char-code #\A)) - (* 256 (char-code #\B)) - (* 65536 (char-code #\C)) - (* 16777216 128)) + (* 256 (char-code #\B)) + (* 65536 (char-code #\C)) + (* 16777216 128)) #+(or sparc sparc-v9 powerpc ppc) (+ (* 16777216 (char-code #\A)) - (* 65536 (char-code #\B)) - (* 256 (char-code #\C)) - (* 1 128))) + (* 65536 (char-code #\B)) + (* 256 (char-code #\C)) + (* 1 128))) + +(deftest :union.1 + (uffi:ensure-char-character + (uffi:get-slot-value *u* 'tunion1 'char)) + #\A) + +(deftest :union.2 + (uffi:ensure-char-integer + (uffi:get-slot-value *u* 'tunion1 'char)) + 65) + +#-(or sparc sparc-v9 openmcl digitool) +(deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t) + + +#-openmcl +(uffi:def-union foo-u + (bar :pointer-self)) + +#-openmcl +(uffi:def-foreign-type foo-u-ptr (* foo-u)) + +;; tests that compilation worked +#-openmcl +(deftest :unions.4 + (with-foreign-object (p 'foo-u) + t) + t) -(deftest union.1 (uffi:ensure-char-character - (uffi:get-slot-value *u* 'tunion1 'char)) #\A) +#-openmcl +(deftest :unions.5 + (progn + (uffi:def-foreign-type foo-union (:union foo-u)) + t) + t) -#-(or sparc sparc-v9 mcl) -(deftest union.2 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t) -;; (uffi:free-foreign-object u))