--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/RegressionTests__BreakpointTests.st Tue Apr 16 09:25:26 2013 +0200
@@ -0,0 +1,288 @@
+"{ 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$'
+! !
+