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

"{ NameSpace: RegressionTests }"

TestCase subclass:#BreakpointTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-RuntimeSystem'

!

!BreakpointTests class methodsFor:'documentation'!

documentation

"

    Testcase to test VM breakpoint support (aka Jan's new breakpoints).

    If the VM is not compiled with new breakpoint support, this tests should

    be skipped.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!BreakpointTests methodsFor:'accessing'!

shouldSkip

    "Returns true, if this testcase should be skipped when a testsuite is run.

     This inly a hint, a test runner is not obliged to respect return value.

     Currently, the only user is stx/goodies/builder/reports"

    ^ConfigurableFeatures includesFeature: #VMBreakpointSupport

    "Created: / 09-04-2013 / 11:53:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BreakpointTests methodsFor:'initialize / release'!

tearDown

    | sels |

    sels :=  self class testSelectors.

    sels addAll: #(setUp tearDown helper_01).

    self class methodDictionary keysAndValuesDo:[:sel :m|

        (sels includes: sel) ifFalse:[

            m breakpointTable: nil.

        ]

    ]

    "Created: / 09-04-2013 / 12:27:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 24-04-2013 / 21:45:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BreakpointTests methodsFor:'mock methods'!

m00

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:01:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m01: a1

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:01:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m02: a1 _: a2

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:01:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m03: a1 _: a2 _: a3

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:01:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m04: a1 _: a2 _: a3 _: a4

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:01:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m05: a1 _: a2 _: a3 _: a4 _: a5

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:02:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m06: a1 _: a2 _: a3 _: a4 _: a5 _: a6

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:02:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m07: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:02:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m08: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:02:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m09: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:02:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m10: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9 _: a10

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:03:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m11: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9 _: a10 _: a11

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:03:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m12: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9 _: a10 _: a11 _: a12

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:03:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m13: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9 _: a10 _: a11 _: a12 _: a13

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:03:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m14: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9 _: a10 _: a11 _: a12 _: a13 _: a14

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:03:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

m15: a1 _: a2 _: a3 _: a4 _: a5 _: a6 _: a7 _: a8 _: a9 _: a10 _: a11 _: a12 _: a13 _: a14 _: a15

    self zork.

    self zork.

    "Created: / 09-04-2013 / 12:03:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mWithBlock

    [ self zork ] 

        valueWithArguments:#(). "/to optimizations

    self zork.

    "Created: / 24-04-2013 / 21:12:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 24-04-2013 / 22:35:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 25-04-2013 / 10:01:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mWithBlock2

    [ [ [ [ self zork ] 

        valueWithArguments:#() ] valueWithArguments:#() ] valueWithArguments:#() ] valueWithArguments:#().

    self zork.

    "

        RegressionTests::BreakpointTests new mWithBlock2

    "

    "Created: / 24-04-2013 / 21:13:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 25-04-2013 / 09:58:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mWithBlock3 | x |

    x := self. 

    [ [ [ [ x zork 

    ] valueWithArguments:#() ] valueWithArguments:#() ] valueWithArguments:#() ] valueWithArguments:#().

    self zork.

    "Created: / 24-04-2013 / 22:09:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-04-2013 / 09:59:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mWithTwoSendsOnLine

    self zork. self zork.

    self zork.

    "Created: / 15-04-2013 / 15:08:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mWithTwoSendsOnLineInCascade

    self zork; zork.

    self zork.

    "Created: / 15-04-2013 / 15:12:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

zork

    "Created: / 09-04-2013 / 12:00:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BreakpointTests methodsFor:'tests'!

helper_01: selector

    ^self perform: selector withBreakpointAt: 2 andAt: 3

    "Created: / 10-04-2013 / 10:50:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-04-2013 / 09:58:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

perform: selector withBreakpointAt: line1 andAt: line2

    | a m nhits |

    m := self class >> selector.

    MessageTracer breakMethod: m atLine: line1.

    a := Array new: m numArgs.

    nhits := 0.

    [       

            self perform: selector withArguments: a

    ] on: BreakPointInterrupt do:[:ex|

            Transcript nextPutAll: 'Breakpointed in ' , selector; cr.

            nhits := nhits + 1.

            MessageTracer breakMethod: m atLine: line2.

            ex proceed.

    ].

    self assert: nhits == 2.

    "Created: / 25-04-2013 / 09:53:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_01

    self helper_01: #m00.

    self helper_01: #m01:.

    self helper_01: #m02:_:.

    self helper_01: #m03:_:_:.

    self helper_01: #m04:_:_:_:.

    self helper_01: #m05:_:_:_:_:.

    self helper_01: #m06:_:_:_:_:_:.

    self helper_01: #m07:_:_:_:_:_:_:.

    self helper_01: #m08:_:_:_:_:_:_:_:.

    self helper_01: #m09:_:_:_:_:_:_:_:_:.

    self helper_01: #m10:_:_:_:_:_:_:_:_:_:.

    self helper_01: #m11:_:_:_:_:_:_:_:_:_:_:.

    self helper_01: #m12:_:_:_:_:_:_:_:_:_:_:_:.

    self helper_01: #m13:_:_:_:_:_:_:_:_:_:_:_:_:.

    self helper_01: #m14:_:_:_:_:_:_:_:_:_:_:_:_:_:.

    self helper_01: #m15:_:_:_:_:_:_:_:_:_:_:_:_:_:_:.

    "Created: / 09-04-2013 / 12:12:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-04-2013 / 10:50:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_01b

    | m s |

    m := self class >> #m00.

    s := #STC_m00.

    ChangeSet withoutUpdatingChangesDo:[

        ParserFlags withSTCCompilation:#always do:[

            self class compile: 'STC_', m source classified: 'mock methods - *dynamic*'

        ].

    ].

    [

        self helper_01: s.

    ] ensure:[

        self class removeSelector: s.

    ]

    "Created: / 15-04-2013 / 14:57:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_02a

    "

    Tests two breakpoints on the same line.    

    "

    self helper_01: #mWithTwoSendsOnLine

    "Created: / 15-04-2013 / 15:12:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_02b

    "

    Tests two breakpoints on the same line using cascade/

    "

    self helper_01: #mWithTwoSendsOnLineInCascade

    "Created: / 15-04-2013 / 15:13:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_03a

    "

    Tests two breakpoints in blocks

    "

    self perform: #mWithBlock withBreakpointAt: 2 andAt: 4.

    "Created: / 24-04-2013 / 21:13:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-04-2013 / 09:59:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_03b

    "

    Tests two breakpoints in blocks

    "

    self perform: #mWithBlock2 withBreakpointAt: 2 andAt: 4.

    "Created: / 24-04-2013 / 21:13:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-04-2013 / 10:00:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_03c

    "

    Tests two breakpoints in blocks

    "

    self perform: #mWithBlock3 withBreakpointAt: 3 andAt: 5.

    "Created: / 24-04-2013 / 22:09:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-04-2013 / 10:04:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BreakpointTests class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !