test-suite/tests/exceptions.test

   1 ;;;; exceptions.test --- tests for Guile's exception handling  -*- scheme -*-
   2 ;;;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This library is free software; you can redistribute it and/or
   5 ;;;; modify it under the terms of the GNU Lesser General Public
   6 ;;;; License as published by the Free Software Foundation; either
   7 ;;;; version 2.1 of the License, or (at your option) any later version.
   8 ;;;;
   9 ;;;; This library is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;;; Lesser General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU Lesser General Public
  15 ;;;; License along with this library; if not, write to the Free Software
  16 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17
  18
  19 (use-modules (test-suite lib))
  20
  21 (with-test-prefix "throw/catch"
  22
  23   (with-test-prefix "wrong type argument"
  24
  25     (pass-if-exception "(throw 1)"
  26       exception:wrong-type-arg
  27       (throw 1)))
  28
  29   (with-test-prefix "wrong number of arguments"
  30
  31     (pass-if-exception "(throw)"
  32       exception:wrong-num-args
  33       (throw))
  34
  35     (pass-if-exception "throw 1 / catch 0"
  36       exception:wrong-num-args
  37       (catch 'a
  38         (lambda () (throw 'a))
  39         (lambda () #f)))
  40
  41     (pass-if-exception "throw 2 / catch 1"
  42       exception:wrong-num-args
  43       (catch 'a
  44         (lambda () (throw 'a 2))
  45         (lambda (x) #f)))
  46
  47     (pass-if-exception "throw 1 / catch 2"
  48       exception:wrong-num-args
  49       (catch 'a
  50         (lambda () (throw 'a))
  51         (lambda (x y) #f)))
  52
  53     (pass-if-exception "throw 3 / catch 2"
  54       exception:wrong-num-args
  55       (catch 'a
  56         (lambda () (throw 'a 2 3))
  57         (lambda (y x) #f)))
  58
  59     (pass-if-exception "throw 1 / catch 2+"
  60       exception:wrong-num-args
  61       (catch 'a
  62         (lambda () (throw 'a))
  63         (lambda (x y . rest) #f)))))
  64
  65 (with-test-prefix "false-if-exception"
  66
  67   (pass-if (false-if-exception #t))
  68   (pass-if (not (false-if-exception #f)))
  69   (pass-if (not (false-if-exception (error "xxx"))))
  70
  71   ;; Not yet working.
  72   ;;
  73   ;; (with-test-prefix "in empty environment"
  74   ;;   ;; an environment with no bindings at all
  75   ;;   (define empty-environment
  76   ;;     (make-module 1))
  77   ;;
  78   ;;   (pass-if "#t"
  79   ;;     (eval `(,false-if-exception #t)
  80   ;;        empty-environment))
  81   ;;   (pass-if "#f"
  82   ;;     (not (eval `(,false-if-exception #f)
  83   ;;             empty-environment)))
  84   ;;   (pass-if "exception"
  85   ;;     (not (eval `(,false-if-exception (,error "xxx"))
  86   ;;                empty-environment))))
  87   )