From 32a1ec81381452961a16a0dea1aff5711d4a3ed0 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 30 Apr 2003 13:48:34 +0000 Subject: [PATCH] r4718: *** empty log message *** --- tests/arrays.lisp | 82 ++++++++++++++++++++++------------------------- uffi-tests.asd | 3 +- 2 files changed, 40 insertions(+), 45 deletions(-) diff --git a/tests/arrays.lisp b/tests/arrays.lisp index 1bc438f..1775f52 100644 --- a/tests/arrays.lisp +++ b/tests/arrays.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; 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 $ +;;;; $Id: arrays.lisp,v 1.3 2003/04/30 13:48:34 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -16,51 +16,45 @@ ;;;; (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) +(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) + 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) + 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)) diff --git a/uffi-tests.asd b/uffi-tests.asd index 6ecea17..f5ff0c9 100644 --- a/uffi-tests.asd +++ b/uffi-tests.asd @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: uffi-tests.asd,v 1.4 2003/04/29 14:08:02 kevin Exp $ +;;;; $Id: uffi-tests.asd,v 1.5 2003/04/30 13:48:34 kevin Exp $ ;;;; ************************************************************************* (defpackage #:uffi-tests-system @@ -27,6 +27,7 @@ (:file "getenv" :depends-on ("package")) (:file "gethostname" :depends-on ("package")) (:file "union" :depends-on ("package")) + (:file "arrays" :depends-on ("package")) (:file "uffi-c-test-lib" :depends-on ("package")) )))) -- 2.34.1