"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#RxTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-Collections-Utilities'

!

!RxTests class methodsFor:'documentation'!

documentation

"

    regex tests.

"

! !

!RxTests methodsFor:'helper'!

compileRegex: aString

        "Compile the regex and answer the matcher, or answer nil if compilation fails."

        | syntaxTree |

        syntaxTree := Regex::RxParser safelyParse: aString.

        ^ syntaxTree ifNotNil: [ self matcherClass for: syntaxTree ]

!

compileRegex: regexSource into: matcherClass

        "Compile the regex and answer the matcher, or answer nil if compilation fails."

        | syntaxTree |

        "/ ^ Regex::RxMatcher2 forString: regexSource.

        syntaxTree := Regex::RxParser "self matcherClass" safelyParse: regexSource.

        syntaxTree == nil ifTrue: [^nil].

        ^matcherClass for: syntaxTree

    "Modified: / 31-07-2019 / 11:48:08 / Stefan Reise"

!

matcherClass

    ^ Regex::RxMatcher

!

runMatcher: aMatcher with: aString expect: aBoolean withSubexpressions: anArray

        | copy got sub subExpect subGot |

        copy := aMatcher

                copy: aString

                translatingMatchesUsing: [ :each | each ].

        self 

                assert: copy = aString

                description: 'Copying: expected ' , aString printString , ', but got ' , copy printString.

        got := aMatcher search: aString.

        self

                assert: got = aBoolean 

                description: 'Searching: expected ' , aBoolean printString , ', but got ' , got printString.

        (anArray isNil or: [ aMatcher supportsSubexpressions not ])

                ifTrue: [ ^ self ].

        1 to: anArray size by: 2 do: [ :index |

                sub := anArray at: index.

                subExpect := anArray at: index + 1.

                subGot := aMatcher subexpression: sub.

                self

                        assert: subExpect = subGot

                        description: 'Subexpression ' , sub printString , ': expected ' , subExpect printString , ', but got ' , subGot storeString ]

!

runProtocolTestsForMatcher: matcherClass

	| matcher |

	Transcript show: 'Testing matcher protocol...'.

	matcher := matcherClass forString: '\w+'.

	(matcher matchesIn: 'now is the time') asArray = #('now' 'is' 'the' 'time')

		ifFalse: [self error: 'matchesIn: test failed'].

	(matcher copy: 'now is  the   time    ' translatingMatchesUsing: [:s | s reverse])

		= 'won si  eht   emit    '

		ifFalse: [self error: 'copy:translatingMatchesWith: test failed'].

	"See that the match context is preserved while copying stuff between matches:"

	((matcherClass forString: '\<\d\D+')

		copy: '9aaa1bbb 8ccc'

		replacingMatchesWith: 'foo') = 'foo1bbb foo'

			ifFalse: [self error: 'test failed'].

	Transcript show: 'OK'; cr

!

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

                ifNil: [ ( anArray at: 2 )

                                ifNotNil: [ self signalFailure: 'Compilation failed, should have succeeded: ' , source printString ]

                        ]

                ifNotNil: [ ( anArray at: 2 )

                                ifNil: [ self signalFailure: 'Compilation succeeded, should have failed: ' , source printString ]

                                ifNotNil: [ 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 )

                                                ]

                                        ]

                        ]

!

runRegexTestsForMatcher: matcherClass

        "Run the whole suite of tests for the given matcher class. May blow up

        if anything goes wrong with the matcher or parser. Since this is a

        developer's tool, who cares?"

        "self new runRegexTestsForMatcher: Regex::RxMatcher"

        | failures |

        failures := 0.

        Transcript cr.

        self xtestSuite do: [:clause |

                | rxSource matcher isOK |

                rxSource := clause first.

                Transcript show: 'Testing regex: '; show: rxSource printString; cr.

                matcher := self compileRegex: rxSource into: matcherClass.

                matcher == nil

                        ifTrue:

                                [(clause at: 2) isNil

                                        ifTrue:

                                                [Transcript tab; show: 'Compilation error as expected (ok)'; cr]

                                        ifFalse:

                                                [Transcript tab;

                                                        show: 'Compilation error, UNEXPECTED -- FAILED'; cr.

                                                failures := failures + 1]]

                        ifFalse:

                                [(clause at: 2) == nil

                                        ifTrue:

                                                [Transcript tab;

                                                        show: 'Compilation succeeded, should have failed -- FAILED!!';

                                                        cr.

                                                failures := failures + 1]

                                        ifFalse:

                                                [2 to: clause size by: 3 do:

                                                        [:i |

                                                        isOK := self

                                                                xtest: matcher

                                                                with: (clause at: i)

                                                                expect: (clause at: i + 1)

                                                                withSubexpressions: (clause at: i + 2).

                                                        isOK ifFalse: [failures := failures + 1].

                                                        Transcript

                                                                show: (isOK ifTrue: [' (ok).'] ifFalse: [' -- FAILED!!']);

                                                                cr]]]].

        failures = 0

                ifTrue: [Transcript show: 'PASSED ALL TESTS.'; cr]

                ifFalse: [Transcript show: failures printString, ' TESTS FAILED!!'; cr]

!

runTestsForMatcher: matcherClass

        "Run the whole suite of tests for the given matcher class. May blow up

        if something goes wrong with the matcher or the parser. Since this is a

        developer's tool, who cares?"

        "self new runTestsForMatcher: Regex::RxMatcher"

        self

                runRegexTestsForMatcher: matcherClass;

                runProtocolTestsForMatcher: matcherClass

! !

!RxTests methodsFor:'profiling'!

bigHonkingStream

    ^ '~/Documents/Pharo/images/Pharo 8.0 - 64bit (development version, latest)/Pharo8.0-32bit-3a0b722.sources' asFilename readStream "38Mb"

"/    ^ '~/Downloads/smalltalk/Pharo6.1-64.app/Contents/MacOS/PharoV60.sources' asFilename readStream "36Mb"

"/    ^'/home/vassili/VisualWorks/image/visualnc.sou' asFilename readStream "7 Megs"

    "Modified: / 04-06-2019 / 10:52:51 / Claus Gittinger"

!

frequentMatchProfile

	"

	TimeProfiler profile: [self frequentMatchProfile]

	Time millisecondsToRun: [self frequentMatchProfile]

	"

	| stream matcher count |

	stream := self bigHonkingStream.

	count := 0.

	matcher := '\<\w+' asRegex.

	[

		[matcher searchStream: stream] whileTrue: [count := count + 1].

	]

	valueNowOrOnUnwindDo: [stream close].

	^count

!

rareMatchProfile

        "                          o:Regex::RxMatcher

        TimeProfiler profile: [self new rareMatchProfile]

        Time millisecondsToRun: [self new rareMatchProfile] -> 22760         

        "

        | stream matcher count |

        stream := self bigHonkingStream.

        count := 0.

        matcher := 'foo' asRegex.

        [

                [matcher searchStream: stream] whileTrue: [count := count + 1].

        ]

        valueNowOrOnUnwindDo: [stream close].

        ^count

    "Modified (comment): / 04-06-2019 / 10:54:16 / Claus Gittinger"

!

singleCharPrefixMatchProfile

	"

	TimeProfiler profile: [self singleCharPrefixMatchProfile]

	Time millisecondsToRun: [self singleCharPrefixMatchProfile]

	"

	| stream matcher count |

	stream := self bigHonkingStream.

	count := 0.

	matcher := 'm(e|a)th' asRegex.

	[

		[matcher searchStream: stream] whileTrue: [count := count + 1].

	]

	valueNowOrOnUnwindDo: [stream close].

	^count

! !

!RxTests methodsFor:'test suite - henry'!

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

!

testHenry002

        self runRegex: #('ab*c'

                'abc' true (1 'abc'))

!

testHenry003

        self runRegex: #('ab*bc'

                'abc' true (1 'abc')

                'abbc' true (1 'abbc')

                'abbbbc' true (1 'abbbbc'))

!

testHenry004

        self runRegex: #('ab+bc'        

                'abbc' true (1 'abbc')

                'abc' false nil

                'abq' false nil

                'abbbbc' true (1 'abbbbc'))

!

testHenry005

        self runRegex: #('ab?bc'

                'abbc' true (1 'abbc')

                'abc' true (1 'abc')

                'abbbbc' false nil

                'abc' true (1 'abc'))

!

testHenry006

        self runRegex: #('^abc$'

                'abc' true (1 'abc')

                'abcc' false nil

                'aabc' false nil)

!

testHenry007

        self runRegex: #('^abc'

                'abcc' true (1 'abc'))

!

testHenry008

        self runRegex: #('abc$'

                'aabc' true (1 'abc'))

!

testHenry009

        self runRegex: #('^'

                'abc' true nil)

!

testHenry010

        self runRegex: #('$'

                'abc' true nil)

!

testHenry011

        self runRegex: #('a.c'

                'abc' true (1 'abc')

                'axc' true (1 'axc'))

!

testHenry012

        "Need to get creative to include the null character..."

        self runRegex: 

            #('a.*c' 

                'axyzd' false nil

                'axyzc' true (1 'axyzc')

                'axy zc' true (1 'axy zc') "testing that a dot matches a space"

            ).

        self runRegex: 

            {'a.*c' . 

                'axy',(String with: 0 asCharacter),'zc' . false . nil} "testing that a dot does not match a null"

!

testHenry014

        self runRegex: #('a\w+c'

                ' abbbbc ' true (1 'abbbbc')

                'abb bc' false nil)

!

testHenry015

        self runRegex: #('\w+'

                '       foobar  quux' true (1 'foobar')

                '       ~!!@#$%^&*()-+=\|/?.>,<' false nil)

!

testHenry016

        self runRegex: #('a\W+c'

                'a   c' true (1 'a   c')

                'a bc' false nil)

!

testHenry017

        self runRegex: #('\W+'

                'foo!!@#$bar' true (1 '!!@#$')

                'foobar' false nil)

!

testHenry018

        self runRegex: #('a\s*c'

                'a   c' true (1 'a   c')

                'a bc' false nil)

!

testHenry019

        self runRegex: #('\s+'

                'abc3457 sd' true (1 ' ')

                '1234$^*^&asdfb' false nil)

!

testHenry020

        self runRegex: #('a\S*c'

                'aqwertyc' true (1 'aqwertyc')

                'ab c' false nil)

!

testHenry021

        self runRegex: #('\S+'

                '       asdf            ' true (1 'asdf')

                '       

                        ' false nil)

!

testHenry022

        self runRegex: #('a\d+c'

                'a0123456789c' true (1 'a0123456789c')

                'a12b34c' false nil)

!

testHenry023

        self runRegex: #('\d+'

                'foo@#$%123ASD #$$%^&' true (1 '123')

                'foo!!@#$asdfl;' false nil)

!

testHenry024

        self runRegex: #('a\D+c'

                'aqwertyc' true (1 'aqwertyc')

                'aqw6ertc' false nil)

!

testHenry025

        self runRegex: #('\D+'

                '1234 abc 456' true (1 ' abc ')

                '1234567890' false nil)

!

testHenry026

        self runRegex: #('(f|o)+\b'

                'foo' true (1 'foo')

                ' foo ' true (1 'foo'))

!

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)

!

testHenry028

        self runRegex: #('(f|o)+\B'

                'quuxfoobar' true (1 'foo')

                'quuxfoo ' true (1 'fo'))

!

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)

!

testHenry030

        self runRegex: #('fooa\>.*'

                'fooa ' true nil

                'fooa123' false nil

                'fooa bar' true nil

                'fooa' true nil

                'fooargh' false nil)

!

testHenry031

        self runRegex: #('\>.+abc'

                ' abcde fg' false nil

                'foo abcde' true (1 ' abc')

                'abcde' false nil)

!

testHenry032

        self runRegex: #('\<foo.*'

                'foo' true nil

                'foobar' true nil

                'qfoobarq foonix' true (1 'foonix')

                ' foo' true nil

                ' 12foo' false nil

                'barfoo' false nil)

!

testHenry033

        self runRegex: #('.+\<foo'

                'foo' false nil

                'ab foo' true (1 'ab foo')

                'abfoo' false nil)

!

testHenry034

        self runRegex: #('a[bc]d'

                'abc' false nil

                'abd' true (1 'abd'))

!

testHenry035

        self runRegex: #('a[b-d]e'

                'abd' false nil

                'ace' true (1 'ace'))

!

testHenry036

        self runRegex: #('a[b-d]'

                'aac' true (1 'ac'))

!

testHenry037

        self runRegex: #('a[-b]'

                'a-' true (1 'a-'))

!

testHenry038

        self runRegex: #('a[b-]'

                'a-' true (1 'a-'))

!

testHenry039

        self runRegex: #('a[a-b-c]' nil)

!

testHenry040

        self runRegex: #('[k]'

                'ab' false nil)

!

testHenry041

        self runRegex: #('a[b-a]' nil)