Commit | Line | Data |
---|---|---|
b8ed3de3 LC |
1 | ;;;; procprop.test --- Procedure properties -*- mode: scheme; coding: utf-8; -*- |
2 | ;;;; Ludovic Courtès <ludo@gnu.org> | |
e47096d9 | 3 | ;;;; |
fe2400c9 | 4 | ;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
e47096d9 | 5 | ;;;; |
53befeb7 NJ |
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, | |
e47096d9 | 12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
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 | |
e47096d9 LC |
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" | |
ee15aa46 AW |
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)))))) | |
e47096d9 LC |
35 | |
36 | \f | |
37 | (with-test-prefix "procedure-arity" | |
38 | (pass-if "simple subr" | |
4597cd20 | 39 | (equal? (procedure-minimum-arity display) |
e47096d9 LC |
40 | '(1 1 #f))) |
41 | ||
42 | (pass-if "gsubr" | |
4597cd20 | 43 | (equal? (procedure-minimum-arity hashq-ref) |
e47096d9 LC |
44 | '(2 1 #f))) |
45 | ||
46 | (pass-if "port-closed?" | |
4597cd20 | 47 | (equal? (procedure-minimum-arity port-closed?) |
e47096d9 LC |
48 | '(1 0 #f))) |
49 | ||
50 | (pass-if "apply" | |
4597cd20 | 51 | (equal? (procedure-minimum-arity apply) |
e47096d9 LC |
52 | '(1 0 #t))) |
53 | ||
54 | (pass-if "cons*" | |
4597cd20 | 55 | (equal? (procedure-minimum-arity cons*) |
e47096d9 LC |
56 | '(1 0 #t))) |
57 | ||
58 | (pass-if "list" | |
4597cd20 | 59 | (equal? (procedure-minimum-arity list) |
f3cf9421 AW |
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))) | |
fe2400c9 LC |
75 | '(2 1 #f))) |
76 | ||
77 | (if (include-deprecated-features) | |
78 | (pass-if-exception "set-procedure-properties! arity" | |
79 | '(misc-error . "arity is a read-only property") | |
80 | (set-procedure-properties! (lambda x x) '((arity . 3)))) | |
81 | #t)) |