~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/srfi-39.test

  • Committer: Bazaar Package Importer
  • Author(s): Steve Langasek
  • Date: 2009-06-04 19:01:38 UTC
  • mfrom: (8.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20090604190138-1ao3t6sj31cqvcfe
Tags: 1.8.6+1-1ubuntu1
* Merge from Debian unstable, remaining changes:
  - Build with -Wno-error.
  - Build with thread support. Some guile-using programs like autogen need it.
  - Add debian/guile-1.8-libs.shlibs: Thread support breaks ABI, bump the soname.
* Dropped changes:
  - libltdl3-dev -> libltdl7-dev: current libltdl-dev Provides: both.
  - debian/patches/libtool-ftbfs.diff: integrated upstream.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
;;;; srfi-39.test --- -*- scheme -*-
2
2
;;;;
3
 
;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
 
3
;;;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
4
4
;;;; 
5
5
;;;; This program is free software; you can redistribute it and/or modify
6
6
;;;; it under the terms of the GNU General Public License as published by
19
19
 
20
20
(define-module (test-srfi-39)
21
21
  #:use-module (test-suite lib)
22
 
  #:use-module (srfi srfi-39))
 
22
  #:use-module (srfi srfi-34)
 
23
  #:use-module (srfi srfi-39)
 
24
  #:duplicates (last) ;; avoid warning about srfi-34 replacing `raise'
 
25
  )
23
26
 
24
27
(define a (make-parameter 3))
25
28
(define b (make-parameter 4))
53
56
           (check c d 10 9)
54
57
           (parameterize ((c (a)) (d (b)))
55
58
             (and (check a b 0 1)
56
 
                  (check c d 0 1)))))))
 
59
                  (check c d 0 1))))))
 
60
 
 
61
  (pass-if "SRFI-34"
 
62
    (let ((inside? (make-parameter #f)))
 
63
      (call/cc (lambda (return)
 
64
                 (with-exception-handler
 
65
                  (lambda (c)
 
66
                    ;; This handler should be called in the dynamic
 
67
                    ;; environment installed by `parameterize'.
 
68
                    (return (inside?)))
 
69
                  (lambda ()
 
70
                    (parameterize ((inside? #t))
 
71
                      (raise 'some-exception)))))))))
57
72
 
58
73
(let ()
59
74
  (define (test-ports param new-port new-port-2)