diff options
| -rw-r--r-- | gnuradio-core/src/guile/gnuradio/test-suite/lib.scm | 26 | ||||
| -rw-r--r-- | gnuradio-core/src/guile/tests/00_runtime_basics.test | 21 |
2 files changed, 33 insertions, 14 deletions
diff --git a/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm b/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm index b7046a8b0..458e627de 100644 --- a/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm +++ b/gnuradio-core/src/guile/gnuradio/test-suite/lib.scm @@ -38,6 +38,7 @@ run-test pass-if expect-fail pass-if-exception expect-fail-exception + pass-if-throw expect-fail-throw ;; Naming groups of tests in a regular fashion. with-test-prefix with-test-prefix* current-test-prefix @@ -340,6 +341,13 @@ `(run-test ,name #f (lambda () ,@rest)))) ;;; A helper function to implement the macros that test for exceptions. +;;; +;;; This doesn't work for all exceptions, just those that were +;;; raised by scm-error or error. This doesn't include those +;;; raised by throw in the general case, or SWIG in particular. +;;; +;;; See also run-raise-exception, pass-if-throw and expect-fail-throw +;;; for alternatives that work with all exceptions. (define (run-test-exception name exception expect-pass thunk) (run-test name expect-pass (lambda () @@ -376,6 +384,24 @@ (defmacro expect-fail-exception (name exception body . rest) `(,run-test-exception ,name ,exception #f (lambda () ,body ,@rest))) + +;;; Helper for macros below +(define (run-test-throw name exception-key expect-pass thunk) + (run-test name expect-pass + (lambda () + (stack-catch exception-key + (lambda () (thunk) #f) + (lambda (key . rest) #t))))) + +;;; A short form for tests that expect a certain exception to be thrown, +;;; where the exception is specified only by the exception-key symbol. +(defmacro pass-if-throw (name exception-key body . rest) + `(,run-test-throw ,name ,exception-key #t (lambda () ,body ,@rest))) + +;;; A short form for tests that expect a certain exception to be thrown, +;;; where the exception is specified only by the exception-key symbol. +(defmacro expect-fail-throw (name exception-key body . rest) + `(,run-test-throw ,name ,exception-key #f (lambda () ,body ,@rest))) ;;;; TEST NAMES ;;;; diff --git a/gnuradio-core/src/guile/tests/00_runtime_basics.test b/gnuradio-core/src/guile/tests/00_runtime_basics.test index 989ae423c..93dcff4d7 100644 --- a/gnuradio-core/src/guile/tests/00_runtime_basics.test +++ b/gnuradio-core/src/guile/tests/00_runtime_basics.test @@ -33,7 +33,7 @@ (list->vector (map f (vector->list v)))) -(with-test-prefix "test-connect-1" +(with-test-prefix "connect-1" (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) (expected-result (vector-map (lambda (x) (* x 2)) src-data)) (tb (gr:top-block-swig "QA top block")) @@ -50,7 +50,7 @@ (test-equal expected-result (gr:data dst)) )) -(with-test-prefix "test-connect-2" +(with-test-prefix "connect-2" (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) (expected-result (vector-map (lambda (x) (* x 2)) src-data)) (tb (gr:top-block-swig "QA top block")) @@ -66,7 +66,7 @@ (test-equal expected-result (gr:data dst)))) -(with-test-prefix "test-connect-3" +(with-test-prefix "connect-3" (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) (expected-result (vector-map (lambda (x) (* x 2)) src-data)) (tb (gr:top-block-swig "QA top block")) @@ -82,7 +82,7 @@ (test-equal expected-result (gr:data dst)))) -(with-test-prefix "test-connect-4" +(with-test-prefix "connect-4" (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) (expected-result (vector-map (lambda (x) (* x 2)) src-data)) (tb (gr:top-block-swig "QA top block")) @@ -96,11 +96,7 @@ (gr:run tb) (test-equal expected-result (gr:data dst)))) -#! -;;; FIXME pass-if-exception is broken if the underlying code throws -;;; (like ours does). Need to write our own test utility for -;;; exceptions. -(with-test-prefix "test-connect-5" +(with-test-prefix "connect-5" (let* ((src-data #(-5 -4 -3 -2 -1 0 1 2 3 4 5)) (expected-result (vector-map (lambda (x) (* x 2)) src-data)) (tb (gr:top-block-swig "QA top block")) @@ -108,14 +104,11 @@ (op (gr:multiply-const-ii 2)) (dst (gr:vector-sink-i))) - ;; FIXME This isn't working... - (pass-if-exception "bad port" exception:swig-exception + (pass-if-throw "bad port exception" 'swig-exception (gr:connect tb src op (gr:ep dst 1))) - )) -!# -(with-test-prefix "test-io-signature-1" +(with-test-prefix "io-signature-1" (let ((ios1 (gr:io-signature 1 2 8)) (ios2 (gr:io-signature2 1 2 16 32)) (ios3 (gr:io-signature3 1 -1 14 32 48)) |