1;;;; procprop.test --- Procedure properties -*- mode: scheme; coding: utf-8; -*- 2;;;; Ludovic Courtès <ludo@gnu.org> 3;;;; 4;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 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 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 (pass-if "from eval" 32 (eq? 'foobar (procedure-name 33 (eval '(begin (define (foobar) #t) foobar) 34 (current-module)))))) 35 36 37(with-test-prefix "procedure-arity" 38 (pass-if "simple subr" 39 (equal? (procedure-minimum-arity display) 40 '(1 1 #f))) 41 42 (pass-if "gsubr" 43 (equal? (procedure-minimum-arity hashq-ref) 44 '(2 1 #f))) 45 46 (pass-if "port-closed?" 47 (equal? (procedure-minimum-arity port-closed?) 48 '(1 0 #f))) 49 50 (pass-if "apply" 51 (equal? (procedure-minimum-arity apply) 52 '(2 0 #t))) 53 54 (pass-if "cons*" 55 (equal? (procedure-minimum-arity cons*) 56 '(1 0 #t))) 57 58 (pass-if "list" 59 (equal? (procedure-minimum-arity list) 60 '(0 0 #t))) 61 62 (pass-if "fixed, eval" 63 (equal? (procedure-minimum-arity (eval '(lambda (a b) #t) 64 (current-module))) 65 '(2 0 #f))) 66 67 (pass-if "rest, eval" 68 (equal? (procedure-minimum-arity (eval '(lambda (a b . c) #t) 69 (current-module))) 70 '(2 0 #t))) 71 72 (pass-if "opt, eval" 73 (equal? (procedure-minimum-arity (eval '(lambda* (a b #:optional c) #t) 74 (current-module))) 75 '(2 1 #f)))) 76