X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=examples%2Funion.cl;fp=examples%2Funion.cl;h=0000000000000000000000000000000000000000;hb=a95b9a217335917d96b8c0cced4f49c3e4846115;hp=fc14c4a7c251d67b01fff40cb0852a73d269d7e1;hpb=bcd9fb3deb580f2976e7505a7433795ed6ad1bb3;p=uffi.git diff --git a/examples/union.cl b/examples/union.cl deleted file mode 100644 index fc14c4a..0000000 --- a/examples/union.cl +++ /dev/null @@ -1,89 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: union.cl -;;;; Purpose: UFFI Example file to test unions -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Mar 2002 -;;;; -;;;; $Id: union.cl,v 1.10 2002/09/29 17:31:20 kevin Exp $ -;;;; -;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; UFFI users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -(in-package :cl-user) - -(uffi:def-union tunion1 - (char :char) - (int :int) - (uint :unsigned-int) - (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) - (+ (* 1 (char-code #\A)) - (* 256 (char-code #\B)) - (* 65536 (char-code #\C)) - (* 16777216 128)) - ;; big endian - #+(or sparc sparc-v9 powerpc ppc) - (+ (* 16777216 (char-code #\A)) - (* 65536 (char-code #\B)) - (* 256 (char-code #\C)) - (* 1 128))) - (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)) - -#+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)) - -#+examples-uffi -(run-union-1) - - -#+test-uffi -(test-union-1)