tests/union.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          union.lisp
   6 ;;;; Purpose:       UFFI Example file to test unions
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Mar 2002
   9 ;;;;
  10 ;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package #:uffi-tests)
  15
  16 (uffi:def-union tunion1
  17     (char :char)
  18   (int :int)
  19   (uint :unsigned-int)
  20   (sf :float)
  21   (df :double))
  22
  23 (defvar *u* (uffi:allocate-foreign-object 'tunion1))
  24 (setf (uffi:get-slot-value *u* 'tunion1 'uint)
  25       #-(or sparc sparc-v9 powerpc ppc)
  26       (+ (* 1 (char-code #\A))
  27          (* 256 (char-code #\B))
  28          (* 65536 (char-code #\C))
  29          (* 16777216 128))
  30       #+(or sparc sparc-v9 powerpc ppc)
  31       (+ (* 16777216 (char-code #\A))
  32          (* 65536 (char-code #\B))
  33          (* 256 (char-code #\C))
  34          (* 1 128)))
  35
  36 (deftest :union.1
  37     (uffi:ensure-char-character
  38      (uffi:get-slot-value *u* 'tunion1 'char))
  39   #\A)
  40
  41 (deftest :union.2
  42     (uffi:ensure-char-integer
  43      (uffi:get-slot-value *u* 'tunion1 'char))
  44   65)
  45
  46 #-(or sparc sparc-v9 openmcl digitool)
  47 (deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
  48
  49
  50 #-openmcl
  51 (uffi:def-union foo-u
  52     (bar :pointer-self))
  53
  54 #-openmcl
  55 (uffi:def-foreign-type foo-u-ptr (* foo-u))
  56
  57 ;; tests that compilation worked
  58 #-openmcl
  59 (deftest :unions.4
  60   (with-foreign-object (p 'foo-u)
  61     t)
  62   t)
  63
  64 #-openmcl
  65 (deftest :unions.5
  66     (progn
  67       (uffi:def-foreign-type foo-union (:union foo-u))
  68       t)
  69   t)
  70
  71
  72
  73