Fixed missing '/'
* test-examples.cl:
- Start work on automated testing
+ Automated testing suite
2002-04-01 Kevin Rosenberg (kevin@rosenberg.net)
;;;; 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
;;;;
((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)
"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
(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")
+ )
+
;;;; 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
;;;;
#+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")
+ )
;;;; 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
;;;;
(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")
+)
+
;;;; 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
;;;;
#+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")))
+
;;;; 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
;;;;
(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))))
;;;; 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
;;;;
(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)
(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)
;;;; 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
;;;;
#-uffi
(mk:load-system :uffi)
+#-allegro
(load (make-pathname :name "acl-compat-tester" :type "cl"
:defaults *load-truename*))
(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
;;;; 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
;;;;
((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)
"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
(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")
+ )
+
;;;; 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
;;;;
#+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")
+ )
;;;; 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
;;;;
(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")
+)
+
;;;; 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
;;;;
#+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")))
+
;;;; 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
;;;;
(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))))
;;;; 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
;;;;
(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)
(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)