From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Tue, 29 Apr 2003 14:08:02 +0000 (+0000)
Subject: r4703: *** empty log message ***
X-Git-Tag: v1.6.1~226
X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=bdb966b22ea563a7dfa1f464a1b6cb6d8b5a712c

r4703: *** empty log message ***
---

diff --git a/debian/rules b/debian/rules
index c83af85..a96513c 100755
--- a/debian/rules
+++ b/debian/rules
@@ -61,7 +61,7 @@ install: build
 	dh_installdirs -p $(debpkg-tests) $(clc-tests)/tests $(lib-dir)
 	dh_install -p $(debpkg-tests) $(pkg-tests).asd $(clc-tests)
 	dh_install -p $(debpkg-tests) "tests/*.lisp" $(clc-tests)/tests
-	dh_install -p $(debpkg-tests) "tests/c-test-fns.so" $(lib-dir)
+	dh_install -p $(debpkg-tests) "tests/uffi-c-test-lib.so" $(lib-dir)
 	dh_link -p $(debpkg-tests) $(clc-tests)/$(pkg-tests).asd $(clc-systems)/$(pkg-tests).asd
 
 # Build architecture-independent files here.
diff --git a/tests/Makefile b/tests/Makefile
index 3a4d2e9..88fda03 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -5,7 +5,7 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.19 2003/04/29 12:42:03 kevin Exp $
+#  CVS Id:   $Id: Makefile,v 1.20 2003/04/29 14:08:02 kevin Exp $
 #
 # This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 #
@@ -21,7 +21,7 @@ include ../Makefile.common
 distclean: clean
 
 
-base=c-test-fns
+base=uffi-c-test-lib
 source=$(base).c
 object=$(base).o
 shared_lib=$(base).so
@@ -32,7 +32,7 @@ all: $(shared_lib)
 linux: $(source) Makefile
 	gcc -fPIC -DPIC -c $(source) -o $(object)
 	gcc -shared $(object) -o $(shared_lib)
-	#gcc -shared -Wl,-soname,c-test-fns $(object) -o $(shared_lib)
+	#gcc -shared -Wl,-soname,uffi-c-test-lib $(object) -o $(shared_lib)
 	rm $(object)
 
 mac:
