steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

factor: more syntax cleanups.

locals-and-roots
Doug Coleman 2016-06-21 17:16:24 -07:00
parent 0167ab0614
commit 66a9842c96
10 changed files with 99 additions and 239 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collections/interval-sets/interval-sets-tests.factor
View File

@ -69,7 +69,7 @@ CONSTANT: i5 $[
{ t } [ 8 i5 in? ] unit-test { t } [ 8 i5 in? ] unit-test
{ f } [ 9 i5 in? ] unit-test { f } [ 9 i5 in? ] unit-test
CONSTANT: i6 $[ ; CONSTANT: i6 $[
{ { 2 5 } } <interval-set> { { 2 5 } } <interval-set>
{ { 4 8 } } <interval-set> { { 4 8 } } <interval-set>
<interval-and> ] ; <interval-and> ] ;

47
core/multiline/multiline-docs.factor
View File

@ -1,47 +0,0 @@
USING: help.markup help.syntax strings ;
in: multiline
HELP: /*
{ $syntax "/* comment */" }
{ $description "Provides C-like comments that can span multiple lines. One caveat is that " { $snippet "/*" } " and " { $snippet "*/" } " are still tokens and must not appear in the comment text itself." }
{ $examples
{ $example "USING: multiline ;"
"/* I think that I shall never see"
" A poem lovely as a tree. */"
""
}
} ;
HELP: \ HEREDOC:
{ $syntax "HEREDOC: marker\n...text...\nmarker" }
{ $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "value" string } }
{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link postpone\ HEREDOC: } " until the end of the line containing " { $link postpone\ HEREDOC: } ". Text is captured until a line is found containing exactly this delimiter string." }
{ $warning "Whitespace is significant." }
{ $examples
{ $example "USING: multiline prettyprint ;"
"HEREDOC: END\nx\nEND\n."
"\"x\\n\""
}
{ $example "USING: multiline prettyprint sequences ;"
"2 5 HEREDOC: zap\nfoo\nbar\nzap\nsubseq ."
"\"o\\nb\""
}
} ;
HELP: parse-multiline-string
{ $values { "end-text" "a string delineating the end" } { "str" "the parsed string" } }
{ $description "Parses the input stream until the " { $snippet "end-text" } " is reached and returns the parsed text as a string." }
{ $notes "Used to implement " { $link postpone\ /* } "." } ;
ARTICLE: "multiline" "Multiline"
"Multiline strings:"
{ $subsections
postpone\ HEREDOC:
}
"Multiline comments:"
{ $subsections postpone\ /* }
"Writing new multiline parsing words:"
{ $subsections parse-multiline-string }
;
about: "multiline"

93
core/multiline/multiline-tests.factor
View File

@ -1,93 +0,0 @@
USING: eval multiline sequences tools.test ;
in: multiline.tests
CONSTANT: test-it [[ foo
bar
]] ;
{ "foo\nbar\n" } [ test-it ] unit-test
! HEREDOC:
{ "foo\nbar\n" } [ HEREDOC: END
foo
bar
END
] unit-test
{ "" } [ HEREDOC: END
END
] unit-test
{ " END\n" } [ HEREDOC: END
END
END
] unit-test
{ "\n" } [ HEREDOC: END
END
] unit-test
{ "x\n" } [ HEREDOC: END
x
END
] unit-test
{ "x\n" } [ HEREDOC: END
x
END
] unit-test
! there's a space after xyz
{ "xyz \n" } [ HEREDOC: END
xyz
END
] unit-test
{ "} ! * # \" «\n" } [ HEREDOC: END
} ! * # " «
END
] unit-test
{ 21 "foo\nbar\n" " HEREDOC: FOO\n FOO\n" 22 } [ 21 HEREDOC: X
foo
bar
X
HEREDOC: END
HEREDOC: FOO
FOO
END
22 ] unit-test
{ "lol\n xyz\n" }
[
HEREDOC: xyz
lol
xyz
xyz
] unit-test
/*
COMPILE<
SYNTAX: MULTILINE-LITERAL: parse-here suffix! ;
COMPILE>
{ { "bar" } }
[
CONSTANT: foo { MULTILINE-LITERAL:
bar
;
} ;
foo
] unit-test
! Make sure parse-here fails if extra crap appears on the first line
[
"CONSTANT: foo { MULTILINE-LITERAL: asdfasfdasdfas
bar
;
} ;" eval
] must-fail
*/

164
core/parser/parser-tests.factor
View File

@ -3,7 +3,7 @@ eval generic grouping io.pathnames io.streams.string kernel
lexer math multiline namespaces parser sequences sets lexer math multiline namespaces parser sequences sets
source-files source-files.errors strings tools.crossref source-files source-files.errors strings tools.crossref
tools.test vocabs vocabs.parser words words.symbol ; tools.test vocabs vocabs.parser words words.symbol ;
in: parser.tests IN: parser.tests
{ 1 [ 2 [ 3 ] 4 ] 5 } { 1 [ 2 [ 3 ] 4 ] 5 }
[ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ] [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
@ -29,15 +29,15 @@ unit-test
{ "hello world" } { "hello world" }
[ [
"in: parser.tests : hello ( -- str ) \"hello world\" ;" "IN: parser.tests : hello ( -- str ) \"hello world\" ;"
eval( -- ) "use: parser.tests hello" eval( -- string ) eval( -- ) "USE: parser.tests hello" eval( -- string )
] unit-test ] unit-test
[ "in: parser.tests : \" ( -- n ) 123 ;" eval( -- ) ] [ "IN: parser.tests : \" ( -- n ) 123 ;" eval( -- ) ]
[ error>> invalid-word-name? ] must-fail-with [ error>> invalid-word-name? ] must-fail-with
[ "in: parser.tests : \"asdf ( -- n ) 123 ;" eval( -- ) ] [ "IN: parser.tests : \"asdf ( -- n ) 123 ;" eval( -- ) ]
[ error>> invalid-word-name? ] must-fail-with [ error>> invalid-word-name? ] must-fail-with
[ "in: parser.tests : 123 ( -- n ) 123 ;" eval( -- ) ] [ "IN: parser.tests : 123 ( -- n ) 123 ;" eval( -- ) ]
[ error>> invalid-word-name? ] must-fail-with [ error>> invalid-word-name? ] must-fail-with
{ } { }
@ -77,7 +77,7 @@ unit-test
[ \ baz "declared-effect" word-prop terminated?>> ] [ \ baz "declared-effect" word-prop terminated?>> ]
unit-test unit-test
{ } [ "in: parser.tests use: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test { } [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
{ t } [ { t } [
"effect-parsing-test" "parser.tests" lookup-word "effect-parsing-test" "parser.tests" lookup-word
@ -87,21 +87,21 @@ unit-test
{ T{ effect f { "a" "b" } { "d" } f } } { T{ effect f { "a" "b" } { "d" } f } }
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
[ "in: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail [ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
! Funny bug ! Funny bug
{ 2 } [ "in: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test { 2 } [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
defer: foo defer: foo
"in: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- ) "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
{ } [ "use: parser.tests foo" eval( -- ) ] unit-test { } [ "USE: parser.tests foo" eval( -- ) ] unit-test
"in: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- ) "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
{ t } [ { t } [
"use: parser.tests \\ foo" eval( -- word ) "USE: parser.tests \\ foo" eval( -- word )
"foo" "parser.tests" lookup-word eq? "foo" "parser.tests" lookup-word eq?
] unit-test ] unit-test
@ -112,7 +112,7 @@ defer: foo
! Test smudging ! Test smudging
{ 1 } [ { 1 } [
"in: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo" "IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
parse-stream drop parse-stream drop
"foo" path>source-file definitions>> first cardinality "foo" path>source-file definitions>> first cardinality
@ -121,7 +121,7 @@ defer: foo
{ t } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test { t } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
{ } [ { } [
"in: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo" "IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
parse-stream drop parse-stream drop
] unit-test ] unit-test
@ -129,21 +129,21 @@ defer: foo
{ f } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test { f } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
{ 3 } [ { 3 } [
"in: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) ; M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo" "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) ; M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
parse-stream drop parse-stream drop
"foo" path>source-file definitions>> first cardinality "foo" path>source-file definitions>> first cardinality
] unit-test ] unit-test
{ 1 } [ { 1 } [
"in: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar" "IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
parse-stream drop parse-stream drop
"bar" path>source-file definitions>> first cardinality "bar" path>source-file definitions>> first cardinality
] unit-test ] unit-test
{ 2 } [ { 2 } [
"in: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) ; M: integer smudge-me ;" <string-reader> "foo" "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) ; M: integer smudge-me ;" <string-reader> "foo"
parse-stream drop parse-stream drop
"foo" path>source-file definitions>> first cardinality "foo" path>source-file definitions>> first cardinality
@ -162,7 +162,7 @@ defer: foo
] unit-test ] unit-test
{ } [ { } [
"in: parser.tests use: math 2 2 +" <string-reader> "a" "IN: parser.tests USE: math 2 2 +" <string-reader> "a"
parse-stream drop parse-stream drop
] unit-test ] unit-test
@ -171,7 +171,7 @@ defer: foo
] unit-test ] unit-test
{ } [ { } [
"in: parser.tests use: math 2 2 -" <string-reader> "a" "IN: parser.tests USE: math 2 2 -" <string-reader> "a"
parse-stream drop parse-stream drop
] unit-test ] unit-test
@ -182,7 +182,7 @@ defer: foo
{ } [ { } [
"a" source-files get delete-at "a" source-files get delete-at
2 [ 2 [
"in: parser.tests defer: x : y ( -- ) x ; : x ( -- ) y ;" "IN: parser.tests defer: x : y ( -- ) x ; : x ( -- ) y ;"
<string-reader> "a" parse-stream drop <string-reader> "a" parse-stream drop
] times ] times
] unit-test ] unit-test
@ -190,7 +190,7 @@ defer: foo
"a" source-files get delete-at "a" source-files get delete-at
[ [
"in: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error" "IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error"
<string-reader> "a" parse-stream <string-reader> "a" parse-stream
] [ source-file-error? ] must-fail-with ] [ source-file-error? ] must-fail-with
@ -199,25 +199,25 @@ defer: foo
] unit-test ] unit-test
{ f } [ { f } [
"in: parser.tests : x ( -- ) ;" "IN: parser.tests : x ( -- ) ;"
<string-reader> "a" parse-stream drop <string-reader> "a" parse-stream drop
"y" "parser.tests" lookup-word "y" "parser.tests" lookup-word
] unit-test ] unit-test
! Test new forward definition logic ! Test new forward definition logic
{ } [ { } [
"in: axx : axx ( -- ) ;" "IN: axx : axx ( -- ) ;"
<string-reader> "axx" parse-stream drop <string-reader> "axx" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"use: axx in: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;" "USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
<string-reader> "bxx" parse-stream drop <string-reader> "bxx" parse-stream drop
] unit-test ] unit-test
! So we move the bxx word to axx... ! So we move the bxx word to axx...
{ } [ { } [
"in: axx : axx ( -- ) ; : bxx ( -- ) ;" "IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
<string-reader> "axx" parse-stream drop <string-reader> "axx" parse-stream drop
] unit-test ] unit-test
@ -225,7 +225,7 @@ defer: foo
! And reload the file that uses it... ! And reload the file that uses it...
{ } [ { } [
"use: axx in: bxx ( -- ) : cxx ( -- ) axx bxx ;" "USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
<string-reader> "bxx" parse-stream drop <string-reader> "bxx" parse-stream drop
] unit-test ] unit-test
@ -234,53 +234,53 @@ defer: foo
! Turning a generic into a non-generic could cause all ! Turning a generic into a non-generic could cause all
! kinds of funnyness ! kinds of funnyness
{ } [ { } [
"in: ayy use: kernel GENERIC: ayy ( a -- b ) ; M: object ayy ;" "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) ; M: object ayy ;"
<string-reader> "ayy" parse-stream drop <string-reader> "ayy" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"in: ayy use: kernel : ayy ( -- ) ;" "IN: ayy USE: kernel : ayy ( -- ) ;"
<string-reader> "ayy" parse-stream drop <string-reader> "ayy" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"in: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b ) ;" "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b ) ;"
<string-reader> "azz" parse-stream drop <string-reader> "azz" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"use: azz M: my-class a-generic ;" "USE: azz M: my-class a-generic ;"
<string-reader> "azz-2" parse-stream drop <string-reader> "azz-2" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"in: azz GENERIC: a-generic ( a -- b ) ;" "IN: azz GENERIC: a-generic ( a -- b ) ;"
<string-reader> "azz" parse-stream drop <string-reader> "azz" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"use: azz use: math M: integer a-generic ;" "USE: azz USE: math M: integer a-generic ;"
<string-reader> "azz-2" parse-stream drop <string-reader> "azz-2" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"in: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;" "IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop <string-reader> "bogus-error" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"in: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;" "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop <string-reader> "bogus-error" parse-stream drop
] unit-test ] unit-test
! Problems with class predicates -vs- ordinary words ! Problems with class predicates -vs- ordinary words
{ } [ { } [
"in: parser.tests TUPLE: killer ;" "IN: parser.tests TUPLE: killer ;"
<string-reader> "removing-the-predicate" parse-stream drop <string-reader> "removing-the-predicate" parse-stream drop
] unit-test ] unit-test
{ } [ { } [
"in: parser.tests GENERIC: killer? ( a -- b ) ;" "IN: parser.tests GENERIC: killer? ( a -- b ) ;"
<string-reader> "removing-the-predicate" parse-stream drop <string-reader> "removing-the-predicate" parse-stream drop
] unit-test ] unit-test
@ -289,60 +289,60 @@ defer: foo
] unit-test ] unit-test
[ [
"in: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b ) ;" "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b ) ;"
<string-reader> "removing-the-predicate" parse-stream <string-reader> "removing-the-predicate" parse-stream
] [ error>> error>> error>> redefine-error? ] must-fail-with ] [ error>> error>> error>> redefine-error? ] must-fail-with
[ [
"in: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;" "IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
<string-reader> "redefining-a-class-1" parse-stream <string-reader> "redefining-a-class-1" parse-stream
] [ error>> error>> error>> redefine-error? ] must-fail-with ] [ error>> error>> error>> redefine-error? ] must-fail-with
{ } [ { } [
"in: parser.tests TUPLE: class-redef-test ; symbol: class-redef-test" "IN: parser.tests TUPLE: class-redef-test ; symbol: class-redef-test"
<string-reader> "redefining-a-class-2" parse-stream drop <string-reader> "redefining-a-class-2" parse-stream drop
] unit-test ] unit-test
[ [
"in: parser.tests TUPLE: class-redef-test ; symbol: class-redef-test : class-redef-test ( -- ) ;" "IN: parser.tests TUPLE: class-redef-test ; symbol: class-redef-test : class-redef-test ( -- ) ;"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> redefine-error? ] must-fail-with ] [ error>> error>> error>> redefine-error? ] must-fail-with
{ } [ { } [
"in: parser.tests TUPLE: class-fwd-test ;" "IN: parser.tests TUPLE: class-fwd-test ;"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] unit-test ] unit-test
[ [
"in: parser.tests \\ class-fwd-test" "IN: parser.tests \\ class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> no-word-error? ] must-fail-with ] [ error>> error>> error>> no-word-error? ] must-fail-with
{ } [ { } [
"in: parser.tests TUPLE: class-fwd-test ; symbol: class-fwd-test" "IN: parser.tests TUPLE: class-fwd-test ; symbol: class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] unit-test ] unit-test
[ [
"in: parser.tests \\ class-fwd-test" "IN: parser.tests \\ class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> no-word-error? ] must-fail-with ] [ error>> error>> error>> no-word-error? ] must-fail-with
[ [
"in: parser.tests : foo ( -- ) ; TUPLE: foo ;" "IN: parser.tests : foo ( -- ) ; TUPLE: foo ;"
<string-reader> "redefining-a-class-4" parse-stream drop <string-reader> "redefining-a-class-4" parse-stream drop
] [ error>> error>> error>> redefine-error? ] must-fail-with ] [ error>> error>> error>> redefine-error? ] must-fail-with
{ } [ { } [
"in: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- ) "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- )
] unit-test ] unit-test
[ [
"in: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- ) "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- )
] must-fail ] must-fail
{ } [ { } [
"in: parser.tests use: kernel PREDICATE: foo < object ;" eval( -- ) "IN: parser.tests USE: kernel PREDICATE: foo < object ;" eval( -- )
] unit-test ] unit-test
{ t } [ { t } [
@ -359,33 +359,33 @@ defer: foo
2 [ 2 [
[ ] [ [ ] [
"in: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;" "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;"
<string-reader> "redefining-a-class-5" parse-stream drop <string-reader> "redefining-a-class-5" parse-stream drop
] unit-test ] unit-test
[ ] [ [ ] [
"in: parser.tests M: f foo ;" "IN: parser.tests M: f foo ;"
<string-reader> "redefining-a-class-6" parse-stream drop <string-reader> "redefining-a-class-6" parse-stream drop
] unit-test ] unit-test
[ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
[ ] [ [ ] [
"in: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;" "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;"
<string-reader> "redefining-a-class-5" parse-stream drop <string-reader> "redefining-a-class-5" parse-stream drop
] unit-test ] unit-test
[ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
[ ] [ [ ] [
"in: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;" "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;"
<string-reader> "redefining-a-class-7" parse-stream drop <string-reader> "redefining-a-class-7" parse-stream drop
] unit-test ] unit-test
[ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test
[ ] [ [ ] [
"in: parser.tests TUPLE: foo ;" "IN: parser.tests TUPLE: foo ;"
<string-reader> "redefining-a-class-7" parse-stream drop <string-reader> "redefining-a-class-7" parse-stream drop
] unit-test ] unit-test
@ -396,17 +396,17 @@ defer: foo
2 [ 2 [
[ ] [ [ ] [
"in: parser.tests defer: d-f-s d-f-s symbol: d-f-s d-f-s" "IN: parser.tests defer: d-f-s d-f-s symbol: d-f-s d-f-s"
<string-reader> "d-f-s-test" parse-stream drop <string-reader> "d-f-s-test" parse-stream drop
] unit-test ] unit-test
[ ] [ [ ] [
"in: parser.tests defer: d-f-s d-f-s forget: d-f-s symbol: d-f-s d-f-s" "IN: parser.tests defer: d-f-s d-f-s forget: d-f-s symbol: d-f-s d-f-s"
<string-reader> "d-f-s-test" parse-stream drop <string-reader> "d-f-s-test" parse-stream drop
] unit-test ] unit-test
[ ] [ [ ] [
"in: parser.tests defer: d-f-s d-f-s symbol: d-f-s d-f-s" "IN: parser.tests defer: d-f-s d-f-s symbol: d-f-s d-f-s"
<string-reader> "d-f-s-test" parse-stream drop <string-reader> "d-f-s-test" parse-stream drop
] unit-test ] unit-test
] times ] times
@ -416,7 +416,7 @@ defer: foo
] unit-test ] unit-test
[ [
"use: this-better-not-exist" eval( -- ) "USE: this-better-not-exist" eval( -- )
] must-fail ] must-fail
[ ": foo ;" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with [ ": foo ;" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
@ -426,7 +426,7 @@ defer: foo
{ } [ { } [
{ {
"in: parser.tests" "IN: parser.tests"
"USING: math arrays kernel ;" "USING: math arrays kernel ;"
"GENERIC: change-combination ( obj a -- b ) ;" "GENERIC: change-combination ( obj a -- b ) ;"
"M: integer change-combination 2drop 1 ;" "M: integer change-combination 2drop 1 ;"
@ -436,7 +436,7 @@ defer: foo
{ } [ { } [
{ {
"in: parser.tests" "IN: parser.tests"
"USING: math arrays kernel ;" "USING: math arrays kernel ;"
"GENERIC#: change-combination 1 ( obj a -- b )" "GENERIC#: change-combination 1 ( obj a -- b )"
"M: integer change-combination 2drop 1 ;" "M: integer change-combination 2drop 1 ;"
@ -451,13 +451,13 @@ defer: foo
{ } [ { } [
2 [ 2 [
"in: parser.tests defer: twice-fails forget: twice-fails mixin: twice-fails" "IN: parser.tests defer: twice-fails forget: twice-fails mixIN: twice-fails"
<string-reader> "twice-fails-test" parse-stream drop <string-reader> "twice-fails-test" parse-stream drop
] times ] times
] unit-test ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;" "IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
<string-reader> "staging-problem-test" parse-stream <string-reader> "staging-problem-test" parse-stream
] unit-test ] unit-test
@ -466,7 +466,7 @@ defer: foo
{ t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test { t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests COMPILE< : staging-problem-test-1 ( -- a ) 1 ; COMPILE> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;" "IN: parser.tests COMPILE< : staging-problem-test-1 ( -- a ) 1 ; COMPILE> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
<string-reader> "staging-problem-test" parse-stream <string-reader> "staging-problem-test" parse-stream
] unit-test ] unit-test
@ -477,7 +477,7 @@ defer: foo
[ "defer: blahy" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with [ "defer: blahy" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
[ [
"in: parser.tests SYNTAX: blahy ; forget: blahy" eval( -- ) "IN: parser.tests SYNTAX: blahy ; forget: blahy" eval( -- )
] [ ] [
error>> staging-violation? error>> staging-violation?
] must-fail-with ] must-fail-with
@ -485,7 +485,7 @@ defer: foo
! Bogus error message ! Bogus error message
defer: blahy defer: blahy
[ "in: parser.tests use: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval( -- ) ] [ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval( -- ) ]
[ error>> error>> def>> \ blahy eq? ] must-fail-with [ error>> error>> def>> \ blahy eq? ] must-fail-with
[ "char: \\u9999999999999" eval( -- n ) ] must-fail [ "char: \\u9999999999999" eval( -- n ) ] must-fail
@ -498,25 +498,25 @@ SYMBOLS: a b c ;
defer: blah defer: blah
{ } [ "in: parser.tests GENERIC: blah ( x -- x )" eval( -- ) ; ] unit-test { } [ "IN: parser.tests GENERIC: blah ( x -- x ) ;" eval( -- ) ] unit-test
{ } [ "in: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test { } [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
{ f } [ \ blah generic? ] unit-test { f } [ \ blah generic? ] unit-test
{ t } [ \ blah symbol? ] unit-test { t } [ \ blah symbol? ] unit-test
defer: blah1 defer: blah1
[ "in: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval( -- ) ] [ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval( -- ) ]
[ error>> error>> def>> \ blah1 eq? ] [ error>> error>> def>> \ blah1 eq? ]
must-fail-with must-fail-with
in: qualified.tests.foo IN: qualified.tests.foo
: x ( -- a ) 1 ; : x ( -- a ) 1 ;
: y ( -- a ) 5 ; : y ( -- a ) 5 ;
in: qualified.tests.bar IN: qualified.tests.bar
: x ( -- a ) 2 ; : x ( -- a ) 2 ;
: y ( -- a ) 4 ; : y ( -- a ) 4 ;
in: qualified.tests.baz IN: qualified.tests.baz
: x ( -- a ) 3 ; : x ( -- a ) 3 ;
qualified: qualified.tests.foo qualified: qualified.tests.foo
@ -541,14 +541,14 @@ EXCLUDE: qualified.tests.bar => x ;
! Replace : def with something in COMPILE< COMPILE> ! Replace : def with something in COMPILE< COMPILE>
/* { [ ] } [ /* { [ ] } [
"in: parser.tests : was-once-a-word-bug ( -- ) ;" "IN: parser.tests : was-once-a-word-bug ( -- ) ;"
<string-reader> "was-once-a-word-test" parse-stream <string-reader> "was-once-a-word-test" parse-stream
] unit-test ] unit-test
{ t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test { t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests use: words COMPILE< \"was-once-a-word-bug\" \"parser.tests\" create-word [ ] ( -- ) define-declared COMPILE>" "IN: parser.tests USE: words COMPILE< \"was-once-a-word-bug\" \"parser.tests\" create-word [ ] ( -- ) define-declared COMPILE>"
<string-reader> "was-once-a-word-test" parse-stream <string-reader> "was-once-a-word-test" parse-stream
] unit-test ] unit-test
@ -556,7 +556,7 @@ EXCLUDE: qualified.tests.bar => x ;
! Replace : def with defer: ! Replace : def with defer:
{ [ ] } [ { [ ] } [
"in: parser.tests : is-not-deferred ( -- ) ;" "IN: parser.tests : is-not-deferred ( -- ) ;"
<string-reader> "is-not-deferred" parse-stream <string-reader> "is-not-deferred" parse-stream
] unit-test ] unit-test
@ -564,7 +564,7 @@ EXCLUDE: qualified.tests.bar => x ;
{ f } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test { f } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests defer: is-not-deferred" "IN: parser.tests defer: is-not-deferred"
<string-reader> "is-not-deferred" parse-stream <string-reader> "is-not-deferred" parse-stream
] unit-test ] unit-test
@ -573,17 +573,17 @@ EXCLUDE: qualified.tests.bar => x ;
! Forward-reference resolution case iterated using list in the wrong direction ! Forward-reference resolution case iterated using list in the wrong direction
{ [ ] } [ { [ ] } [
"in: parser.tests.forward-ref-1 defer: x defer: y" "IN: parser.tests.forward-ref-1 defer: x defer: y"
<string-reader> "forward-ref-1" parse-stream <string-reader> "forward-ref-1" parse-stream
] unit-test ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests.forward-ref-2 defer: x defer: y" "IN: parser.tests.forward-ref-2 defer: x defer: y"
<string-reader> "forward-ref-2" parse-stream <string-reader> "forward-ref-2" parse-stream
] unit-test ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;" "IN: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream <string-reader> "forward-ref-3" parse-stream
] unit-test ] unit-test
@ -592,7 +592,7 @@ EXCLUDE: qualified.tests.bar => x ;
] unit-test ] unit-test
{ [ ] } [ { [ ] } [
"FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; in: parser.tests.forward-ref-3 : x ( -- ) ; : z ( -- ) x y ;" "FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; IN: parser.tests.forward-ref-3 : x ( -- ) ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream <string-reader> "forward-ref-3" parse-stream
] unit-test ] unit-test
@ -601,7 +601,7 @@ EXCLUDE: qualified.tests.bar => x ;
] unit-test ] unit-test
{ [ ] } [ { [ ] } [
"in: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;" "IN: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream <string-reader> "forward-ref-3" parse-stream
] unit-test ] unit-test
@ -610,7 +610,7 @@ EXCLUDE: qualified.tests.bar => x ;
] unit-test ] unit-test
{ [ dup ] } [ { [ dup ] } [
"use: kernel dup" <string-reader> "unuse-test" parse-stream "USE: kernel dup" <string-reader> "unuse-test" parse-stream
] unit-test ] unit-test
[ [
@ -618,7 +618,7 @@ EXCLUDE: qualified.tests.bar => x ;
] [ error>> error>> error>> no-word-error? ] must-fail-with ] [ error>> error>> error>> no-word-error? ] must-fail-with
[ [
"use: kernel UNuse: kernel dup" <string-reader> "unuse-test" parse-stream "USE: kernel UNUSE: kernel dup" <string-reader> "unuse-test" parse-stream
] [ error>> error>> error>> no-word-error? ] must-fail-with ] [ error>> error>> error>> no-word-error? ] must-fail-with
{ } [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test { } [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test

2
core/words/words-tests.factor
View File

@ -89,7 +89,7 @@ defer: deferred
[ error>> undefined-word? ] must-fail-with [ error>> undefined-word? ] must-fail-with
{ } [ { } [
"in: words.tests GENERIC: symbol-generic ( x -- x )" eval( -- ) ; "in: words.tests GENERIC: symbol-generic ( x -- x ) ;" eval( -- )
] unit-test ] unit-test
{ } [ { } [

6
ffi/windows/kernel32/kernel32.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Doug Coleman. ! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel windows.types USING: alien alien.c-types alien.syntax kernel windows.types
math multiline classes.struct alien.data arrays literals ; math classes.struct alien.data arrays literals ;
QUALIFIED-WITH: alien.c-types c ; QUALIFIED-WITH: alien.c-types c ;
IN: windows.kernel32 IN: windows.kernel32
@ -345,7 +345,7 @@ STRUCT: GUID
{ Data3 WORD } { Data3 WORD }
{ Data4 UCHAR[8] } ; { Data4 UCHAR[8] } ;
/* ![[
fBinary :1; fBinary :1;
fParity :1; fParity :1;
fOutxCtsFlow :1; fOutxCtsFlow :1;
@ -360,7 +360,7 @@ STRUCT: GUID
fRtsControl :2; fRtsControl :2;
fAbortOnError :1; fAbortOnError :1;
fDummy2 :17; fDummy2 :17;
*/ ]]
CONSTANT: SP_SERIALCOMM 0x1 ; CONSTANT: SP_SERIALCOMM 0x1 ;
CONSTANT: BAUD_075 0x1 ; CONSTANT: BAUD_075 0x1 ;

2
language/alien/data/map/map-tests.factor
View File

@ -4,7 +4,7 @@ math.vectors.conversion math math.vectors.simd math.ranges sequences
specialized-arrays tools.test ; specialized-arrays tools.test ;
FROM: alien.c-types => uchar short int float ; FROM: alien.c-types => uchar short int float ;
SPECIALIZED-ARRAYS: int float float-4 uchar-16 ; SPECIALIZED-ARRAYS: int float float-4 uchar-16 ;
in: alien.data.map.tests IN: alien.data.map.tests
{ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } } { float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } }
[ [

4
language/literate/literate-tests.factor
View File

@ -2,11 +2,11 @@ USING: eval kernel math tools.test ;
in: literate in: literate
{ 2 3 t } [ { 2 3 t } [
<LITERATE LITERATE[[
1 1
> 2 > 2
> 3 > 3
blah blah
> 2dup 1 - = > 2dup 1 - =
LITERATE> ]]
] unit-test ] unit-test

4
language/literate/literate.factor
View File

@ -19,7 +19,7 @@ M: literate-lexer skip-blank
] [ drop ] if* ] [ drop ] if*
] [ call-next-method ] if ; ] [ call-next-method ] if ;
SYNTAX: <LITERATE SYNTAX: \ LITERATE[[
"LITERATE>" parse-multiline-string string-lines [ "]]" parse-multiline-string string-lines [
<literate-lexer> (parse-lines) append! <literate-lexer> (parse-lines) append!
] with-nested-compilation-unit ; ] with-nested-compilation-unit ;

14
libs/infix/tokenizer/tokenizer-tests.factor
View File

@ -4,18 +4,18 @@ USING: infix.ast infix.tokenizer tools.test ;
in: infix.tokenizer.tests in: infix.tokenizer.tests
{ V{ T{ ast-number f 1 } } } [ "1" tokenize-infix ] unit-test { V{ T{ ast-number f 1 } } } [ "1" tokenize-infix ] unit-test
{ V{ T{ ast-number f 1.02 } char: * T{ ast-number f 3 } } } [ "1.02*3" tokenize-infix ] unit-test { V{ T{ ast-number f 1.02 } char: \* T{ ast-number f 3 } } } [ "1.02*3" tokenize-infix ] unit-test
{ V{ T{ ast-number f 3 } char: / char: \( T{ ast-number f 3 } char: + T{ ast-number f 4 } char: ) } } { V{ T{ ast-number f 3 } char: \/ char: \( T{ ast-number f 3 } char: \+ T{ ast-number f 4 } char: \) } }
[ "3/(3+4)" tokenize-infix ] unit-test [ "3/(3+4)" tokenize-infix ] unit-test
{ V{ "foo" char: \( "x" char: , "y" char: , "z" char: ) } } [ "foo(x,y,z)" tokenize-infix ] unit-test { V{ "foo" char: \( "x" char: \, "y" char: \, "z" char: \) } } [ "foo(x,y,z)" tokenize-infix ] unit-test
{ V{ "arr" char: \[ "x" char: + T{ ast-number f 3 } char: ] } } { V{ "arr" char: \[ "x" char: \+ T{ ast-number f 3 } char: \] } }
[ "arr[x+3]" tokenize-infix ] unit-test [ "arr[x+3]" tokenize-infix ] unit-test
[ "1.0.4" tokenize-infix ] must-fail [ "1.0.4" tokenize-infix ] must-fail
{ V{ char: + char: ] T{ ast-number f 3.4 } char: , "bar" } } { V{ char: \+ char: \] T{ ast-number f 3.4 } char: \, "bar" } }
[ "+]3.4,bar" tokenize-infix ] unit-test [ "+]3.4,bar" tokenize-infix ] unit-test
{ V{ "baz_34c" } } [ "baz_34c" tokenize-infix ] unit-test { V{ "baz_34c" } } [ "baz_34c" tokenize-infix ] unit-test
{ V{ T{ ast-number f 34 } "c_baz" } } [ "34c_baz" tokenize-infix ] unit-test { V{ T{ ast-number f 34 } "c_baz" } } [ "34c_baz" tokenize-infix ] unit-test
{ V{ char: \( T{ ast-number f 1 } char: + T{ ast-number f 2 } char: ) } } { V{ char: \( T{ ast-number f 1 } char: \+ T{ ast-number f 2 } char: \) } }
[ "(1+2)" tokenize-infix ] unit-test [ "(1+2)" tokenize-infix ] unit-test
{ V{ T{ ast-number f 1 } char: + T{ ast-number f 2 } char: / T{ ast-number f 3 } } } { V{ T{ ast-number f 1 } char: \+ T{ ast-number f 2 } char: \/ T{ ast-number f 3 } } }
[ "1\n+\r2\t/ 3" tokenize-infix ] unit-test [ "1\n+\r2\t/ 3" tokenize-infix ] unit-test