Read complex numbers where both parts are inexact decimals
[bpt/guile.git] / test-suite / tests / srfi-17.test
CommitLineData
7171f1ab
DH
1;;;; srfi-17.test --- test suite for Guile's SRFI-17 functions. -*- scheme -*-
2;;;;
6e7d5622 3;;;; Copyright (C) 2001, 2003, 2005, 2006 Free Software Foundation, Inc.
7171f1ab 4;;;;
53befeb7
NJ
5;;;; This library is free software; you can redistribute it and/or
6;;;; modify it under the terms of the GNU Lesser General Public
7;;;; License as published by the Free Software Foundation; either
8;;;; version 3 of the License, or (at your option) any later version.
7171f1ab 9;;;;
53befeb7 10;;;; This library is distributed in the hope that it will be useful,
7171f1ab 11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
53befeb7
NJ
12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13;;;; Lesser General Public License for more details.
7171f1ab 14;;;;
53befeb7
NJ
15;;;; You should have received a copy of the GNU Lesser General Public
16;;;; License along with this library; if not, write to the Free Software
17;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
7171f1ab 18
d6e04e7c
DH
19(define-module (test-suite test-srfi-17)
20 :use-module (test-suite lib)
21 :use-module (srfi srfi-17))
22
7171f1ab 23
3c1f825c
KR
24(pass-if "cond-expand srfi-17"
25 (cond-expand (srfi-17 #t)
26 (else #f)))
27
28;;
29;; car
30;;
31
32(with-test-prefix "car"
33
8e1973d9
KR
34 ;; this test failed in guile 1.8.1 and 1.6.8 and earlier, since `define'
35 ;; didn't set a name on a procedure-with-setter
36 (pass-if "procedure-name"
37 (if (memq 'procnames (debug-options)) ;; enabled by default
38 (eq? 'car (procedure-name car))
39 (throw 'unsupported)))
40
3c1f825c
KR
41 (pass-if "set! (car x)"
42 (let ((lst (list 1)))
43 (set! (car lst) 2)
44 (eqv? 2 (car lst)))))
45
46;;
47;; set!
48;;
49
e08f3f7a
LC
50(define %some-variable #f)
51
a48358b3
AW
52(define exception:bad-quote
53 '(syntax-error . "quote: bad syntax"))
54
7171f1ab
DH
55(with-test-prefix "set!"
56
57 (with-test-prefix "target is not procedure with setter"
58
59 (pass-if-exception "(set! (symbol->string 'x) 1)"
60 exception:wrong-type-arg
61 (set! (symbol->string 'x) 1))
62
63 (pass-if-exception "(set! '#f 1)"
a48358b3 64 exception:bad-quote
e08f3f7a
LC
65 (eval '(set! '#f 1) (interaction-environment))))
66
67 (with-test-prefix "target uses macro"
68
69 (pass-if "(set! (@@ ...) 1)"
70 (eval '(set! (@@ (test-suite test-srfi-17) %some-variable) 1)
71 (interaction-environment))
72 (equal? %some-variable 1))
73
74 ;; The `(quote x)' below used to be memoized as an infinite list before
75 ;; Guile 1.8.3.
76 (pass-if-exception "(set! 'x 1)"
a48358b3 77 exception:bad-quote
e08f3f7a 78 (eval '(set! 'x 1) (interaction-environment)))))
3c1f825c
KR
79
80;;
81;; setter
82;;
83
84(with-test-prefix "setter"
85
86 (pass-if-exception "set! (setter x)" (cons 'misc-error ".*")
87 (set! (setter car) noop))
88
89 (pass-if "car"
90 (eq? set-car! (setter car))))