* Reorganize the scribble tests to separate files
* Finally moved the scribble reader tests with the rest so it can run with the nightly build. svn: r15112
This commit is contained in:
Eli Barzilay
parent
4288c6c2c7
commit
dd68b710ae
|
|
@ -1,465 +0,0 @@
|
|||
#!/bin/env mzscheme
|
||||
#lang scheme/base
|
||||
(require mzlib/string (for-syntax scheme/base))
|
||||
|
||||
#reader scribble/reader
|
||||
(define tests
|
||||
`(
|
||||
|
||||
[@foo
|
||||
foo]
|
||||
|
||||
[@foo{}
|
||||
(foo)]
|
||||
|
||||
[@foo[]
|
||||
(foo)]
|
||||
|
||||
[@foo[]{}
|
||||
(foo)]
|
||||
|
||||
[foo@
|
||||
,(string->symbol "foo@")]
|
||||
|
||||
[fo@o
|
||||
,(string->symbol "fo@o")]
|
||||
|
||||
[\@foo
|
||||
,(string->symbol "@foo")]
|
||||
|
||||
[|@foo|
|
||||
,(string->symbol "@foo")]
|
||||
|
||||
[(define |@foo| '\@bar@baz)
|
||||
,(read-from-string "(define @foo '@bar@baz)")]
|
||||
|
||||
[@foo{bar}
|
||||
(foo "bar")]
|
||||
|
||||
[@foo{bar baz
|
||||
blah}
|
||||
(foo "bar baz" "\n" "blah")]
|
||||
|
||||
[@foo{bar @baz[3]
|
||||
blah}
|
||||
(foo "bar " (baz 3) "\n" "blah")]
|
||||
|
||||
[@foo{bar @baz{3}
|
||||
blah}
|
||||
(foo "bar " (baz "3") "\n" "blah")]
|
||||
|
||||
[@foo{bar @baz[2 3]{4 5}
|
||||
blah}
|
||||
(foo "bar " (baz 2 3 "4 5") "\n" "blah")]
|
||||
|
||||
[@foo{bar @baz[2 3] {4 5}}
|
||||
(foo "bar " (baz 2 3) " {4 5}")]
|
||||
|
||||
[,(let* ([formatter (lambda (fmt)
|
||||
(lambda args
|
||||
(format fmt (apply string-append args))))]
|
||||
[bf (formatter "*~a*")]
|
||||
[it (formatter "/~a/")]
|
||||
[ul (formatter "_~a_")]
|
||||
[text string-append])
|
||||
@text{@it{Note}: @bf{This is @ul{not} a pipe}.})
|
||||
"/Note/: *This is _not_ a pipe*."]
|
||||
|
||||
['@foo{bar}
|
||||
'(foo "bar")]
|
||||
|
||||
[@'foo{bar}
|
||||
'(foo "bar")]
|
||||
|
||||
,@'( ; <- avoid the above openning quasiquote for these
|
||||
|
||||
[@'`,foo{bar}
|
||||
'`,(foo "bar")]
|
||||
|
||||
[@'`,@,foo{bar}
|
||||
'`,@,(foo "bar")]
|
||||
|
||||
[@`',@foo{blah}
|
||||
`@',@foo{blah}]
|
||||
|
||||
[@`',@foo{blah}
|
||||
`',@@foo{blah}]
|
||||
|
||||
)
|
||||
|
||||
[@(lambda (x) x){blah}
|
||||
((lambda (x) x) "blah")]
|
||||
|
||||
[@`(unquote foo){blah}
|
||||
`(,foo "blah")]
|
||||
|
||||
[@{foo bar
|
||||
baz}
|
||||
("foo bar" "\n" "baz")]
|
||||
|
||||
[@'{foo bar
|
||||
baz}
|
||||
'("foo bar" "\n" "baz")]
|
||||
|
||||
[(1 2 @; comment
|
||||
3 4)
|
||||
(1 2 3 4)]
|
||||
|
||||
[@foo{bar @; comment
|
||||
baz@;
|
||||
blah}
|
||||
(foo "bar bazblah")]
|
||||
|
||||
[@foo{bar @; comment, with space and newline
|
||||
|
||||
baz}
|
||||
(foo "bar " "\n" "baz")]
|
||||
|
||||
[@foo{x @y z}
|
||||
(foo "x " y " z")]
|
||||
|
||||
[@foo{x @(* y 2) z}
|
||||
(foo "x " (* y 2) " z")]
|
||||
|
||||
[@{@foo bar}
|
||||
(foo " bar")]
|
||||
|
||||
[@@foo{bar}{baz}
|
||||
((foo "bar") "baz")]
|
||||
|
||||
[@foo[1 (* 2 3)]{bar}
|
||||
(foo 1 (* 2 3) "bar")]
|
||||
|
||||
[@foo[@bar{...}]{blah}
|
||||
(foo (bar "...") "blah")]
|
||||
|
||||
[@foo[bar]
|
||||
(foo bar)]
|
||||
|
||||
[@foo{bar @f[x] baz}
|
||||
(foo "bar " (f x) " baz")]
|
||||
|
||||
[@foo[]{bar}
|
||||
(foo "bar")]
|
||||
|
||||
[@foo[]
|
||||
(foo)]
|
||||
|
||||
[@foo
|
||||
foo]
|
||||
|
||||
[@foo{}
|
||||
(foo)]
|
||||
|
||||
[@foo[#:style 'big]{bar}
|
||||
(foo #:style 'big "bar")]
|
||||
|
||||
[@foo{f{o}o}
|
||||
(foo "f{o}o")]
|
||||
|
||||
[@foo{{{}}{}}
|
||||
(foo "{{}}{}")]
|
||||
|
||||
[@foo{bar}
|
||||
(foo "bar")]
|
||||
|
||||
[@foo{ bar }
|
||||
(foo " bar ")]
|
||||
|
||||
[@foo[1]{ bar }
|
||||
(foo 1 " bar ")]
|
||||
|
||||
[@foo{a @bar{b} c}
|
||||
(foo "a " (bar "b") " c")]
|
||||
|
||||
[@foo{a @bar c}
|
||||
(foo "a " bar " c")]
|
||||
|
||||
[@foo{a @(bar 2) c}
|
||||
(foo "a " (bar 2) " c")]
|
||||
|
||||
[@foo{A @"}" marks the end}
|
||||
(foo "A } marks the end")]
|
||||
|
||||
[@foo{The prefix: @"@".}
|
||||
(foo "The prefix: @.")]
|
||||
|
||||
[@foo{@"@x{y}" --> (x "y")}
|
||||
(foo "@x{y} --> (x \"y\")")]
|
||||
|
||||
[@foo|{...}|
|
||||
(foo "...")]
|
||||
|
||||
[@foo|{"}" follows "{"}|
|
||||
(foo "\"}\" follows \"{\"")]
|
||||
|
||||
[@foo|{Nesting |{is}| ok}|
|
||||
(foo "Nesting |{is}| ok")]
|
||||
|
||||
[@foo|{Maze
|
||||
|@bar{is}
|
||||
Life!}|
|
||||
(foo "Maze" "\n" (bar "is") "\n" "Life!")]
|
||||
|
||||
[@t|{In |@i|{sub|@"@"s}| too}|
|
||||
(t "In " (i "sub@s") " too")]
|
||||
|
||||
[@foo|<<<{@x{foo} |@{bar}|.}>>>|
|
||||
(foo "@x{foo} |@{bar}|.")]
|
||||
|
||||
[@foo|!!{X |!!@b{Y}...}!!|
|
||||
(foo "X " (b "Y") "...")]
|
||||
|
||||
[@foo{foo@bar.}
|
||||
(foo "foo" bar.)]
|
||||
|
||||
[@foo{foo@|bar|.}
|
||||
(foo "foo" bar ".")]
|
||||
|
||||
[@foo{foo@3.}
|
||||
(foo "foo" 3.0)]
|
||||
|
||||
[@foo{foo@|3|.}
|
||||
(foo "foo" 3 ".")]
|
||||
|
||||
[@foo{foo@|(f 1)|{bar}}
|
||||
(foo "foo" (f 1) "{bar}")]
|
||||
|
||||
[@foo{foo@|bar|[1]{baz}}
|
||||
(foo "foo" bar "[1]{baz}")]
|
||||
|
||||
[@foo{x@"y"z}
|
||||
(foo "xyz")]
|
||||
|
||||
[@foo{x@|"y"|z}
|
||||
(foo "x" "y" "z")]
|
||||
|
||||
[@foo{x@|1 (+ 2 3) 4|y}
|
||||
(foo "x" 1 (+ 2 3) 4 "y")]
|
||||
|
||||
[@foo{x@|1 (+ 2 3) 4|y}
|
||||
(foo "x" 1 (+ 2 3) 4 "y")]
|
||||
|
||||
[@foo{x@|*
|
||||
*|y}
|
||||
(foo "x" * * "y")]
|
||||
|
||||
[@foo{Alice@||Bob@|
|
||||
|Carol}
|
||||
(foo "Alice" "Bob" "Carol")]
|
||||
|
||||
[@|{blah}|
|
||||
("blah")]
|
||||
|
||||
[@foo{First line@;{there is still a
|
||||
newline here;}
|
||||
Second line}
|
||||
(foo "First line" "\n" "Second line")]
|
||||
|
||||
[@foo{A long @;
|
||||
single-@;
|
||||
string arg.}
|
||||
(foo "A long single-string arg.")]
|
||||
|
||||
[@foo{bar}
|
||||
(foo "bar")]
|
||||
|
||||
[@foo{ bar }
|
||||
(foo " bar ")]
|
||||
|
||||
|
||||
[@foo{ bar
|
||||
baz }
|
||||
(foo " bar" "\n" "baz ")]
|
||||
|
||||
[@foo{bar
|
||||
}
|
||||
(foo "bar")]
|
||||
|
||||
[@foo{
|
||||
bar
|
||||
}
|
||||
(foo "bar")]
|
||||
|
||||
[@foo{
|
||||
|
||||
bar
|
||||
|
||||
}
|
||||
(foo "\n" "bar" "\n")]
|
||||
|
||||
[@foo{
|
||||
bar
|
||||
|
||||
baz
|
||||
}
|
||||
(foo "bar" "\n" "\n" "baz")]
|
||||
|
||||
[@foo{
|
||||
}
|
||||
(foo "\n")]
|
||||
|
||||
[@foo{
|
||||
|
||||
}
|
||||
(foo "\n" "\n")]
|
||||
|
||||
[@foo{
|
||||
|
||||
|
||||
}
|
||||
(foo "\n" "\n" "\n")]
|
||||
|
||||
[,(let ([nl (car @'{
|
||||
})]
|
||||
[o (open-output-string)])
|
||||
(for-each (lambda (x) (display (if (eq? x nl) "\n... " x) o))
|
||||
@`{foo
|
||||
@,@(list "bar" "\n" "baz")
|
||||
blah})
|
||||
(newline o)
|
||||
(get-output-string o))
|
||||
"foo\n... bar\nbaz\n... blah\n"]
|
||||
|
||||
[@foo{
|
||||
bar
|
||||
baz
|
||||
blah
|
||||
}
|
||||
(foo "bar" "\n" "baz" "\n" "blah")]
|
||||
|
||||
[@foo{
|
||||
begin
|
||||
x++;
|
||||
end}
|
||||
(foo "begin" "\n" " " "x++;" "\n" "end")]
|
||||
|
||||
[@foo{
|
||||
a
|
||||
b
|
||||
c}
|
||||
(foo " " "a" "\n" " " "b" "\n" "c")]
|
||||
|
||||
[@foo{bar
|
||||
baz
|
||||
bbb}
|
||||
(foo "bar" "\n" " " "baz" "\n" "bbb")]
|
||||
|
||||
[@foo{ bar
|
||||
baz
|
||||
bbb}
|
||||
(foo " bar" "\n" " " "baz" "\n" " " "bbb")]
|
||||
|
||||
[@foo{bar
|
||||
baz
|
||||
bbb}
|
||||
(foo "bar" "\n" "baz" "\n" "bbb")]
|
||||
|
||||
[@foo{ bar
|
||||
baz
|
||||
bbb}
|
||||
(foo " bar" "\n" "baz" "\n" "bbb")]
|
||||
|
||||
[@foo{ bar
|
||||
baz
|
||||
bbb}
|
||||
(foo " bar" "\n" "baz" "\n" " " "bbb")]
|
||||
|
||||
[@text{Some @b{bold
|
||||
text}, and
|
||||
more text.}
|
||||
(text "Some " (b "bold" "\n" "text") ", and" "\n" "more text.")]
|
||||
|
||||
[@code{
|
||||
begin
|
||||
i = 1, r = 1
|
||||
@bold{while i < n do
|
||||
r *= i++
|
||||
done}
|
||||
end
|
||||
}
|
||||
(code "begin" "\n"
|
||||
" " "i = 1, r = 1" "\n"
|
||||
" " (bold "while i < n do" "\n"
|
||||
" " "r *= i++" "\n"
|
||||
"done") "\n"
|
||||
"end")]
|
||||
|
||||
[@foo{
|
||||
@|| bar @||
|
||||
@|| baz}
|
||||
(foo " bar " "\n" " baz")]
|
||||
|
||||
[@foo{bar
|
||||
@|baz| bbb
|
||||
@|x1 x2| x3 x4
|
||||
@|| waaaah
|
||||
}
|
||||
(foo "bar" "\n" baz " bbb" "\n" x1 x2 " x3 x4" "\n" " waaaah")]
|
||||
|
||||
[@foo{x1
|
||||
x2@;
|
||||
y2
|
||||
x3@;{
|
||||
;}y3
|
||||
x4@|
|
||||
|y4
|
||||
x5}
|
||||
(foo "x1" "\n" "x2y2" "\n" "x3y3" "\n" "x4" "y4" "\n" "x5")]
|
||||
|
||||
[,(let-syntax ([foo
|
||||
(lambda (stx)
|
||||
(let ([p (syntax-property stx 'scribble)])
|
||||
(syntax-case stx ()
|
||||
[(_ x ...)
|
||||
(and (pair? p) (eq? (car p) 'form) (even? (cadr p)))
|
||||
(let loop ([n (/ (cadr p) 2)]
|
||||
[as '()]
|
||||
[xs (syntax->list #'(x ...))])
|
||||
(if (zero? n)
|
||||
#`(list 'foo `#,(reverse as) #,@xs)
|
||||
(loop (sub1 n)
|
||||
(cons #`(#,(car xs) ,#,(cadr xs)) as)
|
||||
(cddr xs))))])))])
|
||||
@foo[x 1 y (* 2 3)]{blah})
|
||||
(foo ((x 1) (y 6)) "blah")]
|
||||
|
||||
[,(let-syntax ([verb
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ cmd item ...)
|
||||
#`(cmd
|
||||
#,@(let loop ([items (syntax->list #'(item ...))])
|
||||
(if (null? items)
|
||||
'()
|
||||
(let* ([fst (car items)]
|
||||
[prop (syntax-property fst 'scribble)]
|
||||
[rst (loop (cdr items))])
|
||||
(cond [(eq? prop 'indentation) rst]
|
||||
[(not (and (pair? prop)
|
||||
(eq? (car prop)
|
||||
'newline)))
|
||||
(cons fst rst)]
|
||||
[else (cons (datum->syntax
|
||||
fst (cadr prop) fst)
|
||||
rst)])))))]))])
|
||||
@verb[string-append]{
|
||||
foo
|
||||
bar
|
||||
})
|
||||
"foo\n bar"]
|
||||
|
||||
))
|
||||
|
||||
(define failures 0)
|
||||
|
||||
(define (test val expect)
|
||||
(unless (equal? val expect)
|
||||
(set! failures (add1 failures))
|
||||
(printf "Failure, got: ~s\n expected: ~s\n" val expect)))
|
||||
|
||||
(for-each (lambda (t) (apply test t)) tests)
|
||||
|
||||
(if (zero? failures)
|
||||
(printf "All tests passed\n")
|
||||
(begin (printf "~s failures\n" failures) (exit 1)))
|
||||
82
collects/tests/scribble/collect.ss
Normal file
82
collects/tests/scribble/collect.ss
Normal file
|
|
@ -0,0 +1,82 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require tests/eli-tester scribble/text/syntax-utils)
|
||||
|
||||
(provide begin/collect-tests)
|
||||
|
||||
(define (begin/collect-tests)
|
||||
(test
|
||||
|
||||
;; begin/collect scope etc
|
||||
(begin/collect 1) => 1
|
||||
(begin/collect 1 2 3) => '(1 2 3)
|
||||
(begin/collect) => '()
|
||||
(begin/collect (define x 1) x) => 1
|
||||
(begin/collect (define x 1)) => '()
|
||||
(begin/collect (define x 1) x x x) => '(1 1 1)
|
||||
(begin/collect (define x 1) (define y 2) x y x y) => '(1 2 1 2)
|
||||
(begin/collect (define x 1) x (define y 2) y) => '(1 2)
|
||||
(begin/collect (define x 1) x (define y 2)) => '(1)
|
||||
(begin/collect (define x 1) x x (define y 2) y y) => '(1 1 2 2)
|
||||
(begin/collect (define x 1) x (define x 2) x) => '(1 2)
|
||||
(begin/collect (define x 1) x x (define x 2) x x) => '(1 1 2 2)
|
||||
(begin/collect (define (x) y) (define y 1) (x) (x) (x)) => '(1 1 1)
|
||||
(begin/collect (define x 1) x (define y 2) x) => '(1 1)
|
||||
(begin/collect (define x 1) x x (define y 2) x x) => '(1 1 1 1)
|
||||
(begin/collect (define x 1) x x (define y x) y y) => '(1 1 1 1)
|
||||
(begin/collect (define (x) y) (define y 1) (x) (x)
|
||||
(define (x) y) (define y 2) (x) (x))
|
||||
=> '(1 1 2 2)
|
||||
(begin/collect (define-syntax-rule (DEF x y) (define x y)) (DEF x 1) x x)
|
||||
=> '(1 1)
|
||||
(begin/collect (define-syntax-rule (DEF x y) (define x y)) 1 (DEF x 2) x)
|
||||
=> '(1 2)
|
||||
(begin/collect (define-syntax-rule (DEF x y) (define x y))
|
||||
(DEF x 1) x x
|
||||
(DEF x 2) x x)
|
||||
=> '(1 1 2 2)
|
||||
(begin/collect (define (x) y)
|
||||
(define-syntax-rule (DEF x y) (define x y))
|
||||
(DEF y 1) (x) (x)
|
||||
(DEF y 2) (x) (x))
|
||||
=> '(1 1 1 1)
|
||||
(let ([y 1]) (begin/collect y y (define x y) x y x)) => '(1 1 1 1 1)
|
||||
(let ([y 1]) (begin/collect y y (define y 2) y y)) => '(1 1 2 2)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x))) => '(1 1)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (define y 2) (x) (x))) => '(2 2)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y))
|
||||
=> '(1 1 2 2)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y (x)))
|
||||
=> '(1 1 2 2 1)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) (x) y y))
|
||||
=> '(1 1 1 2 2)
|
||||
(begin/collect (begin (define (x) y)
|
||||
(define-syntax-rule (DEF x y) (define x y))
|
||||
(define y 2))
|
||||
(x) (x))
|
||||
=> '(2 2)
|
||||
(begin/collect (define (x) y)
|
||||
(begin (define-syntax-rule (DEF x y) (define x y))
|
||||
(define y 2))
|
||||
(x) (x))
|
||||
=> '(2 2)
|
||||
(begin/collect (define (x) y)
|
||||
(define-syntax-rule (DEF x y) (define x y))
|
||||
(begin (define y 2))
|
||||
(x) (x))
|
||||
=> '(2 2)
|
||||
(begin/collect (begin (begin (begin (define (x) y))
|
||||
(begin (define-syntax-rule (DEF x y)
|
||||
(define x y))))
|
||||
(begin (begin (define y 2))
|
||||
(begin (x)))
|
||||
(begin (x))))
|
||||
=> '(2 2)
|
||||
(begin/collect 1
|
||||
(define (f x #:< [< "<"] #:> [> ">"]) (list < x >))
|
||||
(f 1)
|
||||
(f #:< "[" 2)
|
||||
(f 3 #:> "]" #:< "["))
|
||||
=> '(1 ("<" 1 ">") ("[" 2 ">") ("[" 3 "]"))
|
||||
|
||||
))
|
||||
|
|
@ -1,149 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require tests/eli-tester scribble/text/syntax-utils
|
||||
scheme/runtime-path scheme/port scheme/sandbox
|
||||
(prefix-in doc: (lib "scribblings/scribble/preprocessor.scrbl")))
|
||||
(require tests/eli-tester "reader.ss" "preprocessor.ss" "collect.ss")
|
||||
|
||||
(define-runtime-path text-dir "text")
|
||||
(define-runtime-path this-dir ".")
|
||||
|
||||
(define (tests)
|
||||
(begin/collect-tests)
|
||||
(preprocessor-tests))
|
||||
|
||||
(define (begin/collect-tests)
|
||||
(test
|
||||
|
||||
;; begin/collect scope etc
|
||||
(begin/collect 1) => 1
|
||||
(begin/collect 1 2 3) => '(1 2 3)
|
||||
(begin/collect) => '()
|
||||
(begin/collect (define x 1) x) => 1
|
||||
(begin/collect (define x 1)) => '()
|
||||
(begin/collect (define x 1) x x x) => '(1 1 1)
|
||||
(begin/collect (define x 1) (define y 2) x y x y) => '(1 2 1 2)
|
||||
(begin/collect (define x 1) x (define y 2) y) => '(1 2)
|
||||
(begin/collect (define x 1) x (define y 2)) => '(1)
|
||||
(begin/collect (define x 1) x x (define y 2) y y) => '(1 1 2 2)
|
||||
(begin/collect (define x 1) x (define x 2) x) => '(1 2)
|
||||
(begin/collect (define x 1) x x (define x 2) x x) => '(1 1 2 2)
|
||||
(begin/collect (define (x) y) (define y 1) (x) (x) (x)) => '(1 1 1)
|
||||
(begin/collect (define x 1) x (define y 2) x) => '(1 1)
|
||||
(begin/collect (define x 1) x x (define y 2) x x) => '(1 1 1 1)
|
||||
(begin/collect (define x 1) x x (define y x) y y) => '(1 1 1 1)
|
||||
(begin/collect (define (x) y) (define y 1) (x) (x)
|
||||
(define (x) y) (define y 2) (x) (x))
|
||||
=> '(1 1 2 2)
|
||||
(begin/collect (define-syntax-rule (DEF x y) (define x y)) (DEF x 1) x x)
|
||||
=> '(1 1)
|
||||
(begin/collect (define-syntax-rule (DEF x y) (define x y)) 1 (DEF x 2) x)
|
||||
=> '(1 2)
|
||||
(begin/collect (define-syntax-rule (DEF x y) (define x y))
|
||||
(DEF x 1) x x
|
||||
(DEF x 2) x x)
|
||||
=> '(1 1 2 2)
|
||||
(begin/collect (define (x) y)
|
||||
(define-syntax-rule (DEF x y) (define x y))
|
||||
(DEF y 1) (x) (x)
|
||||
(DEF y 2) (x) (x))
|
||||
=> '(1 1 1 1)
|
||||
(let ([y 1]) (begin/collect y y (define x y) x y x)) => '(1 1 1 1 1)
|
||||
(let ([y 1]) (begin/collect y y (define y 2) y y)) => '(1 1 2 2)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x))) => '(1 1)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (define y 2) (x) (x))) => '(2 2)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y))
|
||||
=> '(1 1 2 2)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) y y (x)))
|
||||
=> '(1 1 2 2 1)
|
||||
(let ([y 1]) (begin/collect (define (x) y) (x) (x) (define y 2) (x) y y))
|
||||
=> '(1 1 1 2 2)
|
||||
(begin/collect (begin (define (x) y)
|
||||
(define-syntax-rule (DEF x y) (define x y))
|
||||
(define y 2))
|
||||
(x) (x))
|
||||
=> '(2 2)
|
||||
(begin/collect (define (x) y)
|
||||
(begin (define-syntax-rule (DEF x y) (define x y))
|
||||
(define y 2))
|
||||
(x) (x))
|
||||
=> '(2 2)
|
||||
(begin/collect (define (x) y)
|
||||
(define-syntax-rule (DEF x y) (define x y))
|
||||
(begin (define y 2))
|
||||
(x) (x))
|
||||
=> '(2 2)
|
||||
(begin/collect (begin (begin (begin (define (x) y))
|
||||
(begin (define-syntax-rule (DEF x y)
|
||||
(define x y))))
|
||||
(begin (begin (define y 2))
|
||||
(begin (x)))
|
||||
(begin (x))))
|
||||
=> '(2 2)
|
||||
(begin/collect 1
|
||||
(define (f x #:< [< "<"] #:> [> ">"]) (list < x >))
|
||||
(f 1)
|
||||
(f #:< "[" 2)
|
||||
(f 3 #:> "]" #:< "["))
|
||||
=> '(1 ("<" 1 ">") ("[" 2 ">") ("[" 3 "]"))
|
||||
|
||||
))
|
||||
|
||||
(define (preprocessor-tests)
|
||||
;; (sample-file-tests)
|
||||
(in-documentation-tests))
|
||||
|
||||
(define (sample-file-tests)
|
||||
(parameterize ([current-directory text-dir])
|
||||
(for ([ifile (map path->string (directory-list))]
|
||||
#:when (and (file-exists? ifile)
|
||||
(regexp-match? #rx"^i[0-9]+\\.ss$" ifile)))
|
||||
(define ofile (regexp-replace #rx"^i([0-9]+)\\..*$" ifile "o\\1.txt"))
|
||||
(define expected (call-with-input-file ofile
|
||||
(lambda (i) (read-bytes (file-size ofile) i))))
|
||||
(define o (open-output-bytes))
|
||||
(parameterize ([current-output-port o])
|
||||
(dynamic-require (path->complete-path ifile) #f))
|
||||
(test (get-output-bytes o) => expected))))
|
||||
|
||||
(define (in-documentation-tests)
|
||||
(define (text-test line in-text out-text more)
|
||||
(define-values (i o) (make-pipe 512))
|
||||
(define-values (expected len-to-read)
|
||||
(let ([m (regexp-match-positions #rx"\n\\.\\.\\.$" out-text)])
|
||||
(if m
|
||||
(values (substring out-text 0 (caar m)) (caar m))
|
||||
(values out-text #f))))
|
||||
;; test with name indicating the source
|
||||
(define-syntax-rule (t . stuff)
|
||||
(test ;#:failure-message
|
||||
;(format "preprocessor test failure at line ~s" line)
|
||||
. stuff))
|
||||
(parameterize ([current-directory this-dir]
|
||||
[sandbox-output o]
|
||||
[sandbox-error-output current-output-port])
|
||||
(define exn #f)
|
||||
(define thd #f)
|
||||
(define (run)
|
||||
;; only need to evaluate the module, so we have its output; but do that
|
||||
;; in a thread, since we might want to look at just a prefix of an
|
||||
;; infinite output
|
||||
(with-handlers ([void (lambda (e) (set! exn e))])
|
||||
(make-module-evaluator in-text)
|
||||
(close-output-port o)))
|
||||
(for ([m more])
|
||||
(call-with-output-file (car m) #:exists 'truncate
|
||||
(lambda (o) (display (cdr m) o))))
|
||||
(set! thd (thread run))
|
||||
(t (with-limits 2 #f
|
||||
(if len-to-read (read-string len-to-read i) (port->string i)))
|
||||
=> expected)
|
||||
(t (begin (kill-thread thd) (cond [exn => raise] [else #t])))
|
||||
(for ([m more])
|
||||
(when (file-exists? (car m)) (delete-file (car m))))))
|
||||
(call-with-trusted-sandbox-configuration
|
||||
(lambda ()
|
||||
(for ([t (in-list (doc:tests))])
|
||||
(begin (apply text-test t))))))
|
||||
|
||||
;; run all
|
||||
(test do (tests))
|
||||
(test do (reader-tests)
|
||||
do (begin/collect-tests)
|
||||
do (preprocessor-tests))
|
||||
|
|
|
|||
66
collects/tests/scribble/preprocessor.ss
Normal file
66
collects/tests/scribble/preprocessor.ss
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require tests/eli-tester scheme/runtime-path scheme/port scheme/sandbox
|
||||
(prefix-in doc: (lib "scribblings/scribble/preprocessor.scrbl")))
|
||||
|
||||
(provide preprocessor-tests)
|
||||
|
||||
(define (preprocessor-tests)
|
||||
;; (sample-file-tests)
|
||||
(in-documentation-tests))
|
||||
|
||||
;; unused now
|
||||
(define-runtime-path text-dir "text")
|
||||
(define (sample-file-tests)
|
||||
(parameterize ([current-directory text-dir])
|
||||
(for ([ifile (map path->string (directory-list))]
|
||||
#:when (and (file-exists? ifile)
|
||||
(regexp-match? #rx"^i[0-9]+\\.ss$" ifile)))
|
||||
(define ofile (regexp-replace #rx"^i([0-9]+)\\..*$" ifile "o\\1.txt"))
|
||||
(define expected (call-with-input-file ofile
|
||||
(lambda (i) (read-bytes (file-size ofile) i))))
|
||||
(define o (open-output-bytes))
|
||||
(parameterize ([current-output-port o])
|
||||
(dynamic-require (path->complete-path ifile) #f))
|
||||
(test (get-output-bytes o) => expected))))
|
||||
|
||||
(define-runtime-path this-dir ".")
|
||||
(define (in-documentation-tests)
|
||||
(define (text-test line in-text out-text more)
|
||||
(define-values (i o) (make-pipe 512))
|
||||
(define-values (expected len-to-read)
|
||||
(let ([m (regexp-match-positions #rx"\n\\.\\.\\.$" out-text)])
|
||||
(if m
|
||||
(values (substring out-text 0 (caar m)) (caar m))
|
||||
(values out-text #f))))
|
||||
;; test with name indicating the source
|
||||
(define-syntax-rule (t . stuff)
|
||||
(test ;; #:failure-message
|
||||
;; (format "preprocessor test failure at line ~s" line)
|
||||
. stuff))
|
||||
(parameterize ([current-directory this-dir]
|
||||
[sandbox-output o]
|
||||
[sandbox-error-output current-output-port])
|
||||
(define exn #f)
|
||||
(define thd #f)
|
||||
(define (run)
|
||||
;; only need to evaluate the module, so we have its output; but do that
|
||||
;; in a thread, since we might want to look at just a prefix of an
|
||||
;; infinite output
|
||||
(with-handlers ([void (lambda (e) (set! exn e))])
|
||||
(make-module-evaluator in-text)
|
||||
(close-output-port o)))
|
||||
(for ([m more])
|
||||
(call-with-output-file (car m) #:exists 'truncate
|
||||
(lambda (o) (display (cdr m) o))))
|
||||
(set! thd (thread run))
|
||||
(t (with-limits 2 #f
|
||||
(if len-to-read (read-string len-to-read i) (port->string i)))
|
||||
=> expected)
|
||||
(t (begin (kill-thread thd) (cond [exn => raise] [else #t])))
|
||||
(for ([m more])
|
||||
(when (file-exists? (car m)) (delete-file (car m))))))
|
||||
(call-with-trusted-sandbox-configuration
|
||||
(lambda ()
|
||||
(for ([t (in-list (doc:tests))])
|
||||
(begin (apply text-test t))))))
|
||||
723
collects/tests/scribble/reader.ss
Normal file
723
collects/tests/scribble/reader.ss
Normal file
|
|
@ -0,0 +1,723 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require tests/eli-tester (prefix-in scr: scribble/reader)
|
||||
(for-syntax scheme/base))
|
||||
|
||||
(provide reader-tests)
|
||||
|
||||
(define the-tests #<<END-OF-TESTS
|
||||
|
||||
;; format:
|
||||
;; * a line with only `-'s marks the boundary between tests
|
||||
;; * -<token>-> marks a <token> kind of reader test
|
||||
;; * lines with semicolon comments flushed at the left column ignored,
|
||||
|
||||
---
|
||||
;; -------------------- simple uses, test identifiers
|
||||
---
|
||||
@foo -@-> foo
|
||||
---
|
||||
@foo{} -@-> (foo)
|
||||
---
|
||||
@foo[] -@-> (foo)
|
||||
---
|
||||
@foo[]{} -@-> (foo)
|
||||
---
|
||||
foo@ -@-> foo@
|
||||
---
|
||||
fo@o -@-> fo@o
|
||||
---
|
||||
\@foo -@-> @foo
|
||||
---
|
||||
|@foo| -@-> @foo
|
||||
---
|
||||
@foo@bar -@-> foo bar
|
||||
---
|
||||
@foo@bar. -@-> foo bar.
|
||||
---
|
||||
@foo@bar: -@-> foo bar:
|
||||
---
|
||||
@foo@bar; -@-> foo bar
|
||||
---
|
||||
@foo[]@bar{} -@-> (foo) (bar)
|
||||
---
|
||||
@foo{foo@|bar|.}
|
||||
-@->
|
||||
(foo "foo" bar ".")
|
||||
---
|
||||
@foo{foo@bar;}
|
||||
-@->
|
||||
(foo "foo" bar ";")
|
||||
---
|
||||
(define |@foo| '\@bar@baz) -@-> (define @foo '@bar@baz)
|
||||
---
|
||||
@foo{foo@2.}
|
||||
-@->
|
||||
(foo "foo" 2.0)
|
||||
---
|
||||
;; -------------------- simple args and texts
|
||||
---
|
||||
@foo{bar} -@-> (foo "bar")
|
||||
---
|
||||
@foo[]{bar} -@-> (foo "bar")
|
||||
---
|
||||
@foo[bar] -@-> (foo bar)
|
||||
---
|
||||
@foo[bar]{} -@-> (foo bar)
|
||||
---
|
||||
@foo[bar][baz] -@-> (foo bar) (baz)
|
||||
---
|
||||
@foo[bar]{baz} -@-> (foo bar "baz")
|
||||
---
|
||||
@foo[bar]{baz}[blah] -@-> (foo bar "baz") (blah)
|
||||
---
|
||||
@foo[bar]{baz}@foo[blah] -@-> (foo bar "baz") (foo blah)
|
||||
---
|
||||
@foo[#:x y]{bar} -@-> (foo #:x y "bar")
|
||||
---
|
||||
@foo[1 (* 2 3)]{bar} -@-> (foo 1 (* 2 3) "bar")
|
||||
---
|
||||
@foo[@bar{...}]{blah}
|
||||
-@->
|
||||
(foo (bar "...") "blah")
|
||||
---
|
||||
;; -------------------- no exprs or text
|
||||
---
|
||||
@{} -@-> ()
|
||||
---
|
||||
@[] -@-> ()
|
||||
---
|
||||
@{foo} -@-> ("foo")
|
||||
---
|
||||
@[foo] -@-> (foo)
|
||||
---
|
||||
@|{blah}| -@-> ("blah")
|
||||
---
|
||||
;; -------------------- newlines and spaces in text
|
||||
---
|
||||
@foo{bar baz} -@-> (foo "bar baz")
|
||||
---
|
||||
@foo{bar baz} -@-> (foo "bar baz")
|
||||
---
|
||||
@foo{ bar } -@-> (foo " bar ")
|
||||
---
|
||||
@foo{ bar } -@-> (foo " bar ")
|
||||
---
|
||||
@foo{ } -@-> (foo " ")
|
||||
---
|
||||
@foo{ } -@-> (foo " ")
|
||||
---
|
||||
@foo[1]{bar baz} -@-> (foo 1 "bar baz")
|
||||
---
|
||||
@foo[1]{bar baz} -@-> (foo 1 "bar baz")
|
||||
---
|
||||
@foo[1]{ bar } -@-> (foo 1 " bar ")
|
||||
---
|
||||
@foo[1]{ bar } -@-> (foo 1 " bar ")
|
||||
---
|
||||
@foo[1]{ } -@-> (foo 1 " ")
|
||||
---
|
||||
@foo[1]{ } -@-> (foo 1 " ")
|
||||
---
|
||||
@foo{bar baz
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar baz" "\n" "blah")
|
||||
---
|
||||
@foo[1]{bar baz
|
||||
blah}
|
||||
-@->
|
||||
(foo 1 "bar baz" "\n" "blah")
|
||||
---
|
||||
@foo{bar baz
|
||||
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar baz" "\n" "\n" "blah")
|
||||
---
|
||||
@foo{bar baz
|
||||
|
||||
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar baz" "\n" "\n" "\n" "blah")
|
||||
---
|
||||
@foo{bar
|
||||
}
|
||||
-@->
|
||||
(foo "bar")
|
||||
---
|
||||
@foo{
|
||||
bar}
|
||||
-@->
|
||||
(foo "bar")
|
||||
---
|
||||
@foo{
|
||||
bar
|
||||
}
|
||||
-@->
|
||||
(foo "bar")
|
||||
---
|
||||
@foo{
|
||||
|
||||
bar
|
||||
}
|
||||
-@->
|
||||
(foo "\n" "bar")
|
||||
---
|
||||
@foo{
|
||||
bar
|
||||
|
||||
}
|
||||
-@->
|
||||
(foo "bar" "\n")
|
||||
---
|
||||
@foo{
|
||||
|
||||
bar
|
||||
|
||||
}
|
||||
-@->
|
||||
(foo "\n" "bar" "\n")
|
||||
---
|
||||
@foo{
|
||||
}
|
||||
-@->
|
||||
(foo "\n")
|
||||
---
|
||||
@foo{
|
||||
|
||||
}
|
||||
-@->
|
||||
(foo "\n" "\n")
|
||||
---
|
||||
@foo{
|
||||
|
||||
|
||||
}
|
||||
-@->
|
||||
(foo "\n" "\n" "\n")
|
||||
---
|
||||
;; -------------------- nested forms
|
||||
---
|
||||
@foo{@bar} -@-> (foo bar)
|
||||
---
|
||||
@foo{@bar{}} -@-> (foo (bar))
|
||||
---
|
||||
@foo{111@bar{222}333} -@-> (foo "111" (bar "222") "333")
|
||||
---
|
||||
@foo{111@bar[222]333} -@-> (foo "111" (bar 222) "333")
|
||||
---
|
||||
@foo[111 @bar{222} 333] -@-> (foo 111 (bar "222") 333)
|
||||
---
|
||||
@foo[111 @bar{222}333] -@-> (foo 111 (bar "222") 333)
|
||||
---
|
||||
@foo[111 @bar[222]333] -@-> (foo 111 (bar 222) 333)
|
||||
---
|
||||
@foo[111 @bar 222] -@-> (foo 111 bar 222)
|
||||
---
|
||||
@foo{111 @bar 222} -@-> (foo "111 " bar " 222")
|
||||
---
|
||||
@foo{@bar 111} -@-> (foo bar " 111")
|
||||
---
|
||||
@foo{111 @bar} -@-> (foo "111 " bar)
|
||||
---
|
||||
@foo{ @bar } -@-> (foo " " bar " ")
|
||||
---
|
||||
@foo{bar @baz[3]
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar " (baz 3) "\n" "blah")
|
||||
---
|
||||
@foo{bar @baz{3}
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar " (baz "3") "\n" "blah")
|
||||
---
|
||||
@foo{bar @baz[2 3]{4 5}
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar " (baz 2 3 "4 5") "\n" "blah")
|
||||
---
|
||||
@foo{bar @baz[2 3] {4 5}}
|
||||
-@->
|
||||
(foo "bar " (baz 2 3) " {4 5}")
|
||||
---
|
||||
;; -------------------- cannot have spaces before args or text
|
||||
---
|
||||
@foo [bar] -@-> foo (bar)
|
||||
---
|
||||
@foo {bar} -@-> foo (bar)
|
||||
---
|
||||
@foo[bar] {baz} -@-> (foo bar) (baz)
|
||||
---
|
||||
@foo{bar @baz {bleh}} -@-> (foo "bar " baz " {bleh}")
|
||||
---
|
||||
;; -------------------- expression escapes, operators, currying
|
||||
---
|
||||
@foo{1 @(+ 2 3) 4} -@-> (foo "1 " (+ 2 3) " 4")
|
||||
---
|
||||
@(lambda (x) x){blah} -@-> ((lambda (x) x) "blah")
|
||||
---
|
||||
@(lambda (x) x)[blah] -@-> ((lambda (x) x) blah)
|
||||
---
|
||||
@foo{bar}{baz} -@-> (foo "bar") (baz)
|
||||
---
|
||||
@@foo{bar}{baz} -@-> ((foo "bar") "baz")
|
||||
---
|
||||
@@foo{bar} {baz} -@-> (foo "bar") (baz)
|
||||
---
|
||||
@@foo{bar}{baz}{} -@-> ((foo "bar") "baz") ()
|
||||
---
|
||||
@@@foo{bar}{baz}{} -@-> (((foo "bar") "baz"))
|
||||
---
|
||||
@@@foo[]{}[][] -@-> (((foo)))
|
||||
---
|
||||
@@@foo[]{}[][][] -@-> (((foo))) ()
|
||||
---
|
||||
@foo{foo@|3|.}
|
||||
-@->
|
||||
(foo "foo" 3 ".")
|
||||
---
|
||||
@foo{foo@|(f 1)|{bar}}
|
||||
-@->
|
||||
(foo "foo" (f 1) "{bar}")
|
||||
---
|
||||
@foo{foo@|bar|[1]{baz}}
|
||||
-@->
|
||||
(foo "foo" bar "[1]{baz}")
|
||||
---
|
||||
;; -------------------- pulling punctuations outside
|
||||
---
|
||||
@'foo -@-> 'foo
|
||||
---
|
||||
@'foo[1 2] -@-> '(foo 1 2)
|
||||
---
|
||||
@'foo{bar} -@-> '(foo "bar")
|
||||
---
|
||||
@`foo{bar} -@-> `(foo "bar")
|
||||
---
|
||||
@,foo{bar} -@-> ,(foo "bar")
|
||||
---
|
||||
@,@foo{bar} -@-> ,@(foo "bar")
|
||||
---
|
||||
@`',foo{bar} -@-> `',(foo "bar")
|
||||
---
|
||||
@`',`',foo{bar} -@-> `',`',(foo "bar")
|
||||
---
|
||||
@``'',,foo{bar} -@-> ``'',,(foo "bar")
|
||||
---
|
||||
@`',@foo{bar} -@-> `',@(foo "bar")
|
||||
---
|
||||
@`',@`',@foo{bar} -@-> `',@`',@(foo "bar")
|
||||
---
|
||||
@``'',@,@foo{bar} -@-> ``'',@,@(foo "bar")
|
||||
---
|
||||
@``'',,,@,@foo{bar} -@-> ``'',,,@,@(foo "bar")
|
||||
---
|
||||
@#'foo{bar} -@-> #'(foo "bar")
|
||||
---
|
||||
@#`foo{bar} -@-> #`(foo "bar")
|
||||
---
|
||||
@#,foo{bar} -@-> #,(foo "bar")
|
||||
---
|
||||
@#''foo{bar} -@-> #''(foo "bar")
|
||||
---
|
||||
@#`'#,foo{bar} -@-> #`'#,(foo "bar")
|
||||
---
|
||||
@`foo{123 @,bar{456} 789}
|
||||
-@->
|
||||
`(foo "123 " ,(bar "456") " 789")
|
||||
---
|
||||
@`(unquote foo){blah}
|
||||
-@->
|
||||
`(,foo "blah")
|
||||
---
|
||||
;; -------------------- balanced braces are allowed
|
||||
---
|
||||
@foo{f{o}o} -@-> (foo "f{o}o")
|
||||
---
|
||||
@foo{{{}}{}} -@-> (foo "{{}}{}")
|
||||
---
|
||||
@foo{f[o]o} -@-> (foo "f[o]o")
|
||||
---
|
||||
@foo{[{}]{}} -@-> (foo "[{}]{}")
|
||||
---
|
||||
;; -------------------- string escapes
|
||||
---
|
||||
@foo{x@"y"z} -@-> (foo "xyz")
|
||||
---
|
||||
@foo{A @"}" marks the end}
|
||||
-@->
|
||||
(foo "A } marks the end")
|
||||
---
|
||||
@foo{The prefix is: @"@".}
|
||||
-@->
|
||||
(foo "The prefix is: @.")
|
||||
--
|
||||
@foo{@"@x{y}" => (x "y")}
|
||||
-@->
|
||||
(foo "@x{y} => (x \"y\")")
|
||||
---
|
||||
;; -------------------- alternative delimiters
|
||||
---
|
||||
@foo|{...}| -@-> (foo "...")
|
||||
---
|
||||
@foo|{"}" after "{"}| -@-> (foo "\"}\" after \"{\"")
|
||||
---
|
||||
@foo|{Nesting |{is}| ok}| -@-> (foo "Nesting |{is}| ok")
|
||||
---
|
||||
@foo|{Nested @form{not}}| -@-> (foo "Nested @form{not}")
|
||||
---
|
||||
@foo|{Nested |@form|{yes}|}| -@-> (foo "Nested " (form "yes"))
|
||||
---
|
||||
@foo|{Nested |@form{indep@{end}ence}}|
|
||||
-@->
|
||||
(foo "Nested " (form "indep" ("end") "ence"))
|
||||
---
|
||||
@foo|{Nested |@|name|}| -@-> (foo "Nested " name)
|
||||
---
|
||||
@foo|{With
|
||||
|@bar{multiple}
|
||||
lines.}|
|
||||
-@->
|
||||
(foo "With" "\n" (bar "multiple") "\n" "lines.")
|
||||
---
|
||||
@t|{In |@i|{sub|@"@"s}| too}| -@-> (t "In " (i "sub@s") " too")
|
||||
---
|
||||
@foo|<<<{@x{foo} |@{bar}|.}>>>| -@-> (foo "@x{foo} |@{bar}|.")
|
||||
---
|
||||
@foo|<<<{@x{foo} |<<<@{bar}|.}>>>| -@-> (foo "@x{foo} " ("bar") "|.")
|
||||
---
|
||||
@foo|!!{X |!!@b{Y}...}!!| -@-> (foo "X " (b "Y") "...")
|
||||
---
|
||||
;; -------------------- comments
|
||||
---
|
||||
(1 2 @; comment
|
||||
3 4)
|
||||
-@->
|
||||
(1 2 3 4)
|
||||
---
|
||||
@foo{bar @; comment
|
||||
baz@;
|
||||
blah}
|
||||
-@->
|
||||
(foo "bar bazblah")
|
||||
---
|
||||
@foo{bar @; comment, with space and newline
|
||||
|
||||
baz}
|
||||
-@->
|
||||
(foo "bar " "\n" "baz")
|
||||
---
|
||||
@foo{bar @;{a balanced comment} baz}
|
||||
-@->
|
||||
(foo "bar baz")
|
||||
---
|
||||
@foo|{bar @;{a non-comment} baz}|
|
||||
-@->
|
||||
(foo "bar @;{a non-comment} baz")
|
||||
---
|
||||
@foo|{bar |@;{a balanced comment again} baz}|
|
||||
-@->
|
||||
(foo "bar baz")
|
||||
---
|
||||
@foo{First line@;{there is still a
|
||||
newline here;}
|
||||
Second line}
|
||||
-@->
|
||||
(foo "First line" "\n" "Second line")
|
||||
---
|
||||
@foo{A long @;
|
||||
single-@;
|
||||
string arg.}
|
||||
-@->
|
||||
(foo "A long single-string arg.")
|
||||
---
|
||||
;; -------------------- indentation management
|
||||
---
|
||||
@foo{ bar
|
||||
baz }
|
||||
-@->
|
||||
(foo " bar" "\n" "baz ")
|
||||
---
|
||||
@foo{bar
|
||||
}
|
||||
-@->
|
||||
(foo "bar")
|
||||
---
|
||||
@foo{
|
||||
bar}
|
||||
-@->
|
||||
(foo "bar")
|
||||
---
|
||||
@foo{
|
||||
bar
|
||||
}
|
||||
-@->
|
||||
(foo "bar")
|
||||
---
|
||||
@foo{
|
||||
|
||||
bar
|
||||
|
||||
}
|
||||
-@->
|
||||
(foo "\n" "bar" "\n")
|
||||
---
|
||||
@foo{
|
||||
bar
|
||||
|
||||
baz
|
||||
}
|
||||
-@->
|
||||
(foo "bar" "\n" "\n" "baz")
|
||||
---
|
||||
@foo{
|
||||
}
|
||||
-@->
|
||||
(foo "\n")
|
||||
---
|
||||
@foo{
|
||||
bar
|
||||
baz
|
||||
blah
|
||||
}
|
||||
-@->
|
||||
(foo "bar" "\n" "baz" "\n" "blah")
|
||||
---
|
||||
@foo{
|
||||
begin
|
||||
x++;
|
||||
end}
|
||||
-@->
|
||||
(foo "begin" "\n" " " "x++;" "\n" "end")
|
||||
---
|
||||
@foo{
|
||||
a
|
||||
b
|
||||
c}
|
||||
-@->
|
||||
(foo " " "a" "\n" " " "b" "\n" "c")
|
||||
---
|
||||
@foo{bar
|
||||
baz
|
||||
bbb}
|
||||
-@->
|
||||
(foo "bar" "\n" " " "baz" "\n" "bbb")
|
||||
---
|
||||
;; requires location tracking
|
||||
@foo{ bar
|
||||
baz
|
||||
bbb}
|
||||
-@->
|
||||
(foo " bar" "\n" " " "baz" "\n" " " "bbb")
|
||||
---
|
||||
@foo{bar
|
||||
baz
|
||||
bbb}
|
||||
-@->
|
||||
(foo "bar" "\n" "baz" "\n" "bbb")
|
||||
---
|
||||
@foo{ bar
|
||||
baz
|
||||
bbb}
|
||||
-@->
|
||||
(foo " bar" "\n" "baz" "\n" "bbb")
|
||||
---
|
||||
@foo{ bar
|
||||
baz
|
||||
bbb}
|
||||
-@->
|
||||
(foo " bar" "\n" "baz" "\n" " " "bbb")
|
||||
---
|
||||
@text{Some @b{bold
|
||||
text}, and
|
||||
more text.}
|
||||
-@->
|
||||
(text "Some " (b "bold" "\n" "text") ", and" "\n" "more text.")
|
||||
---
|
||||
@code{
|
||||
begin
|
||||
i = 1, r = 1
|
||||
@bold{while i < n do
|
||||
r *= i++
|
||||
done}
|
||||
end
|
||||
}
|
||||
-@->
|
||||
(code "begin" "\n"
|
||||
" " "i = 1, r = 1" "\n"
|
||||
" " (bold "while i < n do" "\n"
|
||||
" " "r *= i++" "\n"
|
||||
"done") "\n"
|
||||
"end")
|
||||
---
|
||||
@foo{
|
||||
@|| bar @||
|
||||
@|| baz}
|
||||
-@->
|
||||
(foo " bar " "\n" " baz")
|
||||
---
|
||||
@foo{bar
|
||||
@|baz| bbb
|
||||
@|x1 x2| x3 x4
|
||||
@|| waaaah
|
||||
}
|
||||
-@->
|
||||
(foo "bar" "\n" baz " bbb" "\n" x1 x2 " x3 x4" "\n" " waaaah")
|
||||
---
|
||||
@foo{x1
|
||||
x2@;
|
||||
y2
|
||||
x3@;{
|
||||
;}y3
|
||||
x4@|
|
||||
|y4
|
||||
x5}
|
||||
-@->
|
||||
(foo "x1" "\n" "x2y2" "\n" "x3y3" "\n" "x4" "y4" "\n" "x5")
|
||||
---
|
||||
;; -------------------- ||-quotes for artificial separators and multi-exprs
|
||||
---
|
||||
@foo{x@||z} -@-> (foo "x" "z")
|
||||
---
|
||||
@foo{x@|"y"|z} -@-> (foo "x" "y" "z")
|
||||
---
|
||||
@foo{x@|"y" "z"|} -@-> (foo "x" "y" "z")
|
||||
---
|
||||
@foo{x@|1 (+ 2 3) 4|y} -@-> (foo "x" 1 (+ 2 3) 4 "y")
|
||||
---
|
||||
@foo{x@|*
|
||||
*|y}
|
||||
-@->
|
||||
(foo "x" * * "y")
|
||||
---
|
||||
@foo{Alice@||Bob@|
|
||||
|Carol}
|
||||
-@->
|
||||
(foo "Alice" "Bob" "Carol")
|
||||
---
|
||||
@foo{Alice@||Bob@| x
|
||||
|Carol}
|
||||
-@->
|
||||
(foo "Alice" "Bob" x "Carol")
|
||||
---
|
||||
@foo{@||
|
||||
bar
|
||||
@||}
|
||||
-@->
|
||||
(foo "\n" "bar" "\n")
|
||||
---
|
||||
;; -------------------- some code test
|
||||
---
|
||||
@string-append{1 @(number->string (+ 2 3)) 4} -@e-> "1 5 4"
|
||||
---
|
||||
(let* ([formatter (lambda (fmt)
|
||||
(lambda args (format fmt (apply string-append args))))]
|
||||
[bf (formatter "*~a*")]
|
||||
[it (formatter "/~a/")]
|
||||
[ul (formatter "_~a_")]
|
||||
[text string-append])
|
||||
@text{@it{Note}: @bf{This is @ul{not} a pipe}.})
|
||||
-@e->
|
||||
"/Note/: *This is _not_ a pipe*."
|
||||
---
|
||||
(let ([nl (car @'{
|
||||
})]
|
||||
[o (open-output-string)])
|
||||
(for-each (lambda (x) (display (if (eq? x nl) "\n... " x) o))
|
||||
@`{foo
|
||||
@,@(list "bar" "\n" "baz")
|
||||
blah})
|
||||
(newline o)
|
||||
(get-output-string o))
|
||||
-@e->
|
||||
"foo\n... bar\nbaz\n... blah\n"
|
||||
---
|
||||
(let-syntax ([foo
|
||||
(lambda (stx)
|
||||
(let ([p (syntax-property stx 'scribble)])
|
||||
(syntax-case stx ()
|
||||
[(_ x ...)
|
||||
(and (pair? p) (eq? (car p) 'form) (even? (cadr p)))
|
||||
(let loop ([n (/ (cadr p) 2)]
|
||||
[as '()]
|
||||
[xs (syntax->list #'(x ...))])
|
||||
(if (zero? n)
|
||||
#`(list 'foo `#,(reverse as) #,@xs)
|
||||
(loop (sub1 n)
|
||||
(cons #`(#,(car xs) ,#,(cadr xs)) as)
|
||||
(cddr xs))))])))])
|
||||
@foo[x 1 y (* 2 3)]{blah})
|
||||
-@e->
|
||||
(foo ((x 1) (y 6)) "blah")
|
||||
---
|
||||
(let-syntax ([verb
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ cmd item ...)
|
||||
#`(cmd
|
||||
#,@(let loop ([items (syntax->list #'(item ...))])
|
||||
(if (null? items)
|
||||
'()
|
||||
(let* ([fst (car items)]
|
||||
[prop (syntax-property fst 'scribble)]
|
||||
[rst (loop (cdr items))])
|
||||
(cond [(eq? prop 'indentation) rst]
|
||||
[(not (and (pair? prop)
|
||||
(eq? (car prop)
|
||||
'newline)))
|
||||
(cons fst rst)]
|
||||
[else (cons (datum->syntax
|
||||
fst (cadr prop) fst)
|
||||
rst)])))))]))])
|
||||
@verb[string-append]{
|
||||
foo
|
||||
bar
|
||||
})
|
||||
-@e->
|
||||
"foo\n bar"
|
||||
---
|
||||
|
||||
END-OF-TESTS
|
||||
)
|
||||
|
||||
(define-namespace-anchor anchor)
|
||||
(define ns (namespace-anchor->namespace anchor))
|
||||
(define (string->tester name) (eval (string->symbol name) ns))
|
||||
|
||||
(define (read-all str reader)
|
||||
(define i (open-input-string str))
|
||||
(port-count-lines! i)
|
||||
(let loop ()
|
||||
(let ([x (reader i)])
|
||||
(if (eof-object? x) '() (cons x (loop))))))
|
||||
|
||||
(define (x . -@e-> . y)
|
||||
(define r (void))
|
||||
(for ([x (read-all x (lambda (i) (scr:read-syntax 'test i)))])
|
||||
(set! r (call-with-values (lambda () (eval x ns)) list)))
|
||||
(values r (read-all y read)))
|
||||
|
||||
(define (x . -@-> . y)
|
||||
(values (read-all x scr:read) (read-all y read)))
|
||||
|
||||
(define (reader-tests)
|
||||
(test do
|
||||
(let* ([ts the-tests]
|
||||
[ts (regexp-replace* #px"(?m:^;.*\r?\n)" ts "")]
|
||||
[ts (regexp-replace #px"^\\s+" ts "")]
|
||||
[ts (regexp-replace #px"\\s+$" ts "")]
|
||||
[ts (regexp-split #px"\\s*(?:^|\r?\n)-+(?:$|\r?\n)\\s*" ts)])
|
||||
(for ([t ts] #:when (not (equal? "" t)))
|
||||
(let ([m (regexp-match #px"^(.*\\S)\\s+(-\\S+->)\\s+(\\S.*)$" t)])
|
||||
(if (not (and m (= 4 (length m))))
|
||||
(error 'bad-test "~a" t)
|
||||
(let-values ([(x y)
|
||||
((string->tester (caddr m)) (cadr m) (cadddr m))])
|
||||
(test #:failure-message
|
||||
(format "bad result in\n ~a\n results:\n ~s != ~s"
|
||||
(regexp-replace* #rx"\n" t "\n ")
|
||||
x y)
|
||||
(equal? x y)))))))))
|
||||
Loading…
Reference in New Issue
Block a user