diff --git a/tests/c-test-fns.c b/tests/c-test-fns.c
deleted file mode 100644
index 20a5c2f..0000000
--- a/tests/c-test-fns.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/***************************************************************************
- * FILE IDENTIFICATION
- *  
- *  Name:         c-test-fns.c
- *  Purpose:      Test functions in C for UFFI library
- *  Programer:    Kevin M. Rosenberg
- *  Date Started: Mar 2002
- *
- *  CVS Id:   $Id: c-test-fns.c,v 1.5 2002/03/21 10:06:52 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.
-
- * These variables are correct for GCC
- * you'll need to modify these for other compilers
- ***************************************************************************/
-
-#ifdef WIN32
-#include <windows.h>
-
-BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll,
-                          DWORD fdwReason,
-                          LPVOID lpvReserved)
-{
-        return 1;
-}
-       
-#define DLLEXPORT __declspec(dllexport)
-
-#else
-#define DLLEXPORT 
-#endif
-
-#include <ctype.h>
-#include <stdlib.h>
-#include <math.h>
-
-
-/* Test of constant input string */
-DLLEXPORT
-int
-cs_count_upper (char* psz)
-{
-  int count = 0;
-
-  if (psz) {
-    while (*psz) {
-      if (isupper (*psz))
-	++count;
-      ++psz;
-    }
-    return count;
-  } else 
-    return -1;
-}
-
-/* Test of input and output of a string */
-DLLEXPORT
-void
-cs_to_upper (char* psz)
-{
-  if (psz) {
-    while (*psz) {
-      *psz = toupper (*psz);
-      ++psz;
-    }
-  }
-}
-
-/* Test of an output only string */
-DLLEXPORT
-void
-cs_make_random (int size, char* buffer)
-{
-  int i;
-  for (i = 0; i < size; i++)
-    buffer[i] = 'A' + (rand() % 26);
-}
-
-    
-/* Test of input/output vector */
-DLLEXPORT
-void
-half_double_vector (int size, double* vec)
-{
-  int i;
-  for (i = 0; i < size; i++)
-    vec[i] /= 2.;
-}
-
-    
-
diff --git a/tests/c-test-fns.lisp b/tests/c-test-fns.lisp
deleted file mode 100644
index 4ff8fb9..0000000
--- a/tests/c-test-fns.lisp
+++ /dev/null
@@ -1,121 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          c-test-fns.cl
-;;;; Purpose:       UFFI Example file for zlib compression
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: c-test-fns.lisp,v 1.4 2002/11/18 04:53:31 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)
-
-(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)
-  ((input (* :unsigned-char)))
-  :returning :void
-  )
-
-(defun string-to-upper (str)
-  (uffi:with-foreign-string (str-foreign str)
-    (cs-to-upper str-foreign)
-    (uffi:convert-from-foreign-string str-foreign)))
-
-(uffi:def-function ("cs_count_upper" cs-count-upper)
-  ((input :cstring))
-  :returning :int
-  )
-
-(defun string-count-upper (str)
-  (uffi:with-cstring (str-cstring str)
-    (cs-count-upper str-cstring)))
-
-(uffi:def-function ("half_double_vector" half-double-vector)
-    ((size :int)
-     (vec (* :double)))
-  :returning :void)
-
-(uffi:def-constant +double-vec-length+ 10)
-(defun test-half-double-vector ()
-  (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
-	results)
-    (dotimes (i +double-vec-length+)
-      (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))
-    (uffi:free-foreign-object vec)
-    (nreverse results)))
-
-(defun t2 ()
-  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
-    (dotimes (i +double-vec-length+)
-      (setf (aref vec i) (coerce i 'double-float)))
-    (half-double-vector +double-vec-length+ vec)
-    vec))
-
-#+(or cmu scl)
-(defun t3 ()
-  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
-    (dotimes (i +double-vec-length+)
-      (setf (aref vec i) (coerce i 'double-float)))
-    (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"))
-
-#+examples-uffi
-(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"))
-
-#+examples-uffi
-(format t "~&(string-count-upper nil) => ~A" 
-	(string-count-upper nil))
-
-#+examples-uffi
-(format t "~&Half vector: ~S" (test-half-double-vector))
-
-
-
-#+test-uffi
-(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")
-  (util.test:test (string-to-upper nil) nil
-		  :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")
-  (util.test:test (string-count-upper nil) -1
-		  :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")
-  )
diff --git a/tests/file-socket.lisp b/tests/file-socket.lisp
deleted file mode 100644
index 67fe886..0000000
--- a/tests/file-socket.lisp
+++ /dev/null
@@ -1,42 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          file-socket.cl
-;;;; Purpose:       UFFI Example file to get a socket on a file
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Jul 2002
-;;;;
-;;;; $Id: file-socket.lisp,v 1.1 2002/09/30 10:02:36 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)
-
-;; Values for linux
-(uffi:def-constant PF_UNIX 1)
-(uffi:def-constant SOCK_STREAM 1)
-
-(uffi:def-function ("socket" c-socket)
-    ((family :int)
-     (type :int)
-     (protocol :int))
-    :returning :int)
-
-(uffi:def-function ("connect" c-connect)
-    ((sockfd :int)
-     (serv-addr :void-pointer)
-     (addr-len :int))
-    :returning :int)
-		  
-(defun connect-to-file-socket (filename)
-  (let ((socket (c-socket PF_UNIX SOCK_STREAM 0)))
-    (if (plusp socket)
-	(let ((stream (c-connect socket filename (length filename))))
-	  stream)
-      (error "Unable to create socket"))))
diff --git a/tests/getenv.lisp b/tests/getenv.lisp
index 17d2758..aae7317 100644
--- a/tests/getenv.lisp
+++ b/tests/getenv.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: getenv.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: getenv.lisp,v 1.2 2003/04/29 14:08:02 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -16,32 +16,49 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(in-package :cl-user)
+(in-package :uffi-tests)
 
 
 (uffi:def-function ("getenv" c-getenv) 
     ((name :cstring))
   :returning :cstring)
 
+(uffi:def-function ("setenv" c-setenv) 
+    ((name :cstring)
+     (value :cstring)
+     (overwrite :int))
+  :returning :int)
+
+(uffi:def-function ("unsetenv" c-unsetenv)
+    ((name :cstring))
+  :returning :void)
+
 (defun my-getenv (key)
   "Returns an environment variable, or NIL if it does not exist"
   (check-type key string)
   (uffi:with-cstring (key-native key)
     (uffi:convert-from-cstring (c-getenv key-native))))
-    
-#+examples-uffi
-(progn
-  (flet ((print-results (str)
-	   (format t "~&(getenv ~S) => ~S" str (my-getenv str))))
-    (print-results "USER")
-    (print-results "_FOO_")))
-
-
-#+test-uffi
-(progn
-  (util.test:test (my-getenv "_FOO_") nil :fail-info "Error retrieving non-existent getenv")
-  (util.test:test (and (stringp (my-getenv "USER"))
-		       (< 0 (length (my-getenv "USER"))))
-		  t :fail-info "Error retrieving getenv")
-)
+
+(defun my-setenv (key name &optional (overwrite t))
+  "Returns an environment variable, or NIL if it does not exist"
+  (check-type key string)
+  (check-type name string)
+  (setq overwrite (if overwrite 1 0))
+  (uffi:with-cstrings ((key-native key)
+		       (name-native name))
+    (c-setenv key-native name-native (if overwrite 1 0))))
+
+(defun my-unsetenv (key)
+  "Returns an environment variable, or NIL if it does not exist"
+  (check-type key string)
+  (uffi:with-cstrings ((key-native key))
+    (c-unsetenv key-native)))
+
+(deftest getenv.1 (my-getenv "__UFFI_FOO1__") nil)
+(deftest setenv.1 (my-setenv "__UFFI_FOO1__" "UFFI-TEST") 0)
+(deftest getenv.2 (my-getenv "__UFFI_FOO1__") "UFFI-TEST")
+(deftest setenv.2 (my-unsetenv "__UFFI_FOO1__") nil)
+(deftest getenv.3 (my-getenv "__UFFI_FOO1__") nil)
+
+
 
diff --git a/tests/gethostname.lisp b/tests/gethostname.lisp
index a6e1b0e..e973891 100644
--- a/tests/gethostname.lisp
+++ b/tests/gethostname.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gethostname.lisp,v 1.3 2002/12/02 13:21:43 kevin Exp $
+;;;; $Id: gethostname.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
 ;;;;
@@ -16,7 +16,7 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(in-package :cl-user)
+(in-package :uffi-tests)
 
 
 ;;; This example is inspired by the example on the CL-Cookbook web site
@@ -44,23 +44,11 @@
 	(uffi:convert-from-foreign-string name)
 	(error "gethostname() failed."))))
 
-#+examples-uffi
-(progn
-  (format t "~&Hostname (technique 1): ~A" (gethostname))
-  (format t "~&Hostname (technique 2): ~A" (gethostname2)))
+(deftest gethostname.1 (stringp (gethostname)) t)
+(deftest gethostname.2 (stringp (gethostname2)) t)
+(deftest gethostname.3 (plusp (length (gethostname))) t)
+(deftest gethostname.4 (plusp (length (gethostname2))) t)
+(deftest gethostname.5 (gethostname) #.(gethostname2))
 
-#+test-uffi
-(progn
-  (let ((hostname1 (gethostname))
-	(hostname2 (gethostname2)))
-    
-    (util.test:test (and (stringp hostname1) (stringp hostname2)) t
-		    :fail-info "gethostname not string")
-    (util.test:test (and (not (zerop (length hostname1)))
-			 (not (zerop (length hostname2)))) t
-			 :fail-info "gethostname length 0")
-    (util.test:test (string= hostname1 hostname1) t
-		    :fail-info "gethostname techniques don't match"))
-  )
 
 
diff --git a/tests/getshells.lisp b/tests/getshells.lisp
deleted file mode 100644
index 1b05d10..0000000
--- a/tests/getshells.lisp
+++ /dev/null
@@ -1,47 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          getshells.cl
-;;;; Purpose:       UFFI Example file to get lisp of legal shells
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: getshells.lisp,v 1.1 2002/09/30 10:02:36 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-function "setusershell"
-    nil
-  :returning :void)
-
-(uffi:def-function "endusershell"
-    nil
-  :returning :void)
-
-(uffi:def-function "getusershell"
-    nil
-  :returning :cstring)
-
-(defun getshells ()
-  "Returns list of valid shells"
-  (setusershell)
-  (let (shells)
-    (do ((shell (uffi:convert-from-cstring (getusershell))
-                (uffi:convert-from-cstring (getusershell))))
-	((null shell))
-      (push shell shells))
-    (endusershell)
-    (nreverse shells)))
-
-#+examples-uffi
-(format t "~&Shells: ~S" (getshells))
-
diff --git a/tests/run-examples.lisp b/tests/run-examples.lisp
deleted file mode 100644
index 7e80a3f..0000000
--- a/tests/run-examples.lisp
+++ /dev/null
@@ -1,39 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          run-examples.cl
-;;;; Purpose:       Load and execute all examples for UFFI
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: run-examples.lisp,v 1.1 2002/09/30 10:02:36 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.
-;;;; *************************************************************************
-
-#-uffi (asdf:oos 'asdf:load-op :uffi)
-
-(pushnew :examples-uffi cl:*features*)
-
-(flet ((load-test (name)
-	  (load (make-pathname :defaults *load-truename* :name name))))
-  (load-test "c-test-fns")
-  (load-test "arrays")
-  (load-test "union")
-  (load-test "strtol")
-  (load-test "atoifl")
-  (load-test "gettime")
-  (load-test "getenv")
-  (load-test "gethostname")
-  (load-test "getshells")
-  (load-test "compress"))
-
-(setq cl:*features* (remove :examples-uffi cl:*features*))
-
-
-      
diff --git a/tests/test-examples.lisp b/tests/test-examples.lisp
deleted file mode 100644
index 5f780d4..0000000
--- a/tests/test-examples.lisp
+++ /dev/null
@@ -1,43 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          test-examples.cl
-;;;; Purpose:       Load and execute all examples for UFFI
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: test-examples.lisp,v 1.1 2002/09/30 10:02:36 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.
-;;;; *************************************************************************
-
-#-uffi (asdf:oos 'asdf:load-op :uffi)
-
-(unless (ignore-errors (find-package :util.test))
-  (load (make-pathname :name "acl-compat-tester" :defaults *load-truename*)))
-
-(defun do-tests ()
-  (pushnew :test-uffi cl:*features*)
-  (util.test:with-tests (:name "UFFI-Tests")
-    (setq util.test:*break-on-test-failures* nil)
-    (flet ((load-test (name)
-		      (load (make-pathname :name name :defaults *load-truename*))))
-      (load-test "c-test-fns")
-      (load-test "arrays")
-      (load-test "union")
-      (load-test "strtol")
-      (load-test "atoifl")
-      (load-test "gettime")
-      (load-test "getenv")
-      (load-test "gethostname")
-      (load-test "getshells")
-      (load-test "compress"))
-    (setq cl:*features* (remove :test-uffi cl:*features*))))
-
-(do-tests)
-
diff --git a/tests/uffi-c-test-lib.c b/tests/uffi-c-test-lib.c
new file mode 100644
index 0000000..d8e9b49
--- /dev/null
+++ b/tests/uffi-c-test-lib.c
@@ -0,0 +1,95 @@
+/***************************************************************************
+ * FILE IDENTIFICATION
+ *  
+ *  Name:         c-test-fns.c
+ *  Purpose:      Test functions in C for UFFI library
+ *  Programer:    Kevin M. Rosenberg
+ *  Date Started: Mar 2002
+ *
+ *  CVS Id:   $Id: uffi-c-test-lib.c,v 1.1 2003/04/29 14:08:02 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.
+
+ * These variables are correct for GCC
+ * you'll need to modify these for other compilers
+ ***************************************************************************/
+
+#ifdef WIN32
+#include <windows.h>
+
+BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll,
+                          DWORD fdwReason,
+                          LPVOID lpvReserved)
+{
+        return 1;
+}
+       
+#define DLLEXPORT __declspec(dllexport)
+
+#else
+#define DLLEXPORT 
+#endif
+
+#include <ctype.h>
+#include <stdlib.h>
+#include <math.h>
+
+
+/* Test of constant input string */
+DLLEXPORT
+int
+cs_count_upper (char* psz)
+{
+  int count = 0;
+
+  if (psz) {
+    while (*psz) {
+      if (isupper (*psz))
+	++count;
+      ++psz;
+    }
+    return count;
+  } else 
+    return -1;
+}
+
+/* Test of input and output of a string */
+DLLEXPORT
+void
+cs_to_upper (char* psz)
+{
+  if (psz) {
+    while (*psz) {
+      *psz = toupper (*psz);
+      ++psz;
+    }
+  }
+}
+
+/* Test of an output only string */
+DLLEXPORT
+void
+cs_make_random (int size, char* buffer)
+{
+  int i;
+  for (i = 0; i < size; i++)
+    buffer[i] = 'A' + (rand() % 26);
+}
+
+    
+/* Test of input/output vector */
+DLLEXPORT
+void
+half_double_vector (int size, double* vec)
+{
+  int i;
+  for (i = 0; i < size; i++)
+    vec[i] /= 2.;
+}
+
+    
+
diff --git a/tests/uffi-c-test-lib.lisp b/tests/uffi-c-test-lib.lisp
new file mode 100644
index 0000000..20f4ccb
--- /dev/null
+++ b/tests/uffi-c-test-lib.lisp
@@ -0,0 +1,87 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          c-test-fns.cl
+;;;; Purpose:       UFFI Example file for zlib compression
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: uffi-c-test-lib.lisp,v 1.1 2003/04/29 14:08:02 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 :uffi-tests)
+
+(unless (uffi:load-foreign-library 
+	 (uffi:find-foreign-library "uffi-c-test-lib" 
+				    (list *load-truename*
+					  "/usr/lib/"))
+	 :supporting-libraries '("c"))
+  (warn "Unable to load uffi-c-test-lib library"))
+
+(uffi:def-function ("cs_to_upper" cs-to-upper)
+  ((input (* :unsigned-char)))
+  :returning :void
+  )
+
+(defun string-to-upper (str)
+  (uffi:with-foreign-string (str-foreign str)
+    (cs-to-upper str-foreign)
+    (uffi:convert-from-foreign-string str-foreign)))
+
+(uffi:def-function ("cs_count_upper" cs-count-upper)
+  ((input :cstring))
+  :returning :int
+  )
+
+(defun string-count-upper (str)
+  (uffi:with-cstring (str-cstring str)
+    (cs-count-upper str-cstring)))
+
+(uffi:def-function ("half_double_vector" half-double-vector)
+    ((size :int)
+     (vec (* :double)))
+  :returning :void)
+
+(uffi:def-constant +double-vec-length+ 10)
+(defun test-half-double-vector ()
+  (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
+	results)
+    (dotimes (i +double-vec-length+)
+      (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))
+    (uffi:free-foreign-object vec)
+    (nreverse results)))
+
+(defun t2 ()
+  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+    (dotimes (i +double-vec-length+)
+      (setf (aref vec i) (coerce i 'double-float)))
+    (half-double-vector +double-vec-length+ vec)
+    vec))
+
+#+(or cmu scl)
+(defun t3 ()
+  (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+    (dotimes (i +double-vec-length+)
+      (setf (aref vec i) (coerce i 'double-float)))
+    (system:without-gcing
+     (half-double-vector +double-vec-length+ (system:vector-sap vec)))
+    vec))
+    
+(deftest c-test.1 (string-to-upper "this is a test") "THIS IS A TEST")
+(deftest c-test.2 (string-to-upper nil) nil)
+(deftest c-test.3 (string-count-upper "This is a Test") 2)
+(deftest c-test.4 (string-count-upper nil) -1)
+(deftest c-test.5 (test-half-double-vector)
+  (0.0d0 0.5d0 1.0d0 1.5d0 2.0d0 2.5d0 3.0d0 3.5d0 4.0d0 4.5d0))
+
diff --git a/tests/union.lisp b/tests/union.lisp
index 2e186d8..aefbaaf 100644
--- a/tests/union.lisp
+++ b/tests/union.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -16,7 +16,7 @@
 ;;;; (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)
@@ -25,65 +25,25 @@
   (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))
+
diff --git a/uffi-tests.asd b/uffi-tests.asd
index 0bf6ab3..6ecea17 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.3 2003/04/29 13:16:14 kevin Exp $
+;;;; $Id: uffi-tests.asd,v 1.4 2003/04/29 14:08:02 kevin Exp $
 ;;;; *************************************************************************
 
 (defpackage #:uffi-tests-system
@@ -24,6 +24,10 @@
 	       (:file "strtol" :depends-on ("package"))
 	       (:file "atoifl" :depends-on ("package"))
 	       (:file "compress" :depends-on ("package"))
+	       (:file "getenv" :depends-on ("package"))
+	       (:file "gethostname" :depends-on ("package"))
+	       (:file "union" :depends-on ("package"))
+	       (:file "uffi-c-test-lib" :depends-on ("package"))
 	       ))))
 
 (defmethod perform ((o test-op) (c (eql (find-system :uffi-tests))))