(library (tests scribble)
  (export run-tests)

  (import (ikarus))

  (define (run-tests) (test-scribble))

  (define (test-scribble)

    (define failed 0)
    (define passed 0)
    
    (define (test-one str expected)
      (guard (con
               [else
                (printf "======================================\n")
                (display "testing scribble on:\n")
                (display str)
                (newline)
                (printf "reads as\n")
                (pretty-print expected)
                (printf "test failed!\n")
                (print-condition con)
                (set! failed (+ failed 1))
                (printf "FAILED ~s tests, PASSED ~s\n" failed passed)])
        (let ([p (open-string-input-port str)])
          (let ([v (read p)])
            (unless (equal? v expected)
              (error 'test "mismatch" v)))
          (let ([v (read p)])
            (unless (eof-object? v)
              (error 'test "not eof" v))))
        (set! passed (+ passed 1))
        (printf " [~s]" passed)))
    
    (define-syntax tests
      (lambda (x)
        (define (process ls)
          (cond
            [(null? ls) #'(values)]
            [else
             (let ([x (syntax->datum (car ls))])
               (assert (string? x))
               (let f ([ac x] [ls (cdr ls)])
                 (syntax-case ls (reads as)
                   [(y rest ...) (string? (syntax->datum #'y))
                    (f (string-append ac "\n" (syntax->datum #'y))
                       #'(rest ...))]
                   [(reads as foo rest ...)
                    (with-syntax ([ac ac]
                                  [rest (process #'(rest ...))])
                      #'(begin (test-one ac 'foo) rest))])))]))
        (syntax-case x ()
          [(_ ls ...) 
           (process #'(ls ...))])))
    
    (tests
      "@foo{blah blah blah}" 
        reads as 
      (foo "blah blah blah")
    
      "@foo{blah \"blah\" (`blah'?)}"
        reads as 
      (foo "blah \"blah\" (`blah'?)")
    
      "@foo[1 2]{3 4}"
        reads as
      (foo 1 2 "3 4")
    
      "@foo[1 2 3 4]"
        reads as
      (foo 1 2 3 4)
    
      "@foo[:width 2]{blah blah}"
        reads as
      (foo :width 2 "blah blah")
    
      "@foo{blah blah"
      "     yada yada}"
        reads as
      (foo "blah blah" "\n" "yada yada")
    
      "@foo{"
      "  blah blah"
      "  yada yada"
      "}"
        reads as
      (foo "blah blah" "\n" "yada yada")
    
      "@foo{bar @baz{3}"
      "     blah}"
        reads as
      (foo "bar " (baz "3") "\n" "blah")
        
      "@foo{@b{@u[3] @u{4}}"
      "     blah}"
        reads as
      (foo (b (u 3) " " (u "4")) "\n" "blah")
    
      "@C{while (*(p++))"
      "     *p = '\\n';}"
        reads as 
      (C "while (*(p++))" "\n" "  " "*p = '\\n';")
    
      "@{blah blah}"
        reads as
      ("blah blah")
    
      "@{blah @[3]}"
        reads as
      ("blah " (3))
    
      "'@{foo"
      "   bar"
      "   baz}"
        reads as
      '("foo" "\n" "bar" "\n" "baz")
    
      "@foo"
        reads as
      foo
    
      "@{blah @foo blah}"
        reads as
      ("blah " foo " blah")
            
      "@{blah @foo: blah}"
        reads as
      ("blah " foo: " blah")
              
      "@{blah @|foo|: blah}"
        reads as 
      ("blah " foo ": blah")
    
      "@foo{(+ 1 2) -> @(+ 1 2)!}"
        reads as  
      (foo "(+ 1 2) -> " (+ 1 2) "!")
          
      "@foo{A @\"string\" escape}"
        reads as  
      (foo "A string escape")
    
      "@foo{eli@\"@\"barzilay.org}"
        reads as
      (foo "eli@barzilay.org")
        
      "@foo{A @\"{\" begins a block}"
        reads as  
      (foo "A { begins a block")
        
      "@C{while (*(p++)) {"
      "     *p = '\\n';"
      "   }}"
        reads as  
      (C "while (*(p++)) {" "\n" "  "
         "*p = '\\n';" "\n"
         "}")
        
      "@foo|{bar}@{baz}|"
        reads as  
      (foo "bar}@{baz")
        
      "@foo|{bar |@x{X} baz}|"
        reads as  
      (foo "bar " (x "X") " baz")
        
      "@foo|{bar |@x|{@}| baz}|"
        reads as  
      (foo "bar " (x "@") " baz")
      
      "@foo|--{bar}@|{baz}--|"
        reads as  
      (foo "bar}@|{baz")
        
      "@foo|<<{bar}@|{baz}>>|"
        reads as  
      (foo "bar}@|{baz")
      
      ;;; ikarus does not allow \@identifier  
      "(define |@email| \"foo@bar.com\")"
        reads as  
      (define |@email| "foo@bar.com")
        
      "(define |@atchar| #\\@)"
        reads as  
      (define |@atchar| #\@)
      
      "@foo{bar @baz[2 3] {4 5}}"
        reads as  
      (foo "bar " (baz 2 3) " {4 5}")
        
      "@{foo bar"
      "  baz}"
        reads as  
      ("foo bar" "\n" "baz")
        
      "@foo{x @y z}"
        reads as  
      (foo "x " y " z")
        
      "@foo{x @(* y 2) z}"
        reads as  
      (foo "x " (* y 2) " z")
        
      "@{@foo bar}"
        reads as  
      (foo " bar")
        
      "@@foo{bar}{baz}"
        reads as  
      ((foo "bar") "baz")
        
      "@foo[1 (* 2 3)]{bar}"
        reads as  
      (foo 1 (* 2 3) "bar")
        
      "@foo[@bar{...}]{blah}"
        reads as  
      (foo (bar "...") "blah")
        
      "@foo[bar]"
        reads as  
      (foo bar)
        
      "@foo{bar @f[x] baz}"
        reads as  
      (foo "bar " (f x) " baz")
        
      "@foo[]{bar}"
        reads as  
      (foo "bar")
        
      "@foo[]"
        reads as  
      (foo)
        
      "@foo"
        reads as  
      foo
        
      "@foo{}"
        reads as  
      (foo)
        
      "@foo[:style 'big]{bar}"
        reads as  
      (foo :style 'big  "bar")
        
      "@foo{f{o}o}"
        reads as  
      (foo "f{o}o")
        
      "@foo{{{}}{}}"
        reads as  
      (foo "{{}}{}")
        
      "@foo{bar}"
        reads as  
      (foo "bar")
        
      "@foo{ bar }"
        reads as  
      (foo " bar ")
        
      "@foo[1]{ bar }"
        reads as  
      (foo 1 " bar ")
      
      "@foo{a @bar{b} c}"
        reads as  
      (foo "a " (bar "b") " c")
        
      "@foo{a @bar c}"
        reads as  
      (foo "a " bar " c")
        
      "@foo{a @(bar 2) c}"
        reads as  
      (foo "a " (bar 2) " c")
      
      "@foo{A @\"}\" marks the end}"
        reads as  
      (foo "A } marks the end")
        
      "@foo{The prefix: @\"@\".}"
        reads as  
      (foo "The prefix: @.")
        
      "@foo{@\"@x{y}\" --> (x \"y\")}"
        reads as  
      (foo "@x{y} --> (x \"y\")")
        
      "@foo|{...}|"
        reads as  
      (foo "...")
        
      "@foo|{\"}\" follows \"{\"}|"
        reads as  
      (foo "\"}\" follows \"{\"")
        
      "@foo|{Nesting |{is}| ok}|"
        reads as  
      (foo "Nesting |{is}| ok")
      
      "@foo|{Maze"
      "      |@bar{is}"
      "      Life!}|"
        reads as  
      (foo "Maze" "\n"
           (bar "is") "\n"
            "Life!")
    
      "@t|{In |@i|{sub|@\"@\"s}| too}|"
        reads as  
      (t "In " (i "sub@s") " too")
      
      "@foo|<<<{@x{foo} |@{bar}|.}>>>|"
        reads as  
      (foo "@x{foo} |@{bar}|.")
        
      "@foo|!!{X |!!@b{Y}...}!!|"
        reads as  
      (foo "X " (b "Y") "...")
        
      "@foo{foo@bar.}"
        reads as  
      (foo "foo" bar.)
        
      "@foo{foo@|bar|.}"
        reads as  
      (foo "foo" bar ".")
        
      "@foo{foo@3.}"
        reads as  
      (foo "foo" 3.0)
        
      "@foo{foo@| 3 |.}"
        reads as
      (foo "foo" 3 ".")
        
      "@foo{foo@|(f 1)|{bar}}"
        reads as  
      (foo "foo" (f 1) "{bar}")
        
      "@foo{foo@|bar|[1]{baz}}"
        reads as  
      (foo "foo" bar "[1]{baz}")
        
      "@foo{x@\"y\"z}"
        reads as  
      (foo "xyz")
        
      "@foo{x@|\"y\"|z}"
        reads as  
      (foo "x" "y" "z")
        
      "@foo{x@| 1 (+ 2 3) 4 |y}"
        reads as  
      (foo "x" 1 (+ 2 3) 4 "y")
        
      "@foo{x@|*"
      "        *|y}"
        reads as  
      (foo "x" * * "y")
        
      "@foo{Alice@||Bob@|"
      "     |Carol}"
        reads as  
      (foo "Alice" "Bob" "Carol")
      
      "@|{blah}|"
        reads as  
      ("blah")
      
      "@foo{bar}"
        reads as  
      (foo "bar")
        
      "@foo{ bar }"
        reads as  
      (foo " bar ")
        
      "@foo{ bar"
      "     baz }"
        reads as  
      (foo " bar" "\n" "baz ")
        
      "@foo{bar"
      "}"
        reads as  
      (foo "bar")
        
        
      "@foo{"
      "  bar"
      "}"
        reads as  
      (foo "bar")
        
      "@foo{"
      " "
      "  bar"
      " "
      "}"
        reads as  
      (foo "\n" "bar" "\n")
        
      "@foo{"
      "  bar"
      " "
      "  baz"
      "}"
        reads as  
      (foo "bar" "\n" "\n" "baz")
        
      "@foo{"
      "}"
        reads as  
      (foo "\n")
        
      "@foo{"
      " "
      "}"
        reads as  
      (foo "\n" "\n")
        
      "@foo{ bar"
      "     baz }"
        reads as  
      (foo " bar" "\n" "baz ")
      
      "@foo{"
      "  bar"
      "  baz"
      "  blah"
      "}"
        reads as  
      (foo "bar" "\n" "baz" "\n" "blah")
        
      "@foo{"
      "  begin"
      "    x++;"
      "  end}"
        reads as  
      (foo "begin" "\n" "  " "x++;" "\n" "end")
        
      "@foo{"
      "    a"
      "   b"
      "  c}"
        reads as  
      (foo "  " "a" "\n" " " "b" "\n" "c")
        
      "@foo{bar"
      "       baz"
      "     bbb}"
        reads as  
      (foo "bar" "\n" "  " "baz" "\n" "bbb")
        
      "@foo{ bar"
      "        baz"
      "      bbb}"
        reads as  
      (foo " bar" "\n" "   " "baz" "\n" " " "bbb")
        
      "@foo{bar"
      "   baz"
      "   bbb}"
        reads as  
      (foo "bar" "\n" "baz" "\n" "bbb")
        
      "@foo{ bar"
      "   baz"
      "   bbb}"
        reads as  
      (foo " bar" "\n" "baz" "\n" "bbb")
        
      "@foo{ bar"
      "   baz"
      "     bbb}"
        reads as  
      (foo " bar" "\n" "baz" "\n" "  " "bbb")
        
      "@text{Some @b{bold"
      "  text}, and"
      "  more text.}"
        reads as  
      (text "Some " (b "bold" "\n" "text")", and" "\n" "more text.")
      
      "@foo{"
      "  @|| bar @||"
      "  @|| baz}"
        reads as  
      (foo " bar " "\n" " baz")
      
      "@foo{@|xyz|}"
      reads as 
      (foo xyz)
    
      "@foo{@|<xyz>|}"
      reads as 
      (foo <xyz>)
    
      "@foo{@|<<<<|}"
      reads as 
      (foo <<<<)
    
      "@foo{@|<(x)>|}"
      reads as
      (foo < (x) >)
    
      "@foo{@|(<(<<)>) xy|}"
      reads as
      (foo (< (<<) >) xy)
    
    
    )
    (assert (= failed 0))))