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.
# 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
#
distclean: clean
-base=c-test-fns
+base=uffi-c-test-lib
source=$(base).c
object=$(base).o
shared_lib=$(base).so
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:
+++ /dev/null
-/***************************************************************************
- * 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.;
-}
-
-
-
+++ /dev/null
-;;;; -*- 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")
- )
+++ /dev/null
-;;;; -*- 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"))))
;;;; 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
;;;;
;;;; (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)
+
+
;;;; 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
;;;;
;;;; (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
(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"))
- )
+++ /dev/null
-;;;; -*- 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))
-
+++ /dev/null
-;;;; -*- 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*))
-
-
-
+++ /dev/null
-;;;; -*- 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)
-
--- /dev/null
+/***************************************************************************
+ * 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.;
+}
+
+
+
--- /dev/null
+;;;; -*- 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))
+
;;;; 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
;;;;
;;;; (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)
(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))
+
;;;; 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
(: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))))
projects / uffi.git / commitdiff