]> git.ipfire.org Git - thirdparty/gnutls.git/commitdiff
guile: Fix `priorities' test to use `run-test'.
authorLudovic Courtès <ludo@gnu.org>
Mon, 22 Aug 2011 16:17:10 +0000 (18:17 +0200)
committerLudovic Courtès <ludo@gnu.org>
Mon, 22 Aug 2011 16:18:05 +0000 (18:18 +0200)
This is a followup to commit cd7b8102316cd4151356c4b2b7909c7435593890
("guile: Fix tests to match the `exit' behavior introduced in Guile
2.0.1.").

guile/tests/priorities.scm

index 1ee072be5efe7007d9860b5aa1f3fb5abb88ac1e..2af837eb9a413d2ba85fd6b85a5416df3ef0f77e 100644 (file)
@@ -24,6 +24,8 @@
 ;;;
 
 (use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-1)
              (srfi srfi-26))
 
 (define %valid-priority-strings
     ("NONE:+VERS-TLS-ALL:+AES-128-CBC:"
      . "+FAIL-HERE:+SHA1:+COMP-NULL:+SIGN-RSA-SHA1")))
 
-(dynamic-wind
-
-    (lambda ()
-      #t)
+(run-test
 
     (lambda ()
       (let ((s (make-session connection-end/client)))
         (for-each (cut set-session-priorities! s <>)
                   %valid-priority-strings)
 
-        (for-each (lambda (prefix+suffix)
-                    (let* ((prefix (car prefix+suffix))
-                           (suffix (cdr prefix+suffix))
-                           (pos    (string-length prefix))
-                           (string (string-append prefix suffix)))
-                      (catch 'gnutls-error
-                        (lambda ()
-                          (let ((s (make-session connection-end/client)))
-                            (set-session-priorities! s string)))
-                        (lambda (key err function error-location . unused)
-                          (or (and (eq? key 'gnutls-error)
-                                   (eq? err error/invalid-request)
-                                   (eq? function 'set-session-priorities!)
-                                   (= error-location pos))
-                              (exit 1))))))
-                  %invalid-priority-strings)
-
-        (exit 0)))
-
-    (lambda ()
-      ;; failure
-      (exit 1)))
+        (every (lambda (prefix+suffix)
+                 (let* ((prefix (car prefix+suffix))
+                        (suffix (cdr prefix+suffix))
+                        (pos    (string-length prefix))
+                        (string (string-append prefix suffix)))
+                   (catch 'gnutls-error
+                     (lambda ()
+                       (let ((s (make-session connection-end/client)))
+                         ;; The following call should raise an exception.
+                         (set-session-priorities! s string)
+                         #f))
+                     (lambda (key err function error-location . unused)
+                       (and (eq? key 'gnutls-error)
+                            (eq? err error/invalid-request)
+                            (eq? function 'set-session-priorities!)
+                            (= error-location pos))))))
+               %invalid-priority-strings))))