X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Farrays.lisp;h=d03a2efe8aac70e46e85733be500ee283b2bcde6;hb=HEAD;hp=1bc438f623cb6ba2aa853bf03a50d95a58b95dcc;hpb=603822b8bfea96aa4ee6bccec88fb372d84dcc30;p=uffi.git diff --git a/tests/arrays.lisp b/tests/arrays.lisp index 1bc438f..d03a2ef 100644 --- a/tests/arrays.lisp +++ b/tests/arrays.lisp @@ -2,65 +2,54 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: arrays.cl -;;;; Purpose: UFFI Example file to test arrays -;;;; Programmer: Kevin M. Rosenberg +;;;; Name: arrays.lisp +;;;; Purpose: UFFI test arrays +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: arrays.lisp,v 1.2 2002/12/03 06:58:39 kevin Exp $ +;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg ;;;; -;;;; 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) +(in-package #:uffi-tests) (uffi:def-constant +column-length+ 10) (uffi:def-constant +row-length+ 10) -(uffi:def-foreign-type long-ptr '(* :long)) - -(defun test-array-1d () - "Tests vector" - (let ((a (uffi:allocate-foreign-object :long +column-length+))) - (dotimes (i +column-length+) - (setf (uffi:deref-array a '(:array :long) i) (* i i))) - (dotimes (i +column-length+) - (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i))) - (uffi:free-foreign-object a)) - (values)) - -(defun test-array-2d () - "Tests 2d array" - (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+))) - (dotimes (r +row-length+) - (declare (fixnum r)) - (setf (uffi:deref-array a '(:array (* :long)) r) - (uffi:allocate-foreign-object :long +column-length+)) - (let ((col (uffi:deref-array a '(:array (* :long)) r))) - (dotimes (c +column-length+) - (declare (fixnum c)) - (setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c))))) - - (dotimes (r +row-length+) - (declare (fixnum r)) - (format t "~&Row ~D: " r) - (let ((col (uffi:deref-array a '(:array (* :long)) r))) - (dotimes (c +column-length+) - (declare (fixnum c)) - (let ((result (uffi:deref-array col '(:array :long) c))) - (format t "~d " result))))) - - (uffi:free-foreign-object a)) - (values)) - -#+examples-uffi -(test-array-1d) - -#+examples-uffi -(test-array-2d) +(uffi:def-foreign-type long-ptr (* :long)) + +(deftest :array.1 + (let ((a (uffi:allocate-foreign-object :long +column-length+)) + (results nil)) + (dotimes (i +column-length+) + (setf (uffi:deref-array a '(:array :long) i) (* i i))) + (dotimes (i +column-length+) + (push (uffi:deref-array a '(:array :long) i) results)) + (uffi:free-foreign-object a) + (nreverse results)) + (0 1 4 9 16 25 36 49 64 81)) + + +(deftest :array.2 + (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+)) + (results nil)) + (dotimes (r +row-length+) + (declare (fixnum r)) + (setf (uffi:deref-array a '(:array (* :long)) r) + (uffi:allocate-foreign-object :long +column-length+)) + (let ((col (uffi:deref-array a '(:array (* :long)) r))) + (dotimes (c +column-length+) + (declare (fixnum c)) + (setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c))))) + + (dotimes (r +row-length+) + (declare (fixnum r)) + (let ((col (uffi:deref-array a '(:array (* :long)) r))) + (dotimes (c +column-length+) + (declare (fixnum c)) + (push (uffi:deref-array col '(:array :long) c) results)))) + (uffi:free-foreign-object a) + (nreverse results)) + (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99))