(uffi:def-foreign-type long-ptr (* :long))
-(deftest array.1
+(deftest :array.1
(let ((a (uffi:allocate-foreign-object :long +column-length+))
(results nil))
(dotimes (i +column-length+)
(0 1 4 9 16 25 36 49 64 81))
-(deftest array.2
+(deftest :array.2
(let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+))
(results nil))
(dotimes (r +row-length+)
(uffi:def-function ("atoi" c-atoi)
((str :cstring))
- :module "c"
:returning :int)
(uffi:def-function ("atol" c-atol)
((str :cstring))
- :module "c"
:returning :long)
(uffi:def-function ("atof" c-atof)
((str :cstring))
- :module "c"
:returning :double)
(defun atoi (str)
(uffi:with-cstring (str-cstring str)
(c-atof str-cstring)))
-(deftest atoi.1 (atoi "123") 123)
-(deftest atoi.2 (atoi "") 0)
-(deftest atof.3 (atof "2.23") 2.23d0)
+(deftest :atoi.1 (atoi "123") 123)
+(deftest :atoi.2 (atoi "") 0)
+(deftest :atof.3 (atof "2.23") 2.23d0)
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
+;;;; FILE IDENTIFICAION
;;;;
;;;; Name: casts.lisp
;;;; Purpose: Tests of with-cast-pointer
(uffi:def-function ("cast_test_int" cast-test-int)
()
- :module "c-uffi-test"
+ :module "uffi_tests"
:returning :pointer-void)
(uffi:def-function ("cast_test_float" cast-test-float)
()
- :module "c-uffi-test"
+ :module "uffi_tests"
:returning :pointer-void)
-(deftest cast.1
+(deftest :cast.1
(progn
(uffi:with-cast-pointer (temp (cast-test-int) :int)
(assert (= (uffi:deref-pointer temp :int) 23)))
t)
t)
-(deftest cast.2
+(deftest :cast.2
(progn
(uffi:with-cast-pointer (temp (cast-test-float) :double)
(assert (= (uffi:deref-pointer temp :double) 3.21d0)))
(uffi:free-foreign-object destlen)
(uffi:free-foreign-object dest)))))))
-(deftest compress.1 (compress "")
+(deftest :compress.1 (compress "")
#(120 156 3 0 0 0 0 1) 8)
-(deftest compress.2 (compress "test")
+(deftest :compress.2 (compress "test")
#(120 156 43 73 45 46 1 0 4 93 1 193) 12)
-(deftest compress.3 (compress "test2")
+(deftest :compress.3 (compress "test2")
#(120 156 43 73 45 46 49 2 0 6 80 1 243) 13)
(defun compress-uncompress (str)
uncompressed)))
-(deftest uncompress.1 "" "")
-(deftest uncompress.2 "test" "test")
-(deftest uncompress.3 "test2" "test2")
+(deftest :uncompress.1 "" "")
+(deftest :uncompress.2 "test" "test")
+(deftest :uncompress.3 "test2" "test2")
(def-foreign-var "float_neg_4_5" :float "uffi_tests")
(def-foreign-var "double_3_1" :double "uffi_tests")
-(deftest fvar.1 uchar-13 13)
-(deftest fvar.2 schar-neg-120 -120)
-(deftest fvar.3 uword-257 257)
-(deftest fvar.4 sword-neg-321 -321)
-(deftest fvar.5 uint-1234567 1234567)
-(deftest fvar.6 sint-neg-123456 -123456)
-(deftest fvar.7 float-neg-4-5 -4.5f0)
-(deftest fvar.8 double-3-1 3.1d0)
-
+(deftest :fvar.1 uchar-13 13)
+(deftest :fvar.2 schar-neg-120 -120)
+(deftest :fvar.3 uword-257 257)
+(deftest :fvar.4 sword-neg-321 -321)
+(deftest :fvar.5 uint-1234567 1234567)
+(deftest :fvar.6 sint-neg-123456 -123456)
+(deftest :fvar.7 float-neg-4-5 -4.5f0)
+(deftest :fvar.8 double-3-1 3.1d0)
(uffi:def-foreign-var ("fvar_addend" *fvar-addend*) :int "uffi_tests")
(d :double))
(uffi:def-foreign-var ("fvar_struct" *fvar-struct*) fvar-struct
- "c-uffi-tests")
+ "uffi_tests")
(uffi:def-function ("fvar_struct_int" fvar-struct-int)
()
:returning :int
- :module "c-uffi-test")
+ :module "uffi_tests")
(uffi:def-function ("fvar_struct_double" fvar-struct-double)
()
:returning :double
- :module "c-uffi-test")
+ :module "uffi_tests")
-(deftest fvarst.1 *fvar-addend* 3)
-(deftest fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42)
-(deftest fvarst.3 (= (+ *fvar-addend*
+(deftest :fvarst.1 *fvar-addend* 3)
+(deftest :fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42)
+(deftest :fvarst.3 (= (+ *fvar-addend*
(uffi:get-slot-value *fvar-struct* 'fvar-struct 'i))
(fvar-struct-int))
t)
-(deftest fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0)
-(deftest fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd)
+(deftest :fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0)
+(deftest :fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd)
(fvar-struct-double))
t)
(uffi:def-function ("getenv" c-getenv)
((name :cstring))
- :module "c"
:returning :cstring)
(uffi:def-function ("setenv" c-setenv)
((name :cstring)
(value :cstring)
(overwrite :int))
- :module "c"
:returning :int)
(uffi:def-function ("unsetenv" c-unsetenv)
((name :cstring))
- :module "c"
:returning :void)
(defun my-getenv (key)
(uffi:with-cstrings ((key-native key))
(c-unsetenv key-native)))
-(deftest getenv.1 (progn
+(deftest :getenv.1 (progn
(my-unsetenv "__UFFI_FOO1__")
(my-getenv "__UFFI_FOO1__"))
nil)
-(deftest getenv.2 (progn
+(deftest :getenv.2 (progn
(my-setenv "__UFFI_FOO1__" "UFFI-TEST")
(my-getenv "__UFFI_FOO1__"))
"UFFI-TEST")
(uffi:def-function ("gethostname" c-gethostname)
((name (* :unsigned-char))
(len :int))
- :module "c"
:returning :int)
(defun gethostname ()
(uffi:convert-from-foreign-string name)
(error "gethostname() failed.")))))
-(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 (string= (gethostname) (gethostname2)) t)
+(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 (string= (gethostname) (gethostname2)) t)
(in-package #:uffi-tests)
-(deftest chptr.1
+(deftest :chptr.1
(let ((native-string "test string"))
(uffi:with-foreign-string (fs native-string)
(ensure-char-character
(deref-pointer fs :char))))
#\t)
-(deftest chptr.2
+(deftest :chptr.2
(let ((native-string "test string"))
(uffi:with-foreign-string (fs native-string)
(ensure-char-character
(deref-pointer fs :unsigned-char))))
#\t)
-(deftest chptr.3
+(deftest :chptr.3
(let ((native-string "test string"))
(uffi:with-foreign-string (fs native-string)
(ensure-char-integer
(deref-pointer fs :unsigned-char))))
116)
-(deftest chptr.4
+(deftest :chptr.4
(let ((native-string "test string"))
(uffi:with-foreign-string (fs native-string)
(numberp
(deref-pointer fs :byte))))
t)
-(deftest chptr.5
+(deftest :chptr.5
(let ((fs (uffi:allocate-foreign-object :unsigned-char 128)))
(setf (uffi:deref-array fs '(:array :unsigned-char) 0)
(uffi:ensure-char-storable #\a))
;; rather than fli:dereference
#-lispworks
-(deftest chptr.6
+(deftest :chptr.6
(uffi:with-foreign-object (fs '(:array :unsigned-char 128))
(setf (uffi:deref-array fs '(:array :unsigned-char) 0)
(uffi:ensure-char-storable #\a))
((nptr char-ptr)
(endptr (* char-ptr))
(base :int))
- :module "c"
:returning :long)
(defun strtol (str &optional (base 10))
(uffi:free-foreign-object str-native)
(uffi:free-foreign-object endptr)))))
-(deftest strtol.1 (strtol "123") 123 t)
-(deftest strtol.2 (strtol "0") 0 t)
-(deftest strtol.3 (strtol "55a") 55 2)
-(deftest strtol.4 (strtol "a") nil nil)
+(deftest :strtol.1 (strtol "123") 123 t)
+(deftest :strtol.2 (strtol "0") 0 t)
+(deftest :strtol.3 (strtol "55a") 55 2)
+(deftest :strtol.4 (strtol "a") nil nil)
(uffi:def-foreign-type foo-ptr (* foo))
;; tests that compilation worked
-(deftest structs.1
+(deftest :structs.1
(with-foreign-object (p 'foo)
t)
t)
-(deftest structs.2
+(deftest :structs.2
(progn
(uffi:def-foreign-type foo-struct (:struct foo))
t)
(uffi:def-function ("time" c-time)
((time (* time-t)))
- :module "c"
:returning time-t)
(uffi:def-function "gmtime"
((time (* time-t)))
- :module "c"
:returning (* tm))
(uffi:def-function "asctime"
((time (* tm)))
- :module "c"
:returning :cstring)
(uffi:def-type time-t :unsigned-long)
(uffi:def-type tm-pointer (* tm))
-(deftest time.1
+(deftest :time.1
(uffi:with-foreign-object (time 'time-t)
(setf (uffi:deref-pointer time :unsigned-long) 7381)
(uffi:deref-pointer time :unsigned-long))
7381)
-(deftest time.2
+(deftest :time.2
(uffi:with-foreign-object (time 'time-t)
(setf (uffi:deref-pointer time :unsigned-long) 7381)
(let ((tm-ptr (the tm-pointer (gmtime time))))
(uffi:def-function ("gettimeofday" c-gettimeofday)
((tv (* timeval))
(tz (* timezone)))
- :module "c"
:returning :int)
(defun get-utime ()
(uffi:get-slot-value tv 'timeval 'usecs))
res))))
-(deftest timeofday.1
+(deftest :timeofday.1
(multiple-value-bind (t1 res1) (get-utime)
(multiple-value-bind (t2 res2) (get-utime)
(and (or (= t2 t1) (> t2 t1))
(setf (uffi:deref-pointer time :unsigned-long) secs)
(asctime (gmtime time))))))
-(deftest time.3
+(deftest :time.3
(posix-time-to-asctime 0)
"Thu Jan 1 00:00:00 1970")
(uffi:def-function ("cs_to_upper" cs-to-upper)
((input (* :unsigned-char)))
:returning :void
- :module "uffi-c-test"
- )
+ :module "uffi_tests")
(defun string-to-upper (str)
(uffi:with-foreign-string (str-foreign str)
(uffi:def-function ("cs_count_upper" cs-count-upper)
((input :cstring))
:returning :int
- :module "uffi-c-test")
+ :module "uffi_tests")
(defun string-count-upper (str)
(uffi:with-cstring (str-cstring str)
((size :int)
(vec (* :double)))
:returning :void
- :module "uffi-c-test")
+ :module "uffi_tests")
(uffi:def-function ("return_long_negative_one" return-long-negative-one)
()
:returning :long
- :module "uffi-c-test")
+ :module "uffi_tests")
(uffi:def-function ("return_int_negative_one" return-int-negative-one)
()
:returning :int
- :module "uffi-c-test")
+ :module "uffi_tests")
(uffi:def-function ("return_short_negative_one" return-short-negative-one)
()
:returning :short
- :module "uffi-c-test")
+ :module "uffi_tests")
(uffi:def-constant +double-vec-length+ 10)
(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)
+(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))
-(deftest c-test.6 (return-long-negative-one) -1)
-(deftest c-test.7 (return-int-negative-one) -1)
-(deftest c-test.8 (return-short-negative-one) -1)
+(deftest :c-test.6 (return-long-negative-one) -1)
+(deftest :c-test.7 (return-int-negative-one) -1)
+(deftest :c-test.8 (return-short-negative-one) -1)
(* 256 (char-code #\C))
(* 1 128)))
-(deftest union.1
+(deftest :union.1
(uffi:ensure-char-character
(uffi:get-slot-value *u* 'tunion1 'char))
#\A)
-(deftest union.2
+(deftest :union.2
(uffi:ensure-char-integer
(uffi:get-slot-value *u* 'tunion1 'char))
65)
#-(or sparc sparc-v9 mcl)
-(deftest union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
+(deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
(uffi:def-union foo-u
(uffi:def-foreign-type foo-u-ptr (* foo-u))
;; tests that compilation worked
-(deftest unions.4
+(deftest :unions.4
(with-foreign-object (p 'foo-u)
t)
t)
-(deftest unions.5
+(deftest :unions.5
(progn
(uffi:def-foreign-type foo-union (:union foo-u))
t)
projects / uffi.git / commitdiff