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 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package #:uffi-tests)
  17
  18 (uffi:def-union tunion1
  19     (char :char)
  20   (int :int)
  21   (uint :unsigned-int)
  22   (sf :float)
  23   (df :double))
  24
  25 (defvar *u* (uffi:allocate-foreign-object 'tunion1))
  26 (setf (uffi:get-slot-value *u* 'tunion1 'uint)
  27       #-(or sparc sparc-v9 powerpc ppc)
  28       (+ (* 1 (char-code #\A))
  29          (* 256 (char-code #\B))
  30          (* 65536 (char-code #\C))
  31          (* 16777216 128))
  32       #+(or sparc sparc-v9 powerpc ppc)
  33       (+ (* 16777216 (char-code #\A))
  34          (* 65536 (char-code #\B))
  35          (* 256 (char-code #\C))
  36          (* 1 128)))
  37
  38 (deftest :union.1
  39     (uffi:ensure-char-character
  40      (uffi:get-slot-value *u* 'tunion1 'char))
  41   #\A)
  42
  43 (deftest :union.2
  44     (uffi:ensure-char-integer
  45      (uffi:get-slot-value *u* 'tunion1 'char))
  46   65)
  47
  48 #-(or sparc sparc-v9 mcl)
  49 (deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
  50
  51
  52 (uffi:def-union foo-u
  53     (bar :pointer-self))
  54
  55 (uffi:def-foreign-type foo-u-ptr (* foo-u))
  56
  57 ;; tests that compilation worked
  58 (deftest :unions.4
  59   (with-foreign-object (p 'foo-u)
  60     t)
  61   t)
  62
  63 (deftest :unions.5
  64     (progn
  65       (uffi:def-foreign-type foo-union (:union foo-u))
  66       t)
  67   t)
  68
  69
  70
  71