1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: UFFI Example file to test unions
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
10 ;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; *************************************************************************
16 (uffi:def-union tunion1
24 (let ((u (uffi:allocate-foreign-object 'tunion1)))
25 (setf (uffi:get-slot-value u 'tunion1 'uint)
27 #-(or sparc sparc-v9 powerpc ppc big-endian)
28 (+ (* 1 (char-code #\A))
29 (* 256 (char-code #\B))
30 (* 65536 (char-code #\C))
33 #+(or sparc sparc-v9 powerpc ppc big-endian)
34 (+ (* 16777216 (char-code #\A))
35 (* 65536 (char-code #\B))
36 (* 256 (char-code #\C))
38 (format *standard-output* "~&Should be #\A: ~S"
39 (uffi:ensure-char-character
40 (uffi:get-slot-value u 'tunion1 'char)))
41 ;; (format *standard-output* "~&Should be negative number: ~D"
42 ;; (uffi:get-slot-value u 'tunion1 'int))
43 (format *standard-output* "~&Should be positive number: ~D"
44 (uffi:get-slot-value u 'tunion1 'uint))
45 (uffi:free-foreign-object u))
49 (defun test-union-1 ()
50 (let ((u (uffi:allocate-foreign-object 'tunion1)))
51 (setf (uffi:get-slot-value u 'tunion1 'uint)
52 #-(or sparc sparc-v9 powerpc ppc)
53 (+ (* 1 (char-code #\A))
54 (* 256 (char-code #\B))
55 (* 65536 (char-code #\C))
57 #+(or sparc sparc-v9 powerpc ppc)
58 (+ (* 16777216 (char-code #\A))
59 (* 65536 (char-code #\B))
60 (* 256 (char-code #\C))
61 (* 1 128))) ;set signed bit
62 (util.test:test (uffi:ensure-char-character
63 (uffi:get-slot-value u 'tunion1 'char))
66 :fail-info "Error with union character")
67 #-(or sparc sparc-v9 openmcl digitool)
68 ;; (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
71 ;; "Error with negative int in union")
72 (util.test:test (plusp (uffi:get-slot-value u 'tunion1 'uint))
75 "Error with unsigned int in union")
76 (uffi:free-foreign-object u))