ikarus/scheme/tests/scribble.ss

523 lines
11 KiB
Scheme

(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))))