(load-relative "loadtest.ss")

(Section 'reading)
(define readstr
  (lambda (s)
    (let* ([o (open-input-string s)]
	   [read (lambda () (read o))])
      (let loop ([last eof])
	(let ([v (read)])
	  (if (eof-object? v)
	      last
	      (loop v)))))))

(define readerrtype
  (lambda (x) x))

; Make sure {whitespace} == {delimiter}
(let ([with-censor (load-relative "censor.ss")])
  (with-censor
   (lambda ()
     (let loop ([n 0])
       (unless (= n 256)
	 (let* ([c0 (integer->char n)]
		[c (if (read-case-sensitive)
		       c0
		       (char-downcase c0))])
	   (cond
	    [(char-whitespace? c)
	     (test 'b readstr (string #\a c #\b))]
	    [(char=? #\\ c) (test 'ab readstr (string #\a c #\b))]
	    [(char=? #\; c) (test 'a readstr (string #\a c #\b))]
	    [(char=? #\' c) (test ''b readstr (string #\a c #\b))]
	    [(char=? #\` c) (test '`b readstr (string #\a c #\b))]
	    [(char=? #\, c) (test ',b readstr (string #\a c #\b))]
	    [else
	     (test (string->symbol (string #\a c #\b))
		   'readstr
		   (with-handlers ([void 
				    (lambda (x) 
				      (string->symbol (string #\a c #\b)))])
		     (readstr (string #\a c0 #\b))))]))
	 (loop (add1 n)))))))

(err/rt-test (readstr ")") exn:fail:read?)
(err/rt-test (readstr "[)") exn:fail:read?)
(err/rt-test (readstr "[}") exn:fail:read?)
(err/rt-test (readstr "8 )") exn:fail:read?)
(err/rt-test (readstr "(. )") exn:fail:read?)
(err/rt-test (readstr "(. 8)") exn:fail:read?)
(err/rt-test (readstr "(8 . )") exn:fail:read?)
(err/rt-test (readstr "(8 . ]") exn:fail:read?)
(err/rt-test (readstr "(8 . 9 . )") exn:fail:read?)
(err/rt-test (readstr "(8 . 9 . ]") exn:fail:read?)
(err/rt-test (readstr "(8 . 9 . 1 . )") exn:fail:read?)
(err/rt-test (readstr "(8 . 9 . 1 . 10)") exn:fail:read?)

(test (integer->char 0) readstr "#\\nul")
(test (integer->char 0) readstr "#\\Nul")
(test (integer->char 0) readstr "#\\NuL")
(test (integer->char 0) readstr "#\\null")
(test (integer->char 0) readstr "#\\Null")
(test (integer->char 0) readstr "#\\NulL")
(test (integer->char 8) readstr "#\\Backspace")
(test (integer->char 8) readstr "#\\BacksPace")
(test (integer->char 9) readstr "#\\tab")
(test (integer->char 9) readstr "#\\Tab")
(test (integer->char 9) readstr "#\\TaB")
(test (integer->char 10) readstr "#\\newline")
(test (integer->char 10) readstr "#\\Newline")
(test (integer->char 10) readstr "#\\NewLine")
(test (integer->char 10) readstr "#\\linefeed")
(test (integer->char 10) readstr "#\\Linefeed")
(test (integer->char 10) readstr "#\\LinefEeD")
(test (integer->char 11) readstr "#\\vtab")
(test (integer->char 11) readstr "#\\Vtab")
(test (integer->char 11) readstr "#\\VtAb")
(test (integer->char 12) readstr "#\\page")
(test (integer->char 12) readstr "#\\Page")
(test (integer->char 12) readstr "#\\PaGe")
(test (integer->char 13) readstr "#\\return")
(test (integer->char 13) readstr "#\\Return")
(test (integer->char 13) readstr "#\\retUrn")
(test (integer->char 127) readstr "#\\rubout")
(test (integer->char 127) readstr "#\\Rubout")
(test (integer->char 127) readstr "#\\RubOut")
(test (integer->char #x1) readstr "#\\u1")
(test (integer->char #x10) readstr "#\\u10")
(test (integer->char #x100) readstr "#\\u100")
(test (integer->char #x1000) readstr "#\\u1000")
(test (integer->char #xa) readstr "#\\ua")
(test (integer->char #xa7) readstr "#\\uA7")
(test (integer->char #xa77) readstr "#\\ua77")
(test (integer->char #xa77C) readstr "#\\uA77C")
(test 0 readstr "#\\u10000")
(test 'a readstr "#\\ua000a")
(test 'x readstr "#\\ua000x")
(test (integer->char #xa) readstr "#\\Ua")
(test (integer->char #xa7) readstr "#\\UA7")
(test (integer->char #xa77) readstr "#\\Ua77")
(test (integer->char #xa77C) readstr "#\\UA77C")
(test (integer->char #x10000) readstr "#\\U10000")
(test (integer->char #x100000) readstr "#\\U100000")
(test (integer->char #x10FFFF) readstr "#\\U10FFFF")
(test (integer->char #x10FFFF) readstr "#\\U0010FFFF")
(test (integer->char #x0) readstr "#\\U00000000")
(test 1 readstr "#\\U000000011")

(err/rt-test (readstr "#\\uD800") exn:fail:read?)
(err/rt-test (readstr "#\\uD900") exn:fail:read?)
(err/rt-test (readstr "#\\UDFFF") exn:fail:read?)
(err/rt-test (readstr "#\\UFFFFFF") exn:fail:read?)
(err/rt-test (readstr "#\\U110000") exn:fail:read?)
(err/rt-test (readstr "#\\U1000000") exn:fail:read?)
(err/rt-test (readstr "#\\U10000000") exn:fail:read?)
(err/rt-test (readstr "#\\UFFFFFFFF") exn:fail:read?)

(define (astring n) (string (integer->char n)))

(test (astring 7) readstr "\"\\a\"")
(test (astring 8) readstr "\"\\b\"")
(test (astring 9) readstr "\"\\t\"")
(test (astring 10) readstr "\"\\n\"")
(test (astring 11) readstr "\"\\v\"")
(test (astring 12) readstr "\"\\f\"")
(test (astring 13) readstr "\"\\r\"")
(test #\u1B string-ref (readstr "\"\\e\"") 0)
(test #\u0 string-ref (readstr "\"\\0\"") 0)
(test #\u8 string-ref (readstr "\"\\10\"") 0)
(test #\uC string-ref (readstr "\"\\14\"") 0)
(test (integer->char #o114)  string-ref (readstr "\"\\114\"") 0)
(test (integer->char #o111)  string-ref (readstr "\"\\1111\"") 0)
(test (astring #x24) readstr "\"\\x24\"")
(test (string #\u24 #\space) readstr "\"\\x24 \"")
(test (string #\u24 #\5) readstr "\"\\x245\"")
(test (astring #x1024) readstr "\"\\u1024\"")
(test (astring #x1C24) readstr "\"\\u1C24\"")
(test (string #\u0001) readstr "\"\\u1\"")
(test (string #\u0001 #\space) readstr "\"\\u1 \"")
(test (string #\u0001) readstr "\"\\u01\"")
(test (string #\u0001 #\space) readstr "\"\\u01 \"")
(test (string #\u0001) readstr "\"\\u001\"")
(test (string #\u0001 #\space) readstr "\"\\u001 \"")
(test (string #\u0001) readstr "\"\\u0001\"")
(test (string #\u0001 #\space) readstr "\"\\u0001 \"")
(test (string #\u0001 #\1) readstr "\"\\u00011\"")

(err/rt-test (readstr "\"\\c\"") exn:fail:read?)
(err/rt-test (readstr "\"\\777\"") exn:fail:read?)
(err/rt-test (readstr "\"\\uD800\"") exn:fail:read?)
(err/rt-test (readstr "\"\\UB0000000\"") exn:fail:read?)
(err/rt-test (readstr "\"\\UFFFFFFFF\"") exn:fail:read?)

(test (bytes 7) readstr "#\"\\a\"")
(test (bytes 8) readstr "#\"\\b\"")
(test (bytes 9) readstr "#\"\\t\"")
(test (bytes 10) readstr "#\"\\n\"")
(test (bytes 11) readstr "#\"\\v\"")
(test (bytes 12) readstr "#\"\\f\"")
(test (bytes 13) readstr "#\"\\r\"")
(test #x1B bytes-ref (readstr "#\"\\e\"") 0)
(test #x0 bytes-ref (readstr "#\"\\0\"") 0)
(test #x8 bytes-ref (readstr "#\"\\10\"") 0)
(test #xC bytes-ref (readstr "#\"\\14\"") 0)
(test #o114 bytes-ref (readstr "#\"\\114\"") 0)
(test #o111 bytes-ref (readstr "#\"\\1111\"") 0)
(test (bytes #x24) readstr "#\"\\x24\"")
(test (bytes #x24 32) readstr "#\"\\x24 \"")
(test (bytes #x24 53) readstr "#\"\\x245\"")

(err/rt-test (readstr "#\"\\c\"") exn:fail:read?)
(err/rt-test (readstr "#\"\\777\"") exn:fail:read?)
(err/rt-test (readstr "#\"\\u0040\"") exn:fail:read?)

(load-relative "numstrs.ss")
(let loop ([l number-table])
  (unless (null? l)
    (let* ([pair (car l)]
           [v (car pair)]
           [s (cadr pair)])
      (cond
       [(memq v '(X DBZ NOE))
        (err/rt-test (readstr s) exn:fail:read?)
        (test #f string->number s)]
       [v 
        (printf "here ~a\n" test)
        (test v readstr s)
        (test (if (symbol? v) #f v) string->number s)]
       [else 
        (test (string->symbol s) readstr s)
        (test #f string->number s)
        (unless (regexp-match "#" s)
          (err/rt-test (readstr (string-append "#d" s)) exn:fail:read?)
          (test #f string->number (string-append "#d" s)))]))
    (loop (cdr l))))

(test 5 readstr "#| hi |# 5")
(test 5 readstr "#| #| #| #| hi |# |# |# |# 5")
(test '(5) readstr "(#| #| #| #| hi |# |# |# |# 5)")
(test '(10 1) readstr "(10 #|z#|#f|#z|# 1)")
(test 17 readstr "#|z#|#f|#z|# 17")
(test 17 readstr "#|#|x|#|# 17")

(err/rt-test (readstr "#\\silly") exn:fail:read?)
(err/rt-test (readstr "#\\nully") exn:fail:read?)
(err/rt-test (readstr "#\\nu") exn:fail:read?)
(err/rt-test (readstr "#\\733") exn:fail:read?)
(err/rt-test (readstr "#\\433") exn:fail:read?)
(err/rt-test (readstr "#\\longerthanthrityonecharcterswhichisthebufsize") exn:fail:read?)
(err/rt-test (readstr "#\\rcase") exn:fail:read?)
(err/rt-test (readstr "#\\pcase") exn:fail:read?)
(err/rt-test (readstr "#\\tcase") exn:fail:read?)
(err/rt-test (readstr "#\\vcase") exn:fail:read?)
(err/rt-test (readstr "#\\bcase") exn:fail:read?)
(err/rt-test (readstr "#\\lcase") exn:fail:read?)

(err/rt-test (readstr "(hi") exn:fail:read:eof?)
(err/rt-test (readstr "\"hi") exn:fail:read:eof?)
(err/rt-test (readstr "\"hi\\") exn:fail:read:eof?)
(err/rt-test (readstr "#(hi") exn:fail:read:eof?)
(err/rt-test (readstr "#[hi") exn:fail:read:eof?)
(err/rt-test (readstr "#{hi") exn:fail:read:eof?)
(err/rt-test (readstr "#4(hi") exn:fail:read:eof?)
(err/rt-test (readstr "#4[hi") exn:fail:read:eof?)
(err/rt-test (readstr "#4{hi") exn:fail:read:eof?)
(err/rt-test (readstr "|hi") exn:fail:read:eof?)
(err/rt-test (readstr "hi\\") exn:fail:read:eof?)
(err/rt-test (readstr "#\\") exn:fail:read:eof?)
(err/rt-test (readstr "#\\12") exn:fail:read:eof?)
(err/rt-test (readstr "#| hi") exn:fail:read:eof?)
(err/rt-test (readstr "(1 #| hi") exn:fail:read:eof?)
(err/rt-test (readstr "'") exn:fail:read:eof?)
(err/rt-test (readstr "`") exn:fail:read:eof?)
(err/rt-test (readstr ",@") exn:fail:read:eof?)
(err/rt-test (readstr ",") exn:fail:read:eof?)
(err/rt-test (readstr "#'") exn:fail:read:eof?)
(err/rt-test (readstr "#&") exn:fail:read:eof?)

(err/rt-test (readstr ".") exn:fail:read?)
(err/rt-test (readstr "a .") exn:fail:read?)
(err/rt-test (readstr "a . b") exn:fail:read?)
(err/rt-test (readstr "( . )") exn:fail:read?)
(err/rt-test (readstr "(1 .") exn:fail:read:eof?)
(err/rt-test (readstr "(1 .   ") exn:fail:read:eof?)
(err/rt-test (readstr "(1 . 2") exn:fail:read:eof?)
(err/rt-test (readstr "( . 8)") exn:fail:read?)
(err/rt-test (readstr "(0 . 8 9)") exn:fail:read?)
(err/rt-test (readstr "( . 8 9)") exn:fail:read?)
(err/rt-test (readstr "(1 . 2 3 . 4)") exn:fail:read?)
(err/rt-test (readstr "(1 . 2 . 3 . 4)") exn:fail:read?)
(err/rt-test (readstr "(1 . 2 .3)") exn:fail:read?)
(err/rt-test (readstr "(1 . 2 .a)") exn:fail:read?)
(err/rt-test (readstr "#(8 . )") exn:fail:read?)
(err/rt-test (readstr "#( . )") exn:fail:read?)
(err/rt-test (readstr "#( . 8)") exn:fail:read?)
(err/rt-test (readstr "#(0 . 8 9)") exn:fail:read?)
(err/rt-test (readstr "#( . 8 9)") exn:fail:read?)
(err/rt-test (readstr "#( 8 . 9)") exn:fail:read?)
(err/rt-test (readstr "#( 8 . (9))") exn:fail:read?)
(err/rt-test (readstr "#(1 . 2 . 3)") exn:fail:read?)

(err/rt-test (readstr "#Q") exn:fail:read?)
(err/rt-test (readstr "##") exn:fail:read?)
(err/rt-test (readstr "#?") exn:fail:read?)
(err/rt-test (readstr "#-1()") exn:fail:read?)
(err/rt-test (readstr "#<a>") exn:fail:read?)
(err/rt-test (readstr "#") exn:fail:read:eof?)

(test #(1 a c) readstr "#[1 a c]")
(test #(1 a c) readstr "#{1 a c}")
(test #(1 a a) readstr "#3[1 a]")
(test #(1 a a) readstr "#3{1 a}")
(parameterize ([read-square-bracket-as-paren #f]
	       [read-curly-brace-as-paren #f]
	       [read-accept-quasiquote #f])
  (err/rt-test (readstr "[2") exn:fail:read?)
  (err/rt-test (readstr "{2") exn:fail:read?)
  (err/rt-test (readstr "}2") exn:fail:read?)
  (err/rt-test (readstr "]2") exn:fail:read?)
  (err/rt-test (readstr "#{1}") exn:fail:read?)
  (err/rt-test (readstr "#[1]") exn:fail:read?)
  (err/rt-test (readstr "#2{1}") exn:fail:read?)
  (err/rt-test (readstr "#2[1]") exn:fail:read?)
  (err/rt-test (readstr ",2") exn:fail:read?)
  (err/rt-test (readstr ",@2") exn:fail:read?)
  (err/rt-test (readstr "`2") exn:fail:read?))

(test '(1 2 3) readstr "(2 . 1 . 3)")
(test '(1 2 3 4) readstr "(2 . 1 . 3 4)")
(test '(1 2 3 4) readstr "(2 3 . 1 . 4)")
(test '(2 . 0.4) readstr "(2 . .4)")

(err/rt-test (readstr "#ha") exn:fail:read:eof?)
(err/rt-test (readstr "#ham") exn:fail:read?)
(err/rt-test (readstr "#hash") exn:fail:read:eof?)
(err/rt-test (readstr "#hashe") exn:fail:read:eof?)
(err/rt-test (readstr "#hasheq") exn:fail:read:eof?)
(err/rt-test (readstr "#hasheqv") exn:fail:read:eof?)
(err/rt-test (readstr "#hash(") exn:fail:read:eof?)
(err/rt-test (readstr "#hash((1") exn:fail:read:eof?)
(err/rt-test (readstr "#hash((1 .") exn:fail:read:eof?)
(err/rt-test (readstr "#hash((1 . 2)") exn:fail:read:eof?)
(err/rt-test (readstr "#hash(1)") exn:fail:read?)
(err/rt-test (readstr "#hash(1 2)") exn:fail:read?)
(err/rt-test (readstr "#hash(1 . 2)") exn:fail:read?)
(err/rt-test (readstr "#hash((1))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 2))") exn:fail:read?)
(err/rt-test (readstr "#hash((1. 2))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 .2))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 . 2 3))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 . 2) . ((3 . 4)))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 . 2) . (3 . 4) . (5 . 6))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 . 2 . 3))") exn:fail:read?)
(err/rt-test (readstr "#hash(#0=(1 . 2))") exn:fail:read?)
(err/rt-test (readstr "#hash#0=((1 . 2))") exn:fail:read?)
(err/rt-test (readstr "#hash((1 #0=(2)))") exn:fail:read?)
(err/rt-test (readstr "#0=#hash#0#") exn:fail:read?)
(err/rt-test (readstr "#0=#hash(#0#)") exn:fail:read?)
(err/rt-test (readstr "#hash([1 . 2))") exn:fail:read?)

(define (test-ht t size eq? key val)
  (test #t hash? t)
  (test eq? hash-eq? t)
  (test size length (hash-map t cons))
  (test 'nope hash-ref t 'not-there (lambda () 'nope))
  (test val hash-ref t key (lambda () #f)))
(test-ht (readstr "#hash()") 0 #f 'none #f)
(test-ht (readstr "#hash((1 . 2))") 1 #f 1 2)
(test-ht (readstr "#hash([1 . 2])") 1 #f 1 2)
(test-ht (readstr "#hash[(1 . 2)]") 1 #f 1 2)
(test-ht (readstr "#hash({1 . 2})") 1 #f 1 2)
(test-ht (readstr "#hash{(1 . 2)}") 1 #f 1 2)
(test-ht (readstr "#hash{[1 . 2]}") 1 #f 1 2)
(test-ht (readstr "#hasheq((1 . 2))") 1 #t 1 2)
(test-ht (readstr "#hasheqv((1 . 2))") 1 #f 1 2)
(test-ht (readstr "#hash((\"apple\" . 1))") 1 #f "apple" 1)
(test-ht (readstr "#hasheq((\"apple\" . 1))") 1 #t "apple" #f)
(test-ht (readstr "#hasheqv((\"apple\" . 1))") 1 #f "apple" #f)
(test-ht (readstr "#hash((\"apple\" . 1) (\"apple\" . 10))") 1 #f "apple" 10)
(test-ht (readstr "#hasheq((\"apple\" . 1) (\"apple\" . 10))") 2 #t "apple" #f)
(test-ht (readstr "#hasheqv((\"apple\" . 1) (\"apple\" . 10))") 2 #f "apple" #f)
(test-ht (readstr "#hash((apple . 1) (apple . 10))") 1 #f 'apple 10)
(test-ht (readstr "#hasheq((apple . 1) (apple . 10))") 1 #t 'apple 10)
(test-ht (readstr "#hasheqv((apple . 1) (apple . 10))") 1 #f 'apple 10)
(test-ht (readstr "#hasheq((#0=\"apple\" . 1) (#0# . 10))") 1 #t "apple" #f)
(test-ht (readstr "#hash((#0=\"apple\" . 1) (\"banana\" . #0#))") 2 #f "banana" "apple")
(test-ht (readstr "#hash((a . 1) (b . 2) (c . 3) (e . 4) (f . 5) (g . 6) (h . 7) (i . 8))") 8 #f 'f 5)
(let ([t (readstr "#0=#hash((\"apple\" . #0#))")])
  (test-ht t 1 #f "apple" t))
(test-ht (readstr "#hash((#hash((1 . 2)) . 11) (#hash((3 . 4)) . 12))") 2 #f #hash((1 . 2)) 11)
(test-ht (readstr "#hash((#hash((1 . 2)) . 11) (#hash((3 . 4)) . 12))") 2 #f #hash((3 . 4)) 12)
(let ([t (readstr "#0=#hasheq((#0# . 17))")])
  (test-ht t 1 #t t 17))
(let ([t (readstr "#0=#hash((#0# . 17))")])
  ;; Don't look for t, because that's a hash on a circular object!
  (test-ht t 1 #f 'none #f))

(define (test-write-ht writer t . strings)
  (let ([o (open-output-string)])
    (writer t o)
    (test #t (car strings) (and (member (get-output-string o) strings) #t))))
(parameterize ([print-hash-table #f])
  (test-write-ht write #hash((1 . 2)) "#<hash>"))

(parameterize ([print-hash-table #t])
  (test-write-ht write #hash((1 . 2)) "#hash((1 . 2))")
  (test-write-ht write #hash((1 . 2) (3 . 4)) "#hash((1 . 2) (3 . 4))" "#hash((3 . 4) (1 . 2))")
  (test-write-ht write #hash(("apple" . |coconut !|)) "#hash((\"apple\" . |coconut !|))")
  (test-write-ht display #hash(("apple" . |coconut !|)) "#hash((apple . coconut !))")
  (test-write-ht write (read (open-input-string "#3=#hash((1 . #3#))")) "#0=#hash((1 . #0#))")
  (test-write-ht write (read (open-input-string "#hash((#37=(1 2) . #37#))")) "#hash(((1 2) . (1 2)))")
  (test-write-ht write (read (open-input-string "#hash((a . #9=(1 2)) (b . #9#))"))
		 "#hash((a . (1 2)) (b . (1 2)))"
		 "#hash((b . (1 2)) (a . (1 2)))")
  (parameterize ([print-graph #t])
    (test-write-ht write (read (open-input-string "#hash((#33=(1 2) . #33#))")) "#hash((#0=(1 2) . #0#))")
    (test-write-ht write (read (open-input-string "#hash((a . #7=(1 2)) (b . #7#))"))
		   "#hash((a . #0=(1 2)) (b . #0#))"
		   "#hash((b . #0=(1 2)) (a . #0#))")))


(test #t regexp? (readstr "#rx\".\""))
(test '("abc") regexp-match #rx"a.." "123abcdef")
(test #t pregexp? (readstr "#px\".\""))
(test '("abc") regexp-match #px"a.." "123abcdef")
(test #t byte-regexp? (readstr "#rx#\".\""))
(test '(#"abc") regexp-match #rx#"a.." "123abcdef")
(test #t byte-pregexp? (readstr "#px#\".\""))
(test '(#"abc") regexp-match #px#"a.." "123abcdef")

(err/rt-test (readstr "#r") exn:fail:read:eof?)
(err/rt-test (readstr "#rx") exn:fail:read:eof?)
(err/rt-test (readstr "#rx\"") exn:fail:read:eof?)
(err/rt-test (readstr "#ra") exn:fail:read?)
(err/rt-test (readstr "#rxa") exn:fail:read?)
(err/rt-test (readstr "#rx\"?\"") exn:fail:read?)
(err/rt-test (readstr "#rx#") exn:fail:read:eof?)
(err/rt-test (readstr "#rx#\"") exn:fail:read:eof?)
(err/rt-test (readstr "#rx#a") exn:fail:read?)
(err/rt-test (readstr "#rx#\"?\"") exn:fail:read?)
(err/rt-test (readstr "#p") exn:fail:read:eof?)
(err/rt-test (readstr "#px") exn:fail:read:eof?)
(err/rt-test (readstr "#px\"") exn:fail:read:eof?)
(err/rt-test (readstr "#pa") exn:fail:read?)
(err/rt-test (readstr "#pxa") exn:fail:read?)
(err/rt-test (readstr "#px\"?\"") exn:fail:read?)
(err/rt-test (readstr "#px#") exn:fail:read:eof?)
(err/rt-test (readstr "#px#\"") exn:fail:read:eof?)
(err/rt-test (readstr "#px#a") exn:fail:read?)
(err/rt-test (readstr "#px#\"?\"") exn:fail:read?)

(test 2 vector-length (readstr "#2()"))
(test 0 vector-ref (readstr "#2()") 1)
(test 2 vector-length (readstr "#000000000000000000000000000000002()"))

(err/rt-test (readstr "#2(1 2 3)") exn:fail:read?)
(err/rt-test (readstr "#200000000000(1 2 3)") (readerrtype exn:fail:out-of-memory?))
(err/rt-test (readstr "#111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111x1(1 2 3)") exn:fail:read?)

(test #t (lambda (x) (eq? (car x) (cdr x))) (readstr "(#1=(1 2) . #0001#)"))
(test #t (lambda (x) (and (box? x) (eq? x (unbox x)))) (readstr "#0=#&#0#"))
(test #t (lambda (x) (and (vector? x) (eq? x (vector-ref x 0)) (eq? x (vector-ref x 1)))) (readstr "#0=#2(#0#)"))
(test #t (lambda (x) (and (vector? x) (eq? (vector-ref x 1) (vector-ref x 2)))) (readstr "#3(#0=(1 2) #0#)"))
(test '(1 1 1) readstr "(#0=1 #1=#0# #1#)")

;; Show that syntax, expansion, etc. do not preserve vector sharing
(test #f 
      (lambda (x) (and (vector? x) (eq? (vector-ref x 0) (vector-ref x 1)))) 
      #2((1 2)))

(define (graph-error-tests readstr graph-ok?)
  (err/rt-test (readstr "#0#") exn:fail:read?)
  (err/rt-test (readstr "#0=#0#") exn:fail:read?)
  (err/rt-test (readstr "#0=#0#") exn:fail:read?)
  (err/rt-test (readstr "(#0# #0=7)") exn:fail:read?)
  (err/rt-test (readstr "(#0=7 #1#)") exn:fail:read?)
  (err/rt-test (readstr "(#0=7 #0=7)") exn:fail:read?)
  (err/rt-test (readstr "#0=") (if graph-ok?
                                   exn:fail:read:eof?
                                   exn:fail:read?))
  (err/rt-test (readstr "#0") exn:fail:read:eof?)
  (err/rt-test (readstr "#012345678=7") exn:fail:read?)
  (err/rt-test (readstr "(#12345678=7 #012345678#)") exn:fail:read?)
  (err/rt-test (readstr "#111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111x1=(1 2 3)") exn:fail:read?)
  (parameterize ([read-accept-graph #f])
    (err/rt-test (readstr "#1=1") exn:fail:read?)
    (err/rt-test (readstr "#1#") exn:fail:read?)))
(graph-error-tests readstr #t)
(graph-error-tests (lambda (s)
		     (read-syntax "string" (open-input-string s)))
                   #f)

;; Long symbol:
(test 'abcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefg
      readstr "abcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefgabcdefg")

(test 3 string-length (readstr (string #\" #\a #\nul #\b #\")))
(test (string->symbol (string #\a #\nul #\b)) 'sym (readstr (string #\a #\nul #\b)))
(test (string->symbol (string #\1 #\nul #\b)) 'sym (readstr (string #\1 #\nul #\b)))

; Test read/write invariance on symbols and use of pipe quotes
(define (test-write-sym with-bar without-bar s)
  (let ([sym (string->symbol s)])
    (parameterize ([read-case-sensitive #t])
      (let ([p (open-output-string)])
	(write sym p)
	(test with-bar 'write-sym-with-bar (get-output-string p))
	(test sym read (open-input-string (get-output-string p))))
      (let ([p (open-output-string)])
	(parameterize ([read-accept-bar-quote #f])
	  (write sym p)
	  (test without-bar 'write-sym-no-bar (get-output-string p))
	  (test sym read (open-input-string (get-output-string p)))))
      (let ([p (open-output-string)])
	(display sym p)
	(test s 'display-sym (get-output-string p))))))

(test-write-sym "a->b" "a->b" "a->b")
(test-write-sym "|a,b|" "a\\,b" "a,b")
(test-write-sym "a\\|b" "a|b" "a|b")
(test-write-sym "|a\\b|" "a\\\\b" "a\\b")

(test 'a 'quote '\a)
(test '|\a| 'quote '\\a)
(test 'a 'quote '||||a||)
#ci(test (string->symbol "aaa") 'quote 'aAa)
#ci(test (string->symbol "aAa") 'quote 'A\AA)
#ci(test (string->symbol "aAa") 'quote '|aAa|)
#ci(test (string->symbol "aAa") 'quote 'A|A|A)

(load-relative "numstrs.ss")
(let loop ([l number-table])
  (cond
   [(null? l) 'done]
   [(or (number? (caar l)) (memq (caar l) '(X DBZ NOE)))
    (test-write-sym (string-append "|" (cadar l) "|") 
		    (string-append "\\" (cadar l)) 
		    (cadar l))
    (loop (cdr l))]
   [else 
    (test-write-sym (cadar l) (cadar l) (cadar l))
    (loop (cdr l))]))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test mid-stream EOF

(define (test-mid-stream-eof use-peek?)
  (define chars (map (lambda (x)
		       (if (char? x) (char->integer x) x))
		     (append
		      (string->list "1 2")
		      (list eof)
		      (string->list "\"a\" \"b\"")
		      (list eof)
		      (string->list "(a) (b)")
		      (list eof)
		      (string->list "eof"))))
  (define cp (make-input-port
	      'mid-stream
	      (lambda (b)
		(if (null? chars)
		    eof
		    (let ([c (car chars)])
		      (set! chars (cdr chars))
		      (cond 
		       [(eof-object? c)
			eof]
		       [else
			(bytes-set! b 0 c)
			1]))))
	      (and use-peek?
		   (lambda (b skip progress-evt)
		     (when (positive? skip)
		       (error 'ouch!))
		     (if (null? chars)
			 eof
			 (let ([c (car chars)])
			   (cond 
			    [(eof-object? c)
			     eof]
			    [else
			     (bytes-set! b 0 c)
			     1])))))
	      void))
  (define (f) (read cp))

  (test 1 f)
  (test 2 f)
  (test eof f)
  (test "a" f)
  (test "b" f)
  (test eof f)
  (test '(a) f)
  (test '(b) f)
  (test eof f)
  (test 'eof f)
  (test eof f)
  (test eof f))

(test-mid-stream-eof #f)
(test-mid-stream-eof #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test non-character results for getc

(define-struct special (size))

(define a-special (make-special 1))
(define b-special (make-special 1))
(define special-comment (make-special 1))

(define (make-p stream special-size check-pos)
  ;; The `stream' arg is a list of strings and non-strings;
  ;;  characters from the strings are returned one by one,
  ;;  and the non-strings are returns as "special" literals.
  ;; The `special-size' arg meansures the size (in char
  ;;  positions) of a non-string special literal.
  (let* ([pos 0]
	 [incpos! (lambda () (set! pos (add1 pos)))]
	 [read-one (lambda (str)
		     (let loop ([s stream][p pos])
		       (if (null? s)
			   eof
			   (let ([i (car s)])
			     (if (bytes? i)
				 (if ((bytes-length i) . > . p)
				     (begin
				       (incpos!)
				       (bytes-set! str 0 (bytes-ref i p))
				       1)
				     (loop (cdr s) (- p (bytes-length i))))
				 ;; a special:
				 (cond
				  [(zero? p) (incpos!)
				   (if (and (number? i) 
					    (or (inexact? i)
						(negative? i)))
				       i ; creates an error
				       (lambda (where line col pos)
					 (check-pos where line col pos)
					 (cond
					  [(symbol? i) (i)]
					  [(eq? i special-comment)
					   (make-special-comment i)]
					  [(number? i)
					   (if (inexact? i)
					       (make-special-comment i)
					       'aha)]
					  [else i])))]
				  [else (loop (cdr s) (sub1 p))]))))))])
    (make-input-port
     'specializer
     ;; Non-blocking read string:
     (lambda (str)
       (read-one str))
     ;; Peek char
     (lambda (str skip progress-evt)
       (let ([old-p pos])
	 (let loop ([skip skip])
	   (unless (zero? skip)
	     (read-one str)
	     (loop (sub1 skip))))
	 (begin0
	  (read-one str)
	  (set! pos old-p))))
     ;; Close proc
     (lambda () #t))))

;; Read without specials:
(let* ([p (make-p `(#"(list "
		    #"a"
		    #" "
		    #"b"
		    #"))")
		  special-size
		  (lambda (w l c p)
		    (error "shouldn't get here")))]
       [_ (port-count-lines! p)]
       [v (syntax-e (read-syntax 'ok p))])
  (test 'list syntax-e (car v))
  (test 'a syntax-e (cadr v))
  (test 'b syntax-e (caddr v))
  (test 1 syntax-line (car v))
  (test 1 syntax-column (car v))
  (test 1 syntax-line (cadr v))
  (test 6 syntax-column (cadr v))
  (test 1 syntax-line (caddr v))
  (test 8 syntax-column (caddr v)))

;; Without specials, with newlines:
(let* ([p (make-p `(#"(list\n"
		    #"a"
		    #"\n"
		    #"b"
		    #"))")
		  special-size
		  (lambda (w l c p)
		    (error "shouldn't get here")))]
       [_ (port-count-lines! p)]
       [v (syntax-e (read-syntax 'ok p))])
  (test 'list syntax-e (car v))
  (test 'a syntax-e (cadr v))
  (test 'b syntax-e (caddr v))
  (test 1 syntax-line (car v))
  (test 1 syntax-column (car v))
  (test 2 syntax-line (cadr v))
  (test 0 syntax-column (cadr v))
  (test 3 syntax-line (caddr v))
  (test 0 syntax-column (caddr v)))
  
;; Simple read:
(let* ([p (make-p `(#"(list "
		    ,a-special
		    #" "
		    ,b-special
		    #"))")
		  special-size
		  (lambda (w l c p)
		    (test #f 'no-place1 w)
		    (test 1 'no-place2 l)
		    (test (and p (sub1 p)) 'no-place3 c)
		    (test #f not (memq p '(7 9)))))]
       [_ (port-count-lines! p)]
       [v (read p)])
  (test 'list car v)
  (test a-special cadr v)
  (test b-special caddr v))

;; Read with newlines
(let* ([p (make-p `(#"(list\n"
		    ,a-special
		    #"\n"
		    ,b-special
		    #"))")
		  special-size
		  (lambda (w l c p)
		    (test l 'no-place4 l)
		    (test #f 'no-place5 w)
		    (test 0 'no-place6 c)
		    (test #f not (memq p '(7 9)))
		    (test #f not (memq l '(2 3)))))]
       [_ (port-count-lines! p)]
       [v (read p)])
  (test 'list car v)
  (test a-special cadr v)
  (test b-special caddr v))

(require (only-in mzlib/port [relocate-input-port relocate-input-port]))
(define (shift-port p count-lines? deltas)
  (let ([p (relocate-input-port p 
				(add1 (car deltas))
				(cadr deltas)
				(add1 (caddr deltas)))])
    (when count-lines?
      (port-count-lines! p))
    p))

;; Read with src loc:
(let* ([p (make-p `(#"(list "
		    ,a-special
		    #" "
		    ,b-special
		    #" end))")
		  special-size
		  (lambda (w l c p)
		    (test 'dk 'dk-place w)
		    (test 8 'no-place7 l)
		    (test p + c 631)
		    (test #f not (memq p '(707 709)))))]
       [_ (port-count-lines! p)]
       [v (read-syntax 'dk (shift-port p #t '(7 70 700)))]
       [l (syntax->list v)]
       [v2 (syntax->datum v)])
  (test 'list car v2)
  (test a-special cadr v2)
  (test b-special caddr v2)
  (test 'end cadddr v2)
  
  (test 702 syntax-position (car l))
  (test 707 syntax-position (cadr l))
  (test 709 syntax-position (caddr l))
  (test 711 syntax-position (cadddr l))

  ;; Read with specials as syntax syntax already:
  (let* ([stx v]
	 [p (make-p `(#"(list "
		      ,stx
		      #" end))")
		    (lambda (x)
		      ;; it's 1 wide
		      1)
		    (lambda (w l c p)
		      (test 'dk 'dk-place w)
		    (test #f 'no-place8 l)
		    (test #f 'no-place9 c)
		    (test 7 'place p)))]
	 [v (read-syntax 'dk p)]
	 [l (syntax->list v)])
    ;; make sure syntax object is intact:
    (test stx cadr l)
    (test 9 syntax-position (caddr l))

    ;; Check that plain read performs a syntax->datum:
    (let* ([p (make-p `(#"(list "
			,stx
			#" end))")
		      (lambda (x) 100)
		    (lambda (w l c p)
		      (test #f 'no-place10 w)
		      (test #f 'no-place11 l)
		      (test #f 'no-place12 c)
		      (test 7 'place p)))]
	   [v (read p)])
      (test `(list (list ,a-special ,b-special end) end) values v))))

;; Check that syntax read with with a list special
;;  syntaxizes the list.
(let* ([p (make-p `(#"(list "
		    ,(list a-special b-special)
		    #" end))")
		  (lambda (x)
		    1)
		  (lambda (w l c p)
		    (test 'dk 'dk-place w)
		    (test #f 'no-place13 l)
		    (test #f 'no-place14 c)
		    (test 7 'place p)))]
       [v (read-syntax 'dk p)]
       [l (syntax->list v)])
  (test #t syntax? (cadr l))
  (test #t list? (syntax-e (cadr l)))
  (test a-special syntax-e (car (syntax-e (cadr l))))
  (test b-special syntax-e (cadr (syntax-e (cadr l))))
  (test 9 syntax-position (caddr l)))

;; Test delimitting and unsupported positions:
(test (list 1 a-special) read (make-p (list #"(1" a-special #")") (lambda (x) 1) void))
(test (list 1) read (make-p (list #"(1" special-comment #")") (lambda (x) 1) void))
(test (list 'a a-special 'b) read (make-p (list #"(a" a-special #"b)") (lambda (x) 1) void))
(test (list #\a a-special) read (make-p (list #"(#\\a" a-special #")") (lambda (x) 1) void))
(test (list #\newline a-special) read (make-p (list #"(#\\newline" a-special #")") (lambda (x) 1) void))
(test (list #\newline) read (make-p (list #"(#\\newline" special-comment #")") (lambda (x) 1) void))
(test a-special read-char-or-special (make-p (list a-special) (lambda (x) 1) void))

;; Type error triggered by symbol 'z --- make sure it's propagated:
(err/rt-test (read (make-p (list #"(a" 'z #")") (lambda (x) 1) void)))
;; Negative number triggers bad special result:
(err/rt-test (read (make-p (list #"(a" -42 #")") (lambda (x) 1) void)))
;; Inexact number triggers bad special-comment result:
(err/rt-test (read (make-p (list #"(a" 42.0 #")") (lambda (x) 1) void)))

(define (run-delim-special a-special)
  (test (list 5) read (make-p (list #"(; \"" a-special #"\n5)") (lambda (x) 1) void))
  (test (list 5) read (make-p (list #"(#| \"" a-special #" |# 5)") (lambda (x) 1) void))
  (test (list 5) read (make-p (list #"(;" a-special #"\n 5)") (lambda (x) 1) void))
  (test 5 read (make-p (list #"#| \"" a-special #" |# 5") (lambda (x) 1) void))
  (test 5 read (make-p (list #";" a-special #"\n 5") (lambda (x) 1) void))
  (err/rt-test (read (make-p (list #"\"a" a-special #"\"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"\"" a-special #"\"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"\"\\" a-special #"\"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"\"\\x" a-special #"\"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"\"\\x1" a-special #"\"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"#\\" a-special #"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"#\\12" a-special #"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"#" a-special #"") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"x\\" a-special #"y") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"|" a-special #"y|") (lambda (x) 1) void)) exn:fail:read:non-char?)
  (err/rt-test (read (make-p (list #"|x" a-special #"y|") (lambda (x) 1) void)) exn:fail:read:non-char?))
(run-delim-special a-special)
(run-delim-special special-comment)

;; Test read-char-or-special:
(let ([p (make-p (list #"x" a-special #"y") (lambda (x) 5) void)])
  (test #\x peek-char-or-special p)
  (test 0 file-position p)
  (test #\x peek-char-or-special p 0)
  (test a-special peek-char-or-special p 1)
  (test #\y peek-char-or-special p 2)
  (test 0 file-position p)
  (test #\x read-char-or-special p)
  (test 1 file-position p)
  (test a-special peek-char-or-special p)
  (test 1 file-position p)
  (test a-special read-char-or-special p)
  (test 2 file-position p)
  (test #\y peek-char-or-special p)
  (test 2 file-position p)
  (test #\y read-char-or-special p)
  (test 3 file-position p))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test read-syntax offsets:

(let ([p (open-input-string " a ")])
  (let ([v (read-syntax 'ok (shift-port p #f (list 70 700 7000)))])
    (test #f syntax-line v)
    (test #f syntax-column v)
    (test 7002 syntax-position v)))

(let ([p (open-input-string " a ")])
  (port-count-lines! p)
  (let ([v (read-syntax 'ok (shift-port p #t (list 70 700 7000)))])
    (test 71 syntax-line v)
    (test 701 syntax-column v)
    (test 7002 syntax-position v)))

(let ([p (open-input-string " \n a ")])
  (port-count-lines! p)
  (let ([v (read-syntax 'ok (shift-port p #t (list 70 700 7000)))])
    (test 72 syntax-line v)
    (test 1 syntax-column v)
    (test 7004 syntax-position v)))

;; Check exception record:
(let ([p (open-input-string " . ")])
  (let ([x (with-handlers ([values values])
	     (read-syntax 'ok (shift-port p #f (list 70 700 7000))))])
    (test 'ok srcloc-source (car (exn:fail:read-srclocs x)))
    (test #f srcloc-line (car (exn:fail:read-srclocs x)))
    (test #f srcloc-column (car (exn:fail:read-srclocs x)))
    (test 7002 srcloc-position (car (exn:fail:read-srclocs x)))))
    
(let ([p (open-input-string " . ")])
  (port-count-lines! p)
  (let ([x (with-handlers ([values values])
	     (read-syntax 'ok (shift-port p #t (list 70 700 7000))))])
    (test 'ok srcloc-source (car (exn:fail:read-srclocs x)))
    (test 71 srcloc-line (car (exn:fail:read-srclocs x)))
    (test 701 srcloc-column (car (exn:fail:read-srclocs x)))
    (test 7002 srcloc-position (car (exn:fail:read-srclocs x)))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ([p (open-output-bytes)])
  (display void p)
  (test "#<procedure:void>" get-output-string p)
  (let ([try-bad
	 (lambda (x)
	   (test (void) (list x)
		 (parameterize ([print-unreadable #f])
		   (display x p)))
	   (err/rt-test (parameterize ([print-unreadable #f])
			  (write x p))))]
	[try-good
	 (lambda (x)
	   (test (void) (list x)
		 (parameterize ([print-unreadable #f])
		   (write x p))))])
    (try-bad void)
    (try-bad (lambda () 10))
    (try-bad (seconds->date (current-seconds)))
    (try-bad (let ()
	   (define-struct s (x))
	   (make-s 10)))
    (try-bad #'apple)
    
    (try-good 'ex)
    (try-good '(1 ex))
    (try-good '(1 . ex))
    (try-good #(1 2))
    (try-good #&(1))
    (try-good 1)
    (try-good 1.0)
    (try-good "apple")
    (try-good #"apple")
    (try-good #rx"ok")
    (try-good #rx#"ok")
    (try-good #f)))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test #reader

(err/rt-test (parameterize ([read-accept-reader #f])
	       (read (open-input-string "#reader mzscheme 10")))
	     exn:fail:read?)
(test 10 'ten (parameterize ([read-accept-reader #t])
	       (read (open-input-string "#reader mzscheme 10"))))

(module reader-test-module mzscheme
  (define (my-read port)
    `(READ ,(read port)))
  (define (my-read-syntax name port)
    `(READ-SYNTAX ,(read-syntax name port)))
  (provide (rename my-read read)
	   (rename my-read-syntax read-syntax)))

(test `(READ 10) 'ten 
      (parameterize ([read-accept-reader #t])
	(read (open-input-string "#reader 'reader-test-module 10"))))
(test `(READ-SYNTAX 10) 'ten 
      (syntax->datum
       (parameterize ([read-accept-reader #t])
	 (read-syntax '??? (open-input-string "#reader 'reader-test-module 10")))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test 'paren-shape property

(test #f syntax-property (read-syntax 'x (open-input-string "(1 2 3)")) 'paren-shape)
(test #\[ syntax-property (read-syntax 'x (open-input-string "[1 2 3]")) 'paren-shape)
(test #\[ syntax-property (read-syntax 'x (open-input-string "[1 . 3]")) 'paren-shape)
(test #\[ syntax-property (read-syntax 'x (open-input-string "[1 . 3 . 2]")) 'paren-shape)
(test #\[ syntax-property (read-syntax 'x (open-input-string "#[1 2]")) 'paren-shape)
(test #\{ syntax-property (read-syntax 'x (open-input-string "{1 2 3}")) 'paren-shape)
(test #\{ syntax-property (read-syntax 'x (open-input-string "#{1 2}")) 'paren-shape)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test read error on a character not in any port

(err/rt-test (read/recursive (open-input-string ";") #\. #f) exn:fail:read?)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some hash-table reading trickyness with readtables

(test #hash((apple . (red round))
            (banana . (yellow long)))
      values
      (parameterize ([current-readtable
                      (make-readtable #f
                                      #\! 'terminating-macro (lambda (ch port . args)
                                                               (read/recursive port)))])
        (read (open-input-string
               "!#hash((apple . (red round)) (banana . (yellow long)))"))))


(test #hash((apple . (red round))
            (banana . (yellow long)))
      values
      (parameterize ([current-readtable
                      (make-readtable #f
                                      #\! 'terminating-macro (lambda (ch port . args)
                                                               (read/recursive port))
                                      #\* 'terminating-macro (lambda args
                                                               (make-special-comment #f)))])
        (read (open-input-string
               "!#hash((apple . (red round)) * (banana . (yellow long)))"))))

(test #t hash?
      (parameterize ([current-readtable
                      (make-readtable #f
                                      #\% 'terminating-macro
                                      (lambda (char port . args)
                                        (let ([v (read/recursive port)])
                                          v)))])
        (let ([ht (read (open-input-string "#0=' % % #hash((a . #0#) (b . \"banana\"))"))])
          (cadr (hash-ref (cadr ht) 'a)))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(parameterize ([current-readtable (make-readtable (current-readtable) #\. #\a #f)])
  (test '|.| read (open-input-string ".")))
(parameterize ([current-readtable (make-readtable (current-readtable) #\. #\a #f)]
               [read-accept-dot #f])
  (test '|.| read (open-input-string ".")))
(parameterize ([read-accept-dot #f]
               [current-readtable (make-readtable (current-readtable) #\w #\. #f)])
  (err/rt-test (read (open-input-string "w")) exn:fail:read?))
(parameterize ([current-readtable (make-readtable (current-readtable) #\w #\. #f)])
  (err/rt-test (read (open-input-string "w")) exn:fail:read?))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ([s "#0=(1 #hasheq((#0# . (1))) 2 . #&(3 #(#0#)))"])
  (test s
        format
        "~s"
        (make-reader-graph (let ([p (make-placeholder #f)]) 
                             (placeholder-set! p (list* 1
                                                        (make-immutable-hasheq (list (list p 1))) 
                                                        2 
                                                        (box (list 3 (vector p))))) 
                             p)))
  (test s format "~s" (read (open-input-string s))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Prefab

(test #t struct? (readstr "#s(v 1)"))
(test #t struct? (readstr "#s((v 1) 1)"))
(test #t struct? (readstr "#s((v 1 #()) 1)"))
(test #t struct? (readstr "#s((v 0 (1 #f) #()) 1)"))
(test #t struct? (readstr "#s((v (1 #f) #()) 1)"))
(test #t struct? (readstr "#s((v #(0)) 1)"))
(test #t struct? (readstr "#0=#s(v #0#)"))
(let ([v1 (readstr "#0=#s(v #0#)")])
  (define-struct v (self) #:prefab)
  (test #t eq? v1 (v-self v1)))
(err/rt-test (readstr "#s((v 2) 1)") exn:fail:read?)
(err/rt-test (readstr "#s((v 0) 1)") exn:fail:read?)
(err/rt-test (readstr "#s((v 0) 1)") exn:fail:read?)
(err/rt-test (readstr "#s((v 1 (1 #f) #()) 1)") exn:fail:read?)
(err/rt-test (readstr "#s((v 0 (2 #f) #()) 1)") exn:fail:read?)
(err/rt-test (readstr "#s((v 0 (2 #f) #(0)) 1)") exn:fail:read?)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(report-errs)

(load-relative "readtable.ss")