SystemOrganization addCategory: #'PetitRegex-Core'! SystemOrganization addCategory: #'PetitRegex-Tests'! PPCompositeParser subclass: #PPRegexParser instanceVariableNames: 'regex atom anyAtom beginOfLineAtom endOfLineAtom characterAtom rangePieceSpec number groupAtom escapeAtom characterGroup quantifier characterSet characterSetClass characterSetEscape characterSetRange characterSetCharacter predicateAtom' classVariableNames: 'ClassMap EscapeMap' poolDictionaries: '' category: 'PetitRegex-Core'! !PPRegexParser class methodsFor: 'private' stamp: 'lr 5/2/2010 21:37'! atBeginOfWord: aStream ^ (self isWordChar: (self lastCharIn: aStream)) not and: [ self isWordChar: aStream peek ]! ! !PPRegexParser class methodsFor: 'private' stamp: 'lr 5/2/2010 21:36'! atEndOfWord: aStream ^ (self isWordChar: (self lastCharIn: aStream)) and: [ (self isWordChar: aStream peek) not ]! ! !PPRegexParser class methodsFor: 'private' stamp: 'lr 5/2/2010 21:38'! atWordBoundary: aStream ^ (self isWordChar: (self lastCharIn: aStream)) xor: (self isWordChar: aStream peek)! ! !PPRegexParser class methodsFor: 'private' stamp: 'lr 5/5/2010 14:06'! condition: aBlock message: aString ^ [ :stream | (aBlock value: stream) ifFalse: [ PPFailure message: aString at: stream position ] ] asParser! ! !PPRegexParser class methodsFor: 'initialization' stamp: 'lr 5/2/2010 21:04'! initialize self initializeClassMap. self initializeEscapeMap! ! !PPRegexParser class methodsFor: 'initialization' stamp: 'lr 5/2/2010 21:03'! initializeClassMap ClassMap := Dictionary new. ClassMap at: 'alnum' put: #word asParser; at: 'alpha' put: #letter asParser; at: 'cntrl' put: #control asParser; at: 'digit' put: #digit asParser; at: 'graph' put: #control asParser negate; at: 'lower' put: #lowercase asParser; at: 'print' put: #control asParser negate; at: 'punct' put: #punctuation asParser; at: 'space' put: #space asParser; at: 'upper' put: #uppercase asParser; at: 'xdigit' put: #hex asParser! ! !PPRegexParser class methodsFor: 'initialization' stamp: 'lr 4/18/2011 19:36'! initializeEscapeMap EscapeMap := Dictionary new. EscapeMap "only at beginning of string" at: $A put: (self condition: [ :stream | stream position = 0 ] message: 'beginning of input expected'); "only at end of string" at: $Z put: (self condition: [ :stream | stream atEnd ] message: 'end of input expected'); "an empty string at a word boundary" at: $b put: (self condition: [ :stream | self atWordBoundary: stream ] message: 'word boundary expected'); "an empty string not at a word boundary" at: $B put: (self condition: [ :stream | (self atWordBoundary: stream) not ] message: 'no word boundary expected'); "an empty string at the beginning of a word" at: $< put: (self condition: [ :stream | self atBeginOfWord: stream ] message: 'beginning of word expected'); "an empty string at the end of a word" at: $> put: (self condition: [ :stream | self atEndOfWord: stream ] message: 'end of word expected'); "newline" at: $n put: Character lf asParser; "carriage return" at: $r put: Character cr asParser; "tab" at: $t put: Character tab asParser; "digit" at: $d put: #digit asParser; "not digit" at: $D put: #digit asParser negate; "word" at: $w put: #word asParser / $_ asParser; "not word" at: $W put: #word asParser negate; "whitespace" at: $s put: #space asParser; "not whitespace" at: $S put: #space asParser negate; "backslash" at: $\ put: $\ asParser! ! !PPRegexParser class methodsFor: 'private' stamp: 'lr 5/2/2010 21:35'! isWordChar: aCharacterOrNil ^ aCharacterOrNil ~~ nil and: [ aCharacterOrNil isAlphaNumeric ]! ! !PPRegexParser class methodsFor: 'private' stamp: 'lr 5/2/2010 21:34'! lastCharIn: aStream ^ aStream position = 0 ifFalse: [ aStream skip: -1; next ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 4/18/2011 19:59'! anyAtom ^ $. asParser map: [ :char | (PPPredicateObjectParser char: (Character value: 0)) negate ]! ! !PPRegexParser methodsFor: 'grammar' stamp: 'lr 4/18/2011 19:44'! atom ^ escapeAtom / anyAtom / beginOfLineAtom / endOfLineAtom / characterGroup / groupAtom / predicateAtom / characterAtom! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 5/5/2010 14:06'! beginOfLineAtom ^ $^ asParser map: [ :char | [ :stream | (stream position = 0 or: [ (stream skip: -1; next) = Character cr ]) ifFalse: [ PPFailure message: '^ not expected' at: stream position ] ] asParser ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 4/18/2011 22:54'! characterAtom ^(PPPredicateObjectParser anyOf: '[|()*+?\') negate map: [ :char | char asParser ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 4/18/2011 21:24'! characterGroup ^ [ :stream | stream position ] asParser , $[ asParser , $^ asParser optional , $- asParser optional , characterSet star , $- asParser optional , $] asParser map: [ :pos :open :negate :opend :parsers :closed :close | | result | result := parsers inject: PPChoiceParser new into: [ :each :other | each / other ]. (opend notNil or: [ closed notNil ]) ifTrue: [ result := $- asParser / result ]. result children isEmpty ifTrue: [ PPFailure message: 'Empty character set' at: pos ] ifFalse: [ result children size = 1 ifTrue: [ result := result children first ]. negate isNil ifTrue: [ result ] ifFalse: [ result negate ] ] ]! ! !PPRegexParser methodsFor: 'grammar-characters' stamp: 'lr 5/5/2010 14:24'! characterSet ^ characterSetClass / characterSetEscape / characterSetRange / characterSetCharacter! ! !PPRegexParser methodsFor: 'grammar-characters' stamp: 'lr 4/18/2011 20:12'! characterSetCharacter ^ (PPPredicateObjectParser anyOf: '-]') negate map: [ :char | char asParser ]! ! !PPRegexParser methodsFor: 'grammar-characters' stamp: 'lr 4/18/2011 20:44'! characterSetClass ^ [ :stream | stream position ] asParser , '[:' asParser , #word asParser star flatten , ':]' asParser map: [ :pos :open :class :close | ClassMap at: class ifAbsent: [ PPFailure message: 'Invalid character class [:' , class , ':]' at: pos ] ]! ! !PPRegexParser methodsFor: 'grammar-characters' stamp: 'lr 5/5/2010 14:26'! characterSetEscape ^ escapeAtom! ! !PPRegexParser methodsFor: 'grammar-characters' stamp: 'lr 4/18/2011 20:45'! characterSetRange ^ [ :stream | stream position ] asParser , #any asParser , $- asParser , $] asParser negate map: [ :pos :start :sep :stop | start < stop ifTrue: [ PPPredicateObjectParser between: start and: stop ] ifFalse: [ PPFailure message: 'Invalid character range: ' , (String with: start with: $- with: stop) at: pos ] ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 5/5/2010 14:06'! endOfLineAtom ^ $$ asParser map: [ :char | [ :stream | (stream atEnd or: [ stream peek = Character cr ]) ifFalse: [ PPFailure message: '$ not expected' at: stream position ] ] asParser ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/8/2010 08:43'! escapeAtom ^ $\ asParser , #any asParser map: [ :escape :char | EscapeMap at: char ifAbsent: [ char asParser ] ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/8/2010 00:11'! groupAtom ^ $( asParser , regex , $) asParser ==> #second! ! !PPRegexParser methodsFor: 'other' stamp: 'lr 2/8/2010 19:25'! number ^ #digit asParser plus flatten ==> [ :token | token asInteger ]! ! !PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 4/18/2011 19:33'! oneOrMorePiece "+ 1 or more times" ^ $+ asParser , quantifier map: [ :op :qu | qu setMin: 1 ]! ! !PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 4/18/2011 19:54'! predicateAtom ^ $: asParser , $^ asParser optional , #word asParser plus flatten , $: asParser map: [ :begin :negated :selector :end | | result | result := PPPredicateObjectParser on: (PPCharSetPredicate on: [ :char | char perform: selector asSymbol ]) message: selector printString , ' expected'. negated isNil ifFalse: [ result := result negated ]. result ]! ! !PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 4/18/2011 19:32'! quantifier ^ ($+ asParser ==> [ :node | PPPossessiveRepeatingParser new ]) / ($? asParser ==> [ :node | PPLazyRepeatingParser new setLimit: nil asParser end ]) / (nil asParser ==> [ :node | PPGreedyRepeatingParser new setLimit: nil asParser end ])! ! !PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 4/18/2011 19:33'! rangePiece ^ ${ asParser , rangePieceSpec , $} asParser , quantifier map: [ :op :ra :cl :qu | qu setMin: ra first; setMax: ra last ]! ! !PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 3/1/2010 16:31'! rangePieceSpec "{n,m} at least n but not more than m times {n,} at least n times {n} exactly n times" ^ number optional , $, asParser optional , number optional map: [ :n :op :m | (n ifNil: [ 0 ]) to: (m ifNil: [ SmallInteger maxVal ]) ]! ! !PPRegexParser methodsFor: 'grammar' stamp: 'lr 4/18/2011 22:50'! regex ^ PPExpressionParser new term: atom; group: [ :g |. g postfix: self zeroOrOnePiece do: [ :at :op | op setParser: at ]. g postfix: self zeroOrMorePiece do: [ :at :op | op setParser: at ]. g postfix: self oneOrMorePiece do: [ :at :op | op setParser: at ]. g postfix: self rangePiece do: [ :at :op | op setParser: at ] ]; group: [ :g | g left: nil do: [ :left :op :right | left , right ] ]; group: [ :g | g left: $| do: [ :left :op :right | left / right ] ]; yourself! ! !PPRegexParser methodsFor: 'private' stamp: 'lr 4/18/2011 19:38'! resolveStubs: aParser "In this post-processing step we need to fix the quantifiers." aParser followSets keysAndValuesDo: [ :start :follow | (start isKindOf: PPLimitedRepeatingParser) ifTrue: [ | limit | limit := follow collect: [ :each | each isNil ifTrue: [ nil asParser end ] ifFalse: [ each ] ]. start setLimit: (limit size = 1 ifTrue: [ limit anyOne ] ifFalse: [ PPChoiceParser withAll: limit ]) ] ]. ^ aParser! ! !PPRegexParser methodsFor: 'accessing' stamp: 'lr 3/1/2010 16:17'! start ^ regex end ==> [ :node | self resolveStubs: node ]! ! !PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 4/18/2011 19:33'! zeroOrMorePiece "* 0 or more times" ^ $* asParser , quantifier map: [ :op :qu | qu ]! ! !PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 4/18/2011 19:33'! zeroOrOnePiece "? 0 or 1 times" ^ $? asParser , quantifier map: [ :op :qu | qu setMax: 1 ]! ! PPDelegateParser subclass: #PPRegexMatcher instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitRegex-Core'! !PPRegexMatcher class methodsFor: 'instance creation' stamp: 'lr 8/30/2010 14:44'! for: aParser ^ self on: aParser! ! !PPRegexMatcher class methodsFor: 'instance creation' stamp: 'lr 8/30/2010 14:45'! for: aParser ignoringCase: aBoolean ^ self on: aParser! ! !PPRegexMatcher class methodsFor: 'instance creation' stamp: 'lr 8/30/2010 14:45'! forString: aString ^ self for: (PPRegexParser parse: aString)! ! !PPRegexMatcher class methodsFor: 'instance creation' stamp: 'lr 8/30/2010 14:45'! forString: aString ignoreCase: aBoolean ^ self for: (PPRegexParser parse: aString) ignoringCase: aBoolean! ! !PPRegexMatcher methodsFor: 'execution' stamp: 'lr 8/30/2010 13:51'! search: aString ^ self searchOn: aString asPetitStream! ! !PPRegexMatcher methodsFor: 'execution' stamp: 'lr 8/30/2010 13:55'! searchOn: aStream | position result | position := aStream position. [ aStream atEnd ] whileFalse: [ (self parseOn: aStream) isPetitFailure ifFalse: [ ^ true ]. aStream position: (position := position + 1) ]. ^ false! ! !PPPredicateObjectParser class methodsFor: '*petitregex-chars' stamp: 'lr 8/30/2010 14:48'! control ^ self chars: ((0 to: 31) collect: [ :each | Character value: each ]) message: 'control character expected'! ! TestCase subclass: #PPRegexTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitRegex-Tests'! !PPRegexTest class methodsFor: 'accessing' stamp: 'lr 2/8/2010 10:14'! packageNamesUnderTest ^ #('PetitRegex')! ! !PPRegexTest methodsFor: 'utilties' stamp: 'lr 4/18/2011 20:36'! compileRegex: aString "Compile the regex and answer the matcher, or answer nil if compilation fails." ^ self parserClass parse: aString onError: [ nil ]! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! henryReadme self error: 'The tests in this category are based on the ones in Henry Spencer''s regexp.c package.'! ! !PPRegexTest methodsFor: 'accessing' stamp: 'lr 8/30/2010 14:41'! matcherClass ^ PPRegexMatcher! ! !PPRegexTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 00:46'! parserClass ^ PPRegexParser! ! !PPRegexTest methodsFor: 'utilties' stamp: 'lr 6/4/2010 14:53'! runMatcher: aParser with: aString expect: aBoolean withSubexpressions: anArray | got | "copy := aParser copy: aString translatingMatchesUsing: [ :each | each ]. self assert: copy = aString description: 'Copying: expected ' , aString printString , ', but got ' , copy printString." got := aParser matchesIn: aString. self assert: got notEmpty = aBoolean description: 'Searching: expected ' , aBoolean printString , ', but got ' , got printString. "(anArray isNil or: [ aParser supportsSubexpressions not ]) ifTrue: [ ^ self ]. 1 to: anArray size by: 2 do: [ :index | | sub subExpect subGot | sub := anArray at: index. subExpect := anArray at: index + 1. subGot := aParser subexpression: sub. self assert: subExpect = subGot description: 'Subexpression ' , sub printString , ': expected ' , subExpect printString , ', but got ' , subGot printString ]"! ! !PPRegexTest methodsFor: 'utilties' stamp: 'lr 2/8/2010 00:52'! runRegex: anArray "Run a clause anArray against a set of tests. Each clause is an array with a regex source string followed by sequence of 3-tuples. Each three-element group is one test to try against the regex, and includes: 1) test string; 2) expected result; 3) expected subexpression as an array of (index, substring), or nil." | source matcher | source := anArray first. matcher := self compileRegex: source. matcher isNil ifTrue: [ (anArray at: 2) isNil ifFalse: [ self signalFailure: 'Compilation failed, should have succeeded: ' , source printString ] ] ifFalse: [ (anArray at: 2) isNil ifTrue: [ self signalFailure: 'Compilation succeeded, should have failed: ' , source printString ] ifFalse: [ 2 to: anArray size by: 3 do: [ :index | self runMatcher: matcher with: (anArray at: index) expect: (anArray at: index + 1) withSubexpressions: (anArray at: index + 2) ] ] ]! ! !PPRegexTest methodsFor: 'testing-protocol' stamp: 'lr 8/30/2010 14:41'! testCaseInsensitive | matcher | matcher := self matcherClass forString: 'the quick brown fox' ignoreCase: true. self assert: (matcher search: 'the quick brown fox'). self assert: (matcher search: 'The quick brown FOX'). self assert: (matcher search: 'What do you know about the quick brown fox?'). self assert: (matcher search: 'What do you know about THE QUICK BROWN FOX?')! ! !PPRegexTest methodsFor: 'testing-protocol' stamp: 'lr 8/30/2010 14:41'! testCaseSensitive | matcher | matcher := self matcherClass forString: 'the quick brown fox' ignoreCase: false. self assert: (matcher search: 'the quick brown fox'). self deny: (matcher search: 'The quick brown FOX'). self assert: (matcher search: 'What do you know about the quick brown fox?'). self deny: (matcher search: 'What do you know about THE QUICK BROWN FOX?')! ! !PPRegexTest methodsFor: 'testing-protocol' stamp: 'lr 8/30/2010 14:41'! testCopyReplacingMatches "See that the match context is preserved while copying stuff between matches:" | matcher | matcher := self matcherClass forString: '\<\d\D+'. self assert: (matcher copy: '9aaa1bbb 8ccc' replacingMatchesWith: 'foo') = 'foo1bbb foo'! ! !PPRegexTest methodsFor: 'testing-protocol' stamp: 'lr 8/30/2010 14:41'! testCopyTranslatingMatches | matcher | matcher := self matcherClass forString: '\w+'. self assert: (matcher copy: 'now is the time ' translatingMatchesUsing: [ :each | each reverse ]) = 'won si eht emit '! ! !PPRegexTest methodsFor: 'testing-empty' stamp: 'lr 8/30/2010 14:41'! testEmptyStringAtBeginningOfLine | matcher | matcher := self matcherClass forString: '^'. self assert: (matcher copy: 'foo1 bar1' , String cr , 'foo2 bar2' replacingMatchesWith: '*') = ('*foo1 bar1' , String cr , '*foo2 bar2') description: 'An empty string at the beginning of a line'! ! !PPRegexTest methodsFor: 'testing-empty' stamp: 'lr 8/30/2010 14:41'! testEmptyStringAtBeginningOfWord | matcher | matcher := self matcherClass forString: '\<'. self assert: (matcher copy: 'foo bar' replacingMatchesWith: '*') = '*foo *bar' description: 'An empty string at the beginning of a word'! ! !PPRegexTest methodsFor: 'testing-empty' stamp: 'lr 8/30/2010 14:41'! testEmptyStringAtEndOfLine | matcher | matcher := self matcherClass forString: '$'. self assert: (matcher copy: 'foo1 bar1' , String cr , 'foo2 bar2' replacingMatchesWith: '*') = ('foo1 bar1*', String cr , 'foo2 bar2*') description: 'An empty string at the end of a line'! ! !PPRegexTest methodsFor: 'testing-empty' stamp: 'lr 8/30/2010 14:41'! testEmptyStringAtEndOfWord | matcher | matcher := self matcherClass forString: '\>'. self assert: (matcher copy: 'foo bar' replacingMatchesWith: '*') = 'foo* bar*' description: 'An empty string at the end of a word'! ! !PPRegexTest methodsFor: 'testing-empty' stamp: 'lr 8/30/2010 14:41'! testEmptyStringAtWordBoundary | matcher | matcher := self matcherClass forString: '\b'. self assert: (matcher copy: 'foo bar' replacingMatchesWith: '*') = '*foo* *bar*' description: 'An empty string at a word boundary'! ! !PPRegexTest methodsFor: 'testing-empty' stamp: 'lr 8/30/2010 14:41'! testEmptyStringNotAtWordBoundary | matcher | matcher := self matcherClass forString: '\B'. self assert: (matcher copy: 'foo bar' replacingMatchesWith: '*') = 'f*o*o b*a*r' description: 'An empty string not at a word boundary'! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry001 self runRegex: #('abc' 'abc' true (1 'abc') 'xbc' false nil 'axc' false nil 'abx' false nil 'xabcy' true (1 'abc') 'ababc' true (1 'abc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry002 self runRegex: #('ab*c' 'abc' true (1 'abc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry003 self runRegex: #('ab*bc' 'abc' true (1 'abc') 'abbc' true (1 'abbc') 'abbbbc' true (1 'abbbbc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry004 self runRegex: #('ab+bc' 'abbc' true (1 'abbc') 'abc' false nil 'abq' false nil 'abbbbc' true (1 'abbbbc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry005 self runRegex: #('ab?bc' 'abbc' true (1 'abbc') 'abc' true (1 'abc') 'abbbbc' false nil 'abc' true (1 'abc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry006 self runRegex: #('^abc$' 'abc' true (1 'abc') 'abcc' false nil 'aabc' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry007 self runRegex: #('^abc' 'abcc' true (1 'abc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry008 self runRegex: #('abc$' 'aabc' true (1 'abc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry009 self runRegex: #('^' 'abc' true nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry010 self runRegex: #('$' 'abc' true nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry011 self runRegex: #('a.c' 'abc' true (1 'abc') 'axc' true (1 'axc'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry012 "Need to get creative to include the null character..." self runRegex: #('a.*c' 'axyzc' true (1 'axyzc') 'axy zc' true (1 'axy zc') "testing that a dot matches a space" ), (Array with: 'axy', (String with: 0 asCharacter), 'zc'), #(false nil "testing that a dot does not match a null" 'axyzd' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry013 self runRegex: #('.a.*' '1234abc' true (1 '4abc') 'abcd' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry014 self runRegex: #('a\w+c' ' abbbbc ' true (1 'abbbbc') 'abb bc' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry015 self runRegex: #('\w+' ' foobar quux' true (1 'foobar') ' ~!!@#$%^&*()-+=\|/?.>,<' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry016 self runRegex: #('a\W+c' 'a c' true (1 'a c') 'a bc' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry017 self runRegex: #('\W+' 'foo!!@#$bar' true (1 '!!@#$') 'foobar' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry018 self runRegex: #('a\s*c' 'a c' true (1 'a c') 'a bc' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry019 self runRegex: #('\s+' 'abc3457 sd' true (1 ' ') '1234$^*^&asdfb' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry020 self runRegex: #('a\S*c' 'aqwertyc' true (1 'aqwertyc') 'ab c' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry021 self runRegex: #('\S+' ' asdf ' true (1 'asdf') ' ' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry022 self runRegex: #('a\d+c' 'a0123456789c' true (1 'a0123456789c') 'a12b34c' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry023 self runRegex: #('\d+' 'foo@#$%123ASD #$$%^&' true (1 '123') 'foo!!@#$asdfl;' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry024 self runRegex: #('a\D+c' 'aqwertyc' true (1 'aqwertyc') 'aqw6ertc' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry025 self runRegex: #('\D+' '1234 abc 456' true (1 ' abc ') '1234567890' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry026 self runRegex: #('(f|o)+\b' 'foo' true (1 'foo') ' foo ' true (1 'foo'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry027 self runRegex: #('\ba\w+' "a word beginning with an A" 'land ancient' true (1 'ancient') 'antique vase' true (1 'antique') 'goofy foobar' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry028 self runRegex: #('(f|o)+\B' 'quuxfoobar' true (1 'foo') 'quuxfoo ' true (1 'fo'))! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry029 self runRegex: #('\Ba\w+' "a word with an A in the middle, match at A and further" 'land ancient' true (1 'and') 'antique vase' true (1 'ase') 'smalltalk shall overcome' true (1 'alltalk') 'foonix is better' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry030 self runRegex: #('fooa\>.*' 'fooa ' true nil 'fooa123' false nil 'fooa bar' true nil 'fooa' true nil 'fooargh' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry031 self runRegex: #('\>.+abc' ' abcde fg' false nil 'foo abcde' true (1 ' abc') 'abcde' false nil)! ! !PPRegexTest methodsFor: 'testing-henry' stamp: 'lr 8/30/2010 14:41'! testHenry032 self runRegex: #('\