diff options
Diffstat (limited to 'guile/modules/gnutls/build/tests.scm')
-rw-r--r-- | guile/modules/gnutls/build/tests.scm | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/guile/modules/gnutls/build/tests.scm b/guile/modules/gnutls/build/tests.scm new file mode 100644 index 0000000000..ca3985f12b --- /dev/null +++ b/guile/modules/gnutls/build/tests.scm @@ -0,0 +1,41 @@ +;;; GnuTLS --- Guile bindings for GnuTLS. +;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;; +;;; GnuTLS is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 2.1 of the License, or (at your option) any later version. +;;; +;;; GnuTLS is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with GnuTLS; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Written by Ludovic Courtès <ludo@gnu.org>. + +(define-module (gnutls build tests) + #:export (run-test)) + +(define (run-test thunk) + "Call `(exit (THUNK))'. If THUNK raises an exception, then call `(exit 1)' and +display a backtrace. Otherwise, return THUNK's return value." + (exit + (catch #t + thunk + (lambda (key . args) + ;; Never reached. + (exit 1)) + (lambda (key . args) + (dynamic-wind ;; to be on the safe side + (lambda () #t) + (lambda () + (format (current-error-port) + "~%throw to `~a' with args ~s~%" key args) + (display-backtrace (make-stack #t) (current-output-port))) + (lambda () + (exit 1))) + (exit 1))))) |