guile18/test-suite/tests/procprop.test

   1 ;;;; procprop.test --- Procedure properties               -*- Scheme -*-
   2 ;;;; Ludovic Courtès <ludo@gnu.org>
   3 ;;;;
   4 ;;;;    Copyright (C) 2009 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This program is free software; you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation; either version 2, or (at your option)
   9 ;;;; any later version.
  10 ;;;;
  11 ;;;; This program is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with this software; see the file COPYING.  If not, write to
  18 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19 ;;;; Boston, MA 02110-1301 USA
  20
  21 (define-module (test-procpop)
  22   :use-module (test-suite lib))
  23
  24 \f
  25 (with-test-prefix "procedure-name"
  26   (pass-if "simple subr"
  27     (eq? 'display (procedure-name display)))
  28
  29   (pass-if "gsubr"
  30     (eq? 'hashq-ref (procedure-name hashq-ref))))
  31
  32 \f
  33 (with-test-prefix "procedure-arity"
  34   (pass-if "simple subr"
  35     (equal? (procedure-property display 'arity)
  36             '(1 1 #f)))
  37
  38   (pass-if "gsubr"
  39     (equal? (procedure-property hashq-ref 'arity)
  40             '(2 1 #f)))
  41
  42   (pass-if "port-closed?"
  43     (equal? (procedure-property port-closed? 'arity)
  44             '(1 0 #f)))
  45
  46   (pass-if "apply"
  47     (equal? (procedure-property apply 'arity)
  48             '(1 0 #t)))
  49
  50   (pass-if "cons*"
  51     (equal? (procedure-property cons* 'arity)
  52             '(1 0 #t)))
  53
  54   (pass-if "list"
  55     (equal? (procedure-property list 'arity)
  56             '(0 0 #t))))
  57
  58
  59 ;;; Local Variables:
  60 ;;; coding: latin-1
  61 ;;; End: