"{ Package: 'exept:regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#BreakpointTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'tests-Regression'
!
!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:'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>"
!
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:'running'!
tearDown
| sels |
sels := self class testSelectors.
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>"
! !
!BreakpointTests methodsFor:'tests'!
helper_01: selector
| a m nhits |
m := self class >> selector.
MessageTracer breakMethod: m atLine: 2.
a := Array new: m numArgs.
nhits := 0.
[
self perform: selector withArguments: a
] on: BreakPointInterrupt do:[:ex|
Transcript nextPutLine: 'Breakpointed in ' , selector.
nhits := nhits + 1.
MessageTracer breakMethod: m atLine: 3.
ex proceed.
].
self assert: nhits == 2.
"Created: / 10-04-2013 / 10:50:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-04-2013 / 00:55:25 / 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>"
! !
!BreakpointTests class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !