← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/reader.test

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
test-suite/tests/reader.test
 
1
;;;; reader.test --- test the Guile parser -*- scheme -*-
 
2
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 
3
 
 
4
(define exception:eof
 
5
  (cons 'read-error "end of file$"))
 
6
 
 
7
(define exception:unexpected-rparen
 
8
  (cons 'read-error "unexpected \")\"$"))
 
9
 
 
10
(define (read-string s)
 
11
  (with-input-from-string s (lambda () (read))))
 
12
 
 
13
(with-test-prefix "reading"
 
14
  (pass-if "0"
 
15
    (equal? (read-string "0") 0))
 
16
  (pass-if "1++i"
 
17
    (equal? (read-string "1++i") '1++i))
 
18
  (pass-if "1+i+i"
 
19
    (equal? (read-string "1+i+i") '1+i+i))
 
20
  (pass-if "1+e10000i"
 
21
    (equal? (read-string "1+e10000i") '1+e10000i))
 
22
 
 
23
  ;; At one time the arg list for "Unknown # object: ~S" didn't make it out
 
24
  ;; of read.c.  Check that `format' can be applied to this error.
 
25
  (pass-if "error message on bad #"
 
26
    (catch #t
 
27
           (lambda ()
 
28
             (read-string "#ZZZ")
 
29
             ;; oops, this # is supposed to be unrecognised
 
30
             #f)
 
31
           (lambda (key subr message args rest)
 
32
             (apply format #f message args)
 
33
             ;; message and args are ok
 
34
             #t))))
 
35
 
 
36
(pass-if-exception "radix passed to number->string can't be zero"
 
37
  exception:out-of-range
 
38
  (number->string 10 0))
 
39
(pass-if-exception "radix passed to number->string can't be one either"
 
40
  exception:out-of-range
 
41
  (number->string 10 1))
 
42
 
 
43
(with-test-prefix "mismatching parentheses"
 
44
  (pass-if-exception "opening parenthesis"
 
45
    exception:eof
 
46
    (read-string "("))
 
47
  (pass-if-exception "closing parenthesis following mismatched opening"
 
48
    exception:unexpected-rparen
 
49
    (read-string ")"))
 
50
  (pass-if-exception "opening vector parenthesis"
 
51
    exception:eof
 
52
    (read-string "#("))
 
53
  (pass-if-exception "closing parenthesis following mismatched vector opening"
 
54
     exception:unexpected-rparen
 
55
     (read-string ")")))