test-suite/tests/procprop.test

   1 ;;;; procprop.test --- Procedure properties -*- mode: scheme; coding: utf-8; -*-
   2 ;;;; Ludovic Courtès <ludo@gnu.org>
   3 ;;;;
   4 ;;;;    Copyright (C) 2009, 2010 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library 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 GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (define-module (test-procpop)
  21   :use-module (test-suite lib))
  22
  23 \f
  24 (with-test-prefix "procedure-name"
  25   (pass-if "simple subr"
  26     (eq? 'display (procedure-name display)))
  27
  28   (pass-if "gsubr"
  29     (eq? 'hashq-ref (procedure-name hashq-ref))))
  30
  31 \f
  32 (with-test-prefix "procedure-arity"
  33   (pass-if "simple subr"
  34     (equal? (procedure-minimum-arity display)
  35             '(1 1 #f)))
  36
  37   (pass-if "gsubr"
  38     (equal? (procedure-minimum-arity hashq-ref)
  39             '(2 1 #f)))
  40
  41   (pass-if "port-closed?"
  42     (equal? (procedure-minimum-arity port-closed?)
  43             '(1 0 #f)))
  44
  45   (pass-if "apply"
  46     (equal? (procedure-minimum-arity apply)
  47             '(1 0 #t)))
  48
  49   (pass-if "cons*"
  50     (equal? (procedure-minimum-arity cons*)
  51             '(1 0 #t)))
  52
  53   (pass-if "list"
  54     (equal? (procedure-minimum-arity list)
  55             '(0 0 #t))))