From: Kevin M. Rosenberg Date: Tue, 2 Apr 2002 23:27:05 +0000 (+0000) Subject: r1723: *** empty log message *** X-Git-Tag: v1.6.1~524 X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=acdc714a0b8ea9c0df0c9ffc56699fa010bd549e r1723: *** empty log message *** --- diff --git a/ChangeLog b/ChangeLog index 0718693..0876142 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,7 +3,7 @@ Fixed missing '/' * test-examples.cl: - Start work on automated testing + Automated testing suite 2002-04-01 Kevin Rosenberg (kevin@rosenberg.net) diff --git a/examples/atoifl.cl b/examples/atoifl.cl index 22f597d..064a91f 100644 --- a/examples/atoifl.cl +++ b/examples/atoifl.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: atoifl.cl,v 1.3 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: atoifl.cl,v 1.4 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -22,11 +22,11 @@ ((str :cstring)) :returning :int) -(uffi:def-function ("atol" c-atoi) +(uffi:def-function ("atol" c-atol) ((str :cstring)) :returning :long) -(uffi:def-function ("atof" c-atoi) +(uffi:def-function ("atof" c-atof) ((str :cstring)) :returning :double) @@ -34,6 +34,11 @@ "Returns a int from a string." (uffi:with-cstring (str-cstring str) (c-atoi str-cstring))) + +(defun atof (str) + "Returns a double float from a string." + (uffi:with-cstring (str-cstring str) + (c-atof str-cstring))) #+examples-uffi (progn @@ -42,3 +47,13 @@ (print-results "55"))) +#+test-uffi +(progn + (util.test:test (atoi "123") 123 :test #'eql + :fail-info "Error with atoi") + (util.test:test (atoi "") 0 :test #'eql + :fail-info "Error with atoi") + (util.test:test (atof "2.23") 2.23 :test #'eql + :fail-info "Error with atof") + ) + diff --git a/examples/c-test-fns.cl b/examples/c-test-fns.cl index 1bedef9..589d564 100644 --- a/examples/c-test-fns.cl +++ b/examples/c-test-fns.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: c-test-fns.cl,v 1.5 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: c-test-fns.cl,v 1.6 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -96,3 +96,26 @@ #+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") + (length "THIS IS A TEST") + :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.0 0.5 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5) + :test #'equal + :fail-info "Error comparing half-double-vector") + ) diff --git a/examples/getenv.cl b/examples/getenv.cl index c2fb1bd..b3d620e 100644 --- a/examples/getenv.cl +++ b/examples/getenv.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: getenv.cl,v 1.8 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: getenv.cl,v 1.9 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -36,3 +36,12 @@ (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") +) + diff --git a/examples/gettime.cl b/examples/gettime.cl index 9158b0f..c562fad 100644 --- a/examples/gettime.cl +++ b/examples/gettime.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: gettime.cl,v 1.8 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: gettime.cl,v 1.9 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -65,4 +65,12 @@ #+examples-uffi (format t "~&~A" (gettime)) +#+test-uffi +(progn + (let ((time (gettime))) + (util.test:test (stringp time) t :fail-info "Time is not a string") + (util.test:test (plusp (parse-integer time :junk-allowed t)) + t + :fail-info "time string does not start with a number"))) + diff --git a/examples/strtol.cl b/examples/strtol.cl index 8255ce5..32c5c42 100644 --- a/examples/strtol.cl +++ b/examples/strtol.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: strtol.cl,v 1.14 2002/04/02 22:10:22 kevin Exp $ +;;;; $Id: strtol.cl,v 1.15 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -72,9 +72,10 @@ of first non-valid character" (progn (flet ((test-strtol (str results) (util.test:test (multiple-value-list (strtol str)) results - :test-function #'equal + :test #'equal :fail-info "Error testing strtol"))) - (test-strtol "55" '(55 t)) + (test-strtol "123" '(123 t)) + (test-strtol "0" '(0 t)) (test-strtol "55a" '(55 2)) (test-strtol "a" '(nil nil)))) diff --git a/examples/union.cl b/examples/union.cl index c63b946..bd6e5b4 100644 --- a/examples/union.cl +++ b/examples/union.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: union.cl,v 1.4 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: union.cl,v 1.5 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -25,7 +25,7 @@ (sf :float) (df :double)) -(defun test-union-1 () +(defun run-union-1 () (let ((u (uffi:allocate-foreign-object 'tunion1))) (setf (uffi:get-slot-value u 'tunion1 'uint) (+ (char-code #\A) @@ -42,5 +42,33 @@ (uffi:free-foreign-object u)) (values)) +(defun test-union-1 () + (let ((u (uffi:allocate-foreign-object 'tunion1))) + (setf (uffi:get-slot-value u 'tunion1 'uint) + (+ (char-code #\A) + (* 256 (char-code #\B)) + (* 65536 (char-code #\C)) + (* 16777216 255))) + (util.test:test (uffi:ensure-char-character + (uffi:get-slot-value u 'tunion1 'char)) + #\A + :test #'eql + :fail-info "Error with union character") + + (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)) + #+examples-uffi +(run-union-1) + + +#+test-uffi (test-union-1) diff --git a/test-examples.cl b/test-examples.cl index a3f7a13..e62d2a5 100644 --- a/test-examples.cl +++ b/test-examples.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: test-examples.cl,v 1.10 2002/04/02 21:42:11 kevin Exp $ +;;;; $Id: test-examples.cl,v 1.11 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -19,6 +19,7 @@ #-uffi (mk:load-system :uffi) +#-allegro (load (make-pathname :name "acl-compat-tester" :type "cl" :defaults *load-truename*)) @@ -26,7 +27,7 @@ (defun do-tests () (pushnew :test-uffi cl:*features*) (util.test:with-tests (:name "UFFI") -; (setq util.test:*break-on-test-failures* break) + (setq util.test:*break-on-test-failures* t) (flet ((load-test (name) (load (merge-pathnames (make-pathname :name name diff --git a/tests/atoifl.cl b/tests/atoifl.cl index 22f597d..064a91f 100644 --- a/tests/atoifl.cl +++ b/tests/atoifl.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: atoifl.cl,v 1.3 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: atoifl.cl,v 1.4 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -22,11 +22,11 @@ ((str :cstring)) :returning :int) -(uffi:def-function ("atol" c-atoi) +(uffi:def-function ("atol" c-atol) ((str :cstring)) :returning :long) -(uffi:def-function ("atof" c-atoi) +(uffi:def-function ("atof" c-atof) ((str :cstring)) :returning :double) @@ -34,6 +34,11 @@ "Returns a int from a string." (uffi:with-cstring (str-cstring str) (c-atoi str-cstring))) + +(defun atof (str) + "Returns a double float from a string." + (uffi:with-cstring (str-cstring str) + (c-atof str-cstring))) #+examples-uffi (progn @@ -42,3 +47,13 @@ (print-results "55"))) +#+test-uffi +(progn + (util.test:test (atoi "123") 123 :test #'eql + :fail-info "Error with atoi") + (util.test:test (atoi "") 0 :test #'eql + :fail-info "Error with atoi") + (util.test:test (atof "2.23") 2.23 :test #'eql + :fail-info "Error with atof") + ) + diff --git a/tests/c-test-fns.cl b/tests/c-test-fns.cl index 1bedef9..589d564 100644 --- a/tests/c-test-fns.cl +++ b/tests/c-test-fns.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: c-test-fns.cl,v 1.5 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: c-test-fns.cl,v 1.6 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -96,3 +96,26 @@ #+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") + (length "THIS IS A TEST") + :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.0 0.5 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5) + :test #'equal + :fail-info "Error comparing half-double-vector") + ) diff --git a/tests/getenv.cl b/tests/getenv.cl index c2fb1bd..b3d620e 100644 --- a/tests/getenv.cl +++ b/tests/getenv.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: getenv.cl,v 1.8 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: getenv.cl,v 1.9 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -36,3 +36,12 @@ (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") +) + diff --git a/tests/gettime.cl b/tests/gettime.cl index 9158b0f..c562fad 100644 --- a/tests/gettime.cl +++ b/tests/gettime.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: gettime.cl,v 1.8 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: gettime.cl,v 1.9 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -65,4 +65,12 @@ #+examples-uffi (format t "~&~A" (gettime)) +#+test-uffi +(progn + (let ((time (gettime))) + (util.test:test (stringp time) t :fail-info "Time is not a string") + (util.test:test (plusp (parse-integer time :junk-allowed t)) + t + :fail-info "time string does not start with a number"))) + diff --git a/tests/strtol.cl b/tests/strtol.cl index 8255ce5..32c5c42 100644 --- a/tests/strtol.cl +++ b/tests/strtol.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: strtol.cl,v 1.14 2002/04/02 22:10:22 kevin Exp $ +;;;; $Id: strtol.cl,v 1.15 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -72,9 +72,10 @@ of first non-valid character" (progn (flet ((test-strtol (str results) (util.test:test (multiple-value-list (strtol str)) results - :test-function #'equal + :test #'equal :fail-info "Error testing strtol"))) - (test-strtol "55" '(55 t)) + (test-strtol "123" '(123 t)) + (test-strtol "0" '(0 t)) (test-strtol "55a" '(55 2)) (test-strtol "a" '(nil nil)))) diff --git a/tests/union.cl b/tests/union.cl index c63b946..bd6e5b4 100644 --- a/tests/union.cl +++ b/tests/union.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: union.cl,v 1.4 2002/04/02 21:29:45 kevin Exp $ +;;;; $Id: union.cl,v 1.5 2002/04/02 23:27:05 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -25,7 +25,7 @@ (sf :float) (df :double)) -(defun test-union-1 () +(defun run-union-1 () (let ((u (uffi:allocate-foreign-object 'tunion1))) (setf (uffi:get-slot-value u 'tunion1 'uint) (+ (char-code #\A) @@ -42,5 +42,33 @@ (uffi:free-foreign-object u)) (values)) +(defun test-union-1 () + (let ((u (uffi:allocate-foreign-object 'tunion1))) + (setf (uffi:get-slot-value u 'tunion1 'uint) + (+ (char-code #\A) + (* 256 (char-code #\B)) + (* 65536 (char-code #\C)) + (* 16777216 255))) + (util.test:test (uffi:ensure-char-character + (uffi:get-slot-value u 'tunion1 'char)) + #\A + :test #'eql + :fail-info "Error with union character") + + (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)) + #+examples-uffi +(run-union-1) + + +#+test-uffi (test-union-1)