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
12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
14 ;;;; *************************************************************************
18 (uffi:def-union tunion1
26 (let ((u (uffi:allocate-foreign-object 'tunion1)))
27 (setf (uffi:get-slot-value u 'tunion1 'uint)
29 #-(or sparc sparc-v9 powerpc ppc big-endian)
30 (+ (* 1 (char-code #\A))
31 (* 256 (char-code #\B))
32 (* 65536 (char-code #\C))
35 #+(or sparc sparc-v9 powerpc ppc big-endian)
36 (+ (* 16777216 (char-code #\A))
37 (* 65536 (char-code #\B))
38 (* 256 (char-code #\C))
40 (format *standard-output* "~&Should be #\A: ~S"
41 (uffi:ensure-char-character
42 (uffi:get-slot-value u 'tunion1 'char)))
43 ;; (format *standard-output* "~&Should be negative number: ~D"
44 ;; (uffi:get-slot-value u 'tunion1 'int))
45 (format *standard-output* "~&Should be positive number: ~D"
46 (uffi:get-slot-value u 'tunion1 'uint))
47 (uffi:free-foreign-object u))
51 (defun test-union-1 ()
52 (let ((u (uffi:allocate-foreign-object 'tunion1)))
53 (setf (uffi:get-slot-value u 'tunion1 'uint)
54 #-(or sparc sparc-v9 powerpc ppc)
55 (+ (* 1 (char-code #\A))
56 (* 256 (char-code #\B))
57 (* 65536 (char-code #\C))
59 #+(or sparc sparc-v9 powerpc ppc)
60 (+ (* 16777216 (char-code #\A))
61 (* 65536 (char-code #\B))
62 (* 256 (char-code #\C))
63 (* 1 128))) ;set signed bit
64 (util.test:test (uffi:ensure-char-character
65 (uffi:get-slot-value u 'tunion1 'char))
68 :fail-info "Error with union character")
69 #-(or sparc sparc-v9 openmcl digitool)
70 ;; (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
73 ;; "Error with negative int in union")
74 (util.test:test (plusp (uffi:get-slot-value u 'tunion1 'uint))
77 "Error with unsigned int in union")
78 (uffi:free-foreign-object u))