X-Git-Url: http://git.kpe.io/?p=uffi.git;a=blobdiff_plain;f=examples%2Fc-test-fns.lisp;h=14fca333cb349a5f5eb6393971c71357bee2eef7;hp=c21b39c6e5717bcfca31da2a9ce52062fcb13b3b;hb=b86fdf882156aa45dc6e8e93a158dedf506f4233;hpb=a95b9a217335917d96b8c0cced4f49c3e4846115 diff --git a/examples/c-test-fns.lisp b/examples/c-test-fns.lisp index c21b39c..14fca33 100644 --- a/examples/c-test-fns.lisp +++ b/examples/c-test-fns.lisp @@ -7,21 +7,16 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: c-test-fns.lisp,v 1.1 2002/09/30 10:02:36 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) -(unless (uffi:load-foreign-library - (uffi:find-foreign-library "c-test-fns" *load-truename*) - :supporting-libraries '("c") - :force-load t) +(unless (uffi:load-foreign-library + (uffi:find-foreign-library "c-test-fns" + (list *load-truename* "/home/kevin/debian/src/uffi/examples/")) + :supporting-libraries '("c")) (warn "Unable to load c-test-fns library")) (uffi:def-function ("cs_to_upper" cs-to-upper) @@ -51,10 +46,10 @@ (uffi:def-constant +double-vec-length+ 10) (defun test-half-double-vector () (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+)) - results) + results) (dotimes (i +double-vec-length+) - (setf (uffi:deref-array vec '(:array :double) i) - (coerce i 'double-float))) + (setf (uffi:deref-array vec '(:array :double) i) + (coerce i 'double-float))) (half-double-vector +double-vec-length+ vec) (dotimes (i +double-vec-length+) (push (uffi:deref-array vec '(:array :double) i) results)) @@ -68,7 +63,7 @@ (half-double-vector +double-vec-length+ vec) vec)) -#+cmu +#+(or cmu scl) (defun t3 () (let ((vec (make-array +double-vec-length+ :element-type 'double-float))) (dotimes (i +double-vec-length+) @@ -76,22 +71,22 @@ (system:without-gcing (half-double-vector +double-vec-length+ (system:vector-sap vec))) vec)) - + #+examples-uffi -(format t "~&(string-to-upper \"this is a test\") => ~A" - (string-to-upper "this is a test")) +(format t "~&(string-to-upper \"this is a test\") => ~A" + (string-to-upper "this is a test")) #+examples-uffi -(format t "~&(string-to-upper nil) => ~A" - (string-to-upper nil)) +(format t "~&(string-to-upper nil) => ~A" + (string-to-upper nil)) #+examples-uffi -(format t "~&(string-count-upper \"This is a Test\") => ~A" - (string-count-upper "This is a Test")) +(format t "~&(string-count-upper \"This is a Test\") => ~A" + (string-count-upper "This is a Test")) #+examples-uffi -(format t "~&(string-count-upper nil) => ~A" - (string-count-upper nil)) +(format t "~&(string-count-upper nil) => ~A" + (string-count-upper nil)) #+examples-uffi (format t "~&Half vector: ~S" (test-half-double-vector)) @@ -102,20 +97,20 @@ (progn (util.test:test (string= (string-to-upper "this is a test") "THIS IS A TEST") t - :test #'eql - :fail-info "Error with string-to-upper") + :test #'eql + :fail-info "Error with string-to-upper") (util.test:test (string-to-upper nil) nil - :fail-info "string-to-upper with nil failed") + :fail-info "string-to-upper with nil failed") (util.test:test (string-count-upper "This is a Test") - 2 - :test #'eql - :fail-info "Error with string-count-upper") + 2 + :test #'eql + :fail-info "Error with string-count-upper") (util.test:test (string-count-upper nil) -1 - :test #'eql - :fail-info "string-count-upper with nil failed") + :test #'eql + :fail-info "string-count-upper with nil failed") (util.test:test (test-half-double-vector) - '(0.0d0 0.5d0 1.0d0 1.5d0 2.0d0 2.5d0 3.0d0 3.5d0 4.0d0 4.5d0) - :test #'equal - :fail-info "Error comparing half-double-vector") + '(0.0d0 0.5d0 1.0d0 1.5d0 2.0d0 2.5d0 3.0d0 3.5d0 4.0d0 4.5d0) + :test #'equal + :fail-info "Error comparing half-double-vector") )