--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/islands/tests/PPIslandTest.st Wed Oct 08 00:33:44 2014 +0100
@@ -0,0 +1,723 @@
+"{ Package: 'stx:goodies/petitparser/islands/tests' }"
+
+PPAbstractParserTest subclass:#PPIslandTest
+ instanceVariableNames:'result context'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitIslands-Tests'
+!
+
+PPIslandTest comment:''
+!
+
+!PPIslandTest methodsFor:'as yet unclassified'!
+
+context
+ context ifNil: [ ^ super context ].
+ ^ context
+!
+
+setUp
+ super setUp.
+ context := nil
+! !
+
+!PPIslandTest methodsFor:'parse support'!
+
+identifier
+ ^ ((#letter asParser / $# asParser), (#letter asParser / #digit asParser) star) flatten
+!
+
+island: parser
+ ^ self islandInstance island: parser.
+!
+
+island: parser water: water
+ ^ self islandInstance
+ island: parser;
+ water: water;
+ yourself
+
+!
+
+islandClass
+ ^ PPIsland
+!
+
+islandInstance
+ ^ self islandClass new
+!
+
+nestedBlock
+ | blockIsland block nilIsland |
+ blockIsland := self islandInstance.
+ nilIsland := self nilIsland.
+
+ block := PPDelegateParser new.
+ block setParser: (${ asParser, (blockIsland plus / nilIsland), $} asParser).
+ block name: 'block'.
+
+ blockIsland island: block.
+ blockIsland name: 'block island'.
+ ^ block
+!
+
+nilIsland
+ | nilIsland |
+ nilIsland := self islandInstance.
+
+ nilIsland island: nil asParser.
+ nilIsland name: 'nil island'.
+
+ ^ nilIsland
+! !
+
+!PPIslandTest methodsFor:'parsing'!
+
+assert: parser parse: input
+ result := super assert: parser parse: input
+! !
+
+!PPIslandTest methodsFor:'testing'!
+
+testBlock
+ | block |
+
+ block := self nestedBlock.
+
+ self assert: block parse: '{}'.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result third = $}.
+
+ self assert: block parse: '{ }'.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result third = $}.
+
+ self assert: block parse: '{ { } }'.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result third = $}.
+
+
+ self assert: block parse: '{ { {{} } } }'.
+ self assert: result isCollection.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result second first second first = ${.
+ self assert: result second first second second first second first = ${.
+ self assert: result second first second second first second third = $}.
+ self assert: result second first second third = $}.
+ self assert: result third = $}.
+
+
+ self assert: block parse: '{ {
+ {{} }
+ } }'.
+ self assert: result isCollection.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result second first second first = ${.
+ self assert: result second first second second first second first = ${.
+ self assert: result second first second second first second third = $}.
+ self assert: result second first second third = $}.
+ self assert: result third = $}.
+!
+
+testBoundary
+ | p end body start |
+
+ "use non-trivial end-of-class a complex end"
+ end := 'end' asParser trimBlanks, 'of' asParser trimBlanks, 'class' asParser trimBlanks ==> [:args | #eoc].
+ body := self nilIsland.
+ start := 'class' asParser trim, self identifier.
+ p := start, body, end.
+
+ self assert: p parse: 'class Foo end of class'.
+ self assert: result size = 4.
+ self assert: result second = 'Foo'.
+
+ self assert: p parse: 'class Foo .... end of class'.
+ self assert: result size = 4.
+ self assert: result second = 'Foo'.
+
+ self assert: p parse: 'class Foo .... end ... end of class'.
+ self assert: result size = 4.
+ self assert: result second = 'Foo'.
+
+ self assert: p parse: 'class Foo .... end of ... end of class'.
+ self assert: result size = 4.
+ self assert: result second = 'Foo'.
+!
+
+testBoundary2
+
+ | epilog id p |
+ "use optional boundary"
+ epilog := 'end' asParser optional.
+ id := self identifier.
+ p := ((self island: id), epilog) plus.
+
+ self assert: p parse: '...foo..end...bar...end'.
+
+ self assert: result first first second = 'foo'.
+ self assert: result first second = 'end'.
+
+ self assert: result second first second = 'bar'.
+ self assert: result second second = 'end'.
+!
+
+testIslandAfterIslandPlus
+
+ | island2 islandParser2 island1 islandParser1 parser |
+ island1 := 'aa' asParser, 'bb' asParser.
+ islandParser1 := self islandInstance.
+ islandParser1 island: island1.
+
+ island2 := 'cc' asParser.
+ islandParser2 := self islandInstance.
+ islandParser2 island: island2.
+
+ parser := (islandParser1, islandParser2) plus.
+
+ result := islandParser1 parse: '__ aabb __ cc __'.
+ self assert: result isPetitFailure not.
+!
+
+testIslandAfterIslandPlus2
+
+ | island2 islandParser2 island1 islandParser1 parser |
+
+ island1 := 'aa' asParser, 'bb' asParser.
+ islandParser1 := self islandInstance.
+ islandParser1 island: island1.
+
+ island2 := 'cc' asParser.
+ islandParser2 := self islandInstance.
+ islandParser2 island: island2.
+
+ parser := (islandParser1, islandParser2) plus.
+
+ result := islandParser1 parse: '__ aaxx __ cc __'.
+ self assert: result isPetitFailure.
+!
+
+testIslandDetection
+ | island parser |
+ island := 'class' asParser, self identifier trim, 'endclass' asParser.
+ parser := self island: island.
+
+ self assert: parser parse: 'class Foo endclass'.
+ self assert: result size = 3.
+ self assert: result second second = 'Foo'.
+
+ self assert: parser parse: '/*comment*/ class Foo endclass'.
+ self assert: result size = 3.
+ self assert: result second second = 'Foo'.
+
+ self assert: parser parse: '/*comment class Bar */ class Foo endclass'.
+ self assert: result size = 3.
+ self assert: result second second = 'Foo'.
+
+ self assert: parser parse: '/*comment class Bar */ class Foo endclass //something more'.
+ self assert: result size = 3.
+ self assert: result second second = 'Foo'.
+
+ self assert: parser parse: '/*comment class Bar endclass */ class Foo endclass //something more'.
+ self assert: result size = 3.
+ self assert: result second second = 'Bar'.
+!
+
+testIslandPlus
+
+ | island parser |
+ island := self island: 'X' asParser.
+ parser := island plus.
+
+ self assert: parser parse: '....X....'.
+ self assert: result size = 1.
+
+ self assert: parser parse: '...X...X...XX'.
+ self assert: result size = 4.
+
+ self assert: parser fail: '.....'.
+!
+
+testIslandPlus2
+
+ | island parser |
+ island := self island: ('class' asParser, self identifier trim).
+ parser := island plus.
+
+ self assert: parser parse: '....class Foo....'.
+ self assert: result size = 1.
+ self assert: result first second second = 'Foo'.
+
+
+ self assert: parser parse: '....class . class Foo....'.
+ self assert: result size = 1.
+ self assert: result first second second = 'Foo'.
+
+ self assert: parser parse: '....class . class Foo class Bar....'.
+ self assert: result size = 2.
+ self assert: result first second second = 'Foo'.
+ self assert: result second second second = 'Bar'.
+
+
+
+ self assert: parser fail: '.....'.
+!
+
+testIslandSequence
+
+ | parser a b c |
+ "Island sequence will never cross the boundery of 'c'"
+ a := 'a' asParser.
+ b := 'b' asParser.
+ c := 'c' asParser.
+
+ parser := (self island: a), (self island: b), c.
+
+ self assert: parser parse: '..a...b...c'.
+ self assert: parser fail: '..a..c...b..c'.
+ self assert: parser fail: '..c..a.....b..c'.
+!
+
+testIslandSequence2
+ | p a b |
+
+ a := self island: ('a' asParser plus).
+ a name: 'a island'.
+
+ b := self island: 'b' asParser.
+ b name: 'b island'.
+
+ p := a optional, (b / self nilIsland).
+ self assert: p parse: 'a'.
+ self assert: result size = 2.
+ self assert: result first notNil.
+ self assert: result second size = 3.
+ self assert: result second second = nil.
+
+ self assert: p parse: '..ab'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+ self assert: result first notNil.
+ self assert: result second size = 3.
+ self assert: result second second = 'b'.
+
+ self assert: p parse: 'a..b'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+ self assert: result first notNil.
+ self assert: result second size = 3.
+ self assert: result second second = 'b'.
+
+ self assert: p parse: 'ab...'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+ self assert: result first notNil.
+ self assert: result second size = 3.
+ self assert: result second second = 'b'.
+
+ self assert: p parse: '...a...b...'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+ self assert: result first notNil.
+ self assert: result second size = 3.
+ self assert: result second second = 'b'.
+
+ self assert: p parse: '...a...b...'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+ self assert: result first notNil.
+ self assert: result second size = 3.
+ self assert: result second second = 'b'.
+
+ self assert: p end parse: '...b...'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+ self assert: result first isNil.
+ self assert: result second size = 3.
+ self assert: result second second = 'b'.
+!
+
+testIslandSequence3
+
+ | parser body class extends |
+ class := self island: 'class' asParser trim, self identifier trim.
+ extends := self island: 'extends' asParser trim, self identifier trim.
+ body := self island: self nestedBlock.
+
+ parser := (class, extends optional, body) plus.
+ self assert: parser parse: '
+ /* lorem ipsum */
+ class Foo { whatever }
+
+ // something more
+ class Bar extends Zorg { blah blah bla }
+ // this is the end'.
+
+ self assert: result isPetitFailure not.
+ self assert: result size = 2.
+!
+
+testIslandStar
+ | p |
+
+
+ p := (self island: 'a' asParser) star, 'b' asParser.
+ self assert: p parse: 'b'.
+ self assert: result size = 2.
+ self assert: result first size = 0.
+
+ self assert: p parse: 'ab'.
+ self assert: result size = 2.
+ self assert: result first size = 1.
+
+ self assert: p parse: 'aab'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...aab'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...aa...b'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...a...a...b'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...a...a...aa...b'.
+ self assert: result size = 2.
+ self assert: result first size = 4.
+
+ "Thats the question, if I want this:"
+ self assert: p fail: '...b'.
+!
+
+testIslandStar2
+ | p |
+
+
+ p := (self island: 'a' asParser) star, 'b' asParser optional.
+ self assert: p parse: 'aa'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '....aa'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...a...a...'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...a...a...b'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+ self assert: result second = 'b'.
+!
+
+testIslandStar3
+ | p |
+
+
+ p := (self island: 'a' asParser) star, (self island: nil asParser).
+
+ self assert: p parse: '....'.
+ self assert: result size = 2.
+ self assert: result first size = 0.
+
+ self assert: p parse: 'aa'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '....aa'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...a...a...'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+
+ self assert: p parse: '...a...a...b'.
+ self assert: result size = 2.
+ self assert: result first size = 2.
+ self assert: result second second = nil.
+!
+
+testNestedIsland
+
+ | nestedIsland before after topIsland |
+ nestedIsland := self island: 'X' asParser.
+
+ before := 'before' asParser.
+ after := 'after' asParser.
+ topIsland := self island: (before, nestedIsland, after).
+
+ self assert: nestedIsland parse: 'before...X...ater'.
+ self assert: topIsland parse: 'beforeXafter'.
+
+ self assert: topIsland parse: '....before..X..after....'.
+ self assert: result size = 3.
+ self assert: result second size = 3.
+ self assert: result second second size = 3.
+ self assert: result second second second = 'X'.
+
+ self assert: topIsland parse: '....X....before...X....after'.
+ self assert: topIsland parse: '....before.......after....before..X...after'.
+
+ self assert: topIsland fail: '....before.......after...'.
+ self assert: topIsland fail: '....before.......after...X'.
+ self assert: topIsland fail: '....before.......after...X...after'.
+!
+
+testNilIsland
+
+ | nilIsland p |
+
+ nilIsland := self nilIsland.
+
+
+ p := ${ asParser, nilIsland, $} asParser.
+
+ self assert: p parse: '{}'.
+
+ self assert: result isCollection.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result third = $}.
+
+
+ self assert: p parse: '{ }'.
+ self assert: result isCollection.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result third = $}.
+
+
+ self assert: p parse: '{ ... }'.
+ self assert: result isCollection.
+ self assert: result size = 3.
+ self assert: result first = ${.
+ self assert: result third = $}.
+!
+
+testOptionalIsland
+
+ | island parser |
+
+ island := self island: ('a' asParser / 'b' asParser optional).
+ parser := island, 'c' asParser.
+
+ self assert: parser parse: '....a....b...c'.
+ self assert: result first second = 'a'.
+ self assert: result second = 'c'.
+
+ self assert: parser parse: '....d....b...c'.
+ self assert: result first second = 'b'.
+ self assert: result second = 'c'.
+
+ self assert: parser parse: '....d....d...c'.
+ self assert: result first second = nil.
+ self assert: result second = 'c'.
+
+ self assert: parser parse: '...c'.
+! !
+
+!PPIslandTest methodsFor:'tests - complex'!
+
+testClass
+ | text file class |
+ text := '
+// some comment
+namespace cde {
+
+public class Foo
+endclass
+
+public class 123 // invalid class
+public struct {}
+
+class bar endclass
+class Zorg endclass
+}
+ '.
+
+ class := ('public' asParser trim optional, 'class' asParser trim, self identifier, 'endclass' asParser trim)
+ ==> [:t | t third] .
+ file := ((self island: class) ==> [:t | t second ]) plus.
+
+ result := file parse: text.
+ self assert: result size = 3.
+ self assert: result first = 'Foo'.
+ self assert: result second = 'bar'.
+ self assert: result third = 'Zorg'.
+!
+
+testFile
+ | text using imports class file |
+ text := '
+
+using a.b.c;
+using c.d.e;
+// some comment
+namespace cde {
+
+public class Foo
+endclass
+
+public class 123 // invalid class
+public struct {}
+
+class bar endclass
+}
+ '.
+
+ using := 'using' asParser trim, (self identifier, ('.' asParser, self identifier) star) flatten ==> [:t | t second].
+
+ imports := (self island: using) star.
+
+ class := ('public' asParser trim optional, 'class' asParser trim, self identifier, 'endclass' asParser trim)
+ ==> [:t | t third] .
+ file := imports, ((self island: class) ==> [:t | t second ]) plus.
+
+ result := file parse: text.
+
+ self assert: result isPetitFailure not.
+!
+
+testFile2
+ | text using imports class file |
+ text := '
+
+using a.b.c;
+using c.d.e;
+// some comment
+namespace cde {
+
+class Foo
+endclass
+
+public class 123 // invalid class
+public struct {}
+
+class bar endclass
+}
+ '.
+
+ using := 'using' asParser trim, (self identifier, ('.' asParser, self identifier) star) flatten ==> [:t | t second].
+
+ imports := (self island: using) star.
+
+ class := ('public' asParser trim optional, 'class' asParser trim, self identifier, 'endclass' asParser trim)
+ ==> [:t | t third] .
+ file := imports, ((self island: class) ==> [:t | t second ]) plus.
+
+ result := file parse: text.
+
+ self assert: result isPetitFailure not.
+!
+
+testImports
+ | text using imports |
+ text := '
+
+/** whatever */
+using a.b.c;
+// another comment
+using c.d.e;
+// some comment
+namespace cde {
+}
+ '.
+
+ using := 'using' asParser trim, (self identifier, ('.' asParser, self identifier) star) flatten ==> [:t | t second].
+ imports := ((self island: using) ==> [:t | t second ]) star.
+
+ result := imports parse: text.
+
+ self assert: result size = 2.
+ self assert: result first = 'a.b.c'.
+ self assert: result second = 'c.d.e'.
+! !
+
+!PPIslandTest methodsFor:'tests - water objects'!
+
+multilineCommentParser
+ ^ '/*' asParser, (#any asParser starLazy: '*/' asParser), '*/' asParser.
+!
+
+singleCommentParser
+ | nl |
+ nl := #newline asParser.
+ ^ '//' asParser, (#any asParser starLazy: nl), nl.
+!
+
+testMultilineComment
+ | parser |
+ parser := self multilineCommentParser.
+
+ self assert: parser parse: '/* hello there */'.
+ self assert: parser parse: '/* class Bar endclass */'.
+!
+
+testWaterObjects
+ | parser |
+ context := PPContext new.
+ parser := (self island: ('class' asParser, self identifier trim, 'endclass' asParser ==> #second)) star.
+
+ self assert: parser parse: ' /* hello there */ class Foo endclass'.
+ self assert: result size = 1.
+ self assert: result first second = 'Foo'.
+
+ context := PPContext new.
+ self assert: parser parse: ' /* class Bar endclass */ class Foo endclass'.
+ self assert: result size = 2.
+ self assert: result first second = 'Bar'.
+ self assert: result second second = 'Foo'.
+
+ context := PPContext new.
+ parser := (self island: ('class' asParser, self identifier trim, 'endclass' asParser ==> #second) water: self multilineCommentParser / #any asParser) star.
+
+ self assert: parser parse: ' /* class Bar endclass */ class Foo endclass'.
+ self assert: result size = 1.
+ self assert: result first second = 'Foo'.
+!
+
+testWaterObjects2
+ | parser source |
+ context := PPContext new.
+
+ parser := (self island: ('class' asParser, self identifier trim, 'endclass' asParser ==> #second)
+ water: self multilineCommentParser / self singleCommentParser / #any asParser) star.
+
+ source := ' /* class Bar endclass */
+ class Foo
+ endclass
+ /*
+ class Borg
+ endclass
+ */
+ // class Qwark endclass
+ class Zorg
+ endclass
+ '.
+
+ self assert: parser parse: source.
+ self assert: result size = 2.
+ self assert: result first second = 'Foo'.
+ self assert: result second second = 'Zorg'.
+! !
+