;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Mar 2002
;;;;
-;;;; $Id: union.lisp,v 1.3 2002/12/09 16:30:20 kevin Exp $
+;;;; $Id: union.lisp,v 1.4 2003/04/29 14:08:02 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package :cl-user)
+(in-package :uffi-tests)
(uffi:def-union tunion1
(char :char)
(sf :float)
(df :double))
-(defun run-union-1 ()
- (let ((u (uffi:allocate-foreign-object 'tunion1)))
- (setf (uffi:get-slot-value u 'tunion1 'uint)
- ;; little endian
- #-(or sparc sparc-v9 powerpc ppc big-endian)
+(defvar *u* (uffi:allocate-foreign-object 'tunion1))
+(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 255))
- ;; big endian
- #+(or sparc sparc-v9 powerpc ppc big-endian)
+ (* 16777216 128))
+ #+(or sparc sparc-v9 powerpc ppc)
(+ (* 16777216 (char-code #\A))
(* 65536 (char-code #\B))
(* 256 (char-code #\C))
- (* 1 255)))
- (format *standard-output* "~&Should be #\A: ~S"
- (uffi:ensure-char-character
- (uffi:get-slot-value u 'tunion1 'char)))
-;; (format *standard-output* "~&Should be negative number: ~D"
-;; (uffi:get-slot-value u 'tunion1 'int))
- (format *standard-output* "~&Should be positive number: ~D"
- (uffi:get-slot-value u 'tunion1 'uint))
- (uffi:free-foreign-object u))
- (values))
+ (* 1 128)))
-#+test-uffi
-(defun test-union-1 ()
- (let ((u (uffi:allocate-foreign-object 'tunion1)))
- (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))
- #+(or sparc sparc-v9 powerpc ppc)
- (+ (* 16777216 (char-code #\A))
- (* 65536 (char-code #\B))
- (* 256 (char-code #\C))
- (* 1 128))) ;set signed bit
- (util.test:test (uffi:ensure-char-character
- (uffi:get-slot-value u 'tunion1 'char))
- #\A
- :test #'eql
- :fail-info "Error with union character")
- #-(or sparc sparc-v9 mcl)
-;; (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
-;; t
-;; :fail-info
-;; "Error with negative int in union")
- (util.test:test (plusp (uffi:get-slot-value u 'tunion1 'uint))
- t
- :fail-info
- "Error with unsigned int in union")
- (uffi:free-foreign-object u))
- (values))
+(deftest union.1 (uffi:ensure-char-character
+ (uffi:get-slot-value *u* 'tunion1 'char)) #\A)
-#+examples-uffi
-(run-union-1)
+#-(or sparc sparc-v9 mcl)
+(deftest union.2 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
-#+test-uffi
-(test-union-1)
+;; (uffi:free-foreign-object u))
+