--- a/s/BenchmarkExecutor.st Mon Mar 10 11:29:09 2014 +0000
+++ b/s/BenchmarkExecutor.st Wed May 21 12:32:17 2014 +0100
@@ -135,6 +135,82 @@
"Created: / 12-08-2013 / 00:11:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-03-2014 / 10:23:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spy: aBenchmarkInstance result: aBenchmarkResult defines: aDictionary
+ "
+ Takes a benchmark instance and a set of parameter defines,
+ then executes the benchmark under MessageTally profiler.
+ Given defines must define only one combination, otherwise
+ and error is thrown.
+
+ This can be used for rough in-image profiling
+ "
+
+ | parameters combinator |
+
+ aBenchmarkResult initializeTimestampIfNotAlready.
+ parameters := aBenchmarkInstance parameters collect:[:parameter|
+ | key1 key2 valuesString values defined |
+
+ key1 := aBenchmarkInstance instance class name , '#' , parameter name.
+ key2 := parameter name.
+ defined := true.
+ valuesString := aDictionary at: key1 ifAbsent:[aDictionary at: key2 ifAbsent:[defined := false]].
+ defined ifTrue:[
+ values := BenchmarkPlatform current isSmalltalkX
+ ifTrue:[valuesString tokensBasedOn: $,]
+ ifFalse:[valuesString subStrings:','].
+ values := values collect:[:each|
+
+ (parameter type includesBehavior: String) ifTrue:[
+ each
+ ] ifFalse:[
+ | s v |
+
+ s := each readStream.
+ v := parameter type readFrom: s onError:[
+ "JV: Note for Smalltalk/X: #signal: is actually an ANSI 1.9 protocol!!"
+ BenchmarkParameterError new signal: 'Cannot read parameter value for ' , parameter name , ' (parse error)'
+ ].
+ s atEnd ifFalse:[
+ "JV: Note for Smalltalk/X: #signal: is actually an ANSI 1.9 protocol!!"
+ BenchmarkParameterError new signal: 'Cannot read parameter value for ' , parameter name , ' (parse error)'
+ ].
+ v.
+ ].
+ ]
+
+ ] ifFalse:[
+ parameter default == BenchmarkParameter undefinedValue ifTrue:[
+ BenchmarkParameterError new signal: 'Parameter value for ' , parameter name , ' not specified and parameter has no default value'.
+ ].
+ values := Array with: parameter default.
+ ].
+ values size > 1 ifTrue:[
+ BenchmarkParameterError new signal: 'Multiple parameter values for param ', parameter name , '. No parameter combinating allowed when running under profiler!!'.
+ ].
+ parameter -> values
+ ].
+
+ parameters := parameters asOrderedCollection sort:[:a :b | a key name < b key name ].
+
+ combinator := [:parametersAndValues |
+ parametersAndValues size = parameters size ifTrue:[
+ self spy: aBenchmarkInstance result: aBenchmarkResult parameters: parametersAndValues.
+ ] ifFalse:[
+ | parameter |
+
+ parameter := parameters at: parametersAndValues size + 1.
+ parameter value do:[:value |
+ combinator value: (parametersAndValues copyWith: (parameter key -> value)).
+ ]
+ ]
+ ].
+
+ combinator value: #().
+
+ "Created: / 21-05-2014 / 10:44:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BenchmarkExecutor methodsFor:'executing-private'!
@@ -197,6 +273,18 @@
"Modified: / 01-08-2013 / 19:14:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+spyIt: aBenchmarkInstance
+ | t |
+ [
+ t := aBenchmarkInstance spyIt.
+ ] on: Error do:[:ex|
+ BenchmarkExecutionError new signal:'Error during measurement: ', ex description.
+ ].
+ ^t
+
+ "Created: / 21-05-2014 / 10:48:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
tearDown: aBenchmarkInstance
[
aBenchmarkInstance tearDown.
@@ -232,6 +320,33 @@
"Modified: / 31-07-2013 / 01:04:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!BenchmarkExecutor methodsFor:'profiling-private'!
+
+spy: aBenchmarkInstance result: aBenchmarkResult parameters: aCollection
+ "
+ Takes a benchmark instance and a set of parameter defines,
+ runs it under MessageTally profiler and show profiling results.
+ "
+
+ | times outcome |
+
+ [
+ self setUp:aBenchmarkInstance parameters: aCollection .
+ self warmUp: aBenchmarkInstance.
+ times := Array with: (self spyIt: aBenchmarkInstance).
+ aBenchmarkResult addOutcome:
+ (outcome := BenchmarkOutcome
+ benchmark: aBenchmarkInstance
+ times: times
+ parameters: aCollection)
+ ] ensure:[
+ self tearDown: aBenchmarkInstance
+ ].
+ ^ outcome
+
+ "Created: / 21-05-2014 / 10:44:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!BenchmarkExecutor class methodsFor:'documentation'!
version_HG
--- a/s/BenchmarkInstance.st Mon Mar 10 11:29:09 2014 +0000
+++ b/s/BenchmarkInstance.st Wed May 21 12:32:17 2014 +0100
@@ -274,15 +274,52 @@
"Modified: / 09-03-2014 / 23:31:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!BenchmarkInstance methodsFor:'profiling'!
+
+spy
+ "Run benchmark under MessageTally and display results"
+
+ ^self spy: BenchmarkResult new.
+
+ "Created: / 21-05-2014 / 10:31:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spy: aBenchmarkResult
+ "Run benchmark under MessageTally profiler. Result is added to given benchmark result"
+
+ ^self spy: aBenchmarkResult with: Dictionary new
+
+ "Created: / 21-05-2014 / 10:32:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spy: aBenchmarkResult with: aDictionary
+ ^ self spy: aBenchmarkResult with: aDictionary executor: BenchmarkExecutor new
+
+ "Created: / 21-05-2014 / 10:33:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spy: aBenchmarkResult with: aDictionary executor: aBenchmarkExecutor
+ aBenchmarkExecutor spy: self result: aBenchmarkResult defines: aDictionary.
+ ^ aBenchmarkResult
+
+ "Created: / 21-05-2014 / 10:33:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spyWith: aDictionary
+ ^ self spy: BenchmarkResult new with: aDictionary
+
+ "Created: / 21-05-2014 / 10:33:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!BenchmarkInstance methodsFor:'running'!
run
- "Run the suite, returning result"
+ "Run benchmark, returning result"
^self run: BenchmarkResult new.
"Created: / 27-05-2013 / 19:10:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 24-06-2013 / 01:07:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 21-05-2014 / 10:31:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
run: aBenchmarkResult
@@ -337,6 +374,22 @@
"Created: / 27-07-2013 / 11:43:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+spyIt
+ | t0 t1 messageTally |
+
+ " Special - use Smalltalk/X visual profiler instead plain old
+ MessageTally."
+ messageTally := Smalltalk isSmalltalkX
+ ifTrue:[ Smalltalk at:#'Tools::Profiler' ]
+ ifFalse:[ MessageTally ].
+ t0 := MillisecondsTime value.
+ messageTally spyDetailedOn: [ instance perform:benchmarkSelector ].
+ t1 := MillisecondsTime value.
+ ^ t1 - t0
+
+ "Created: / 21-05-2014 / 10:53:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
tearDown
tearDownSelector1 notNil ifTrue:[
instance perform: tearDownSelector1
--- a/s/s.rc Mon Mar 10 11:29:09 2014 +0000
+++ b/s/s.rc Wed May 21 12:32:17 2014 +0100
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
VALUE "ProductName", "LibraryName\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Mon, 10 Mar 2014 10:53:32 GMT\0"
+ VALUE "ProductDate", "Wed, 21 May 2014 10:01:24 GMT\0"
END
END
--- a/s/stx/stx.rc Mon Mar 10 11:29:09 2014 +0000
+++ b/s/stx/stx.rc Wed May 21 12:32:17 2014 +0100
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
VALUE "ProductName", "ProductName\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Mon, 10 Mar 2014 10:53:37 GMT\0"
+ VALUE "ProductDate", "Wed, 21 May 2014 10:01:29 GMT\0"
END
END
--- a/s/tests/tests.rc Mon Mar 10 11:29:09 2014 +0000
+++ b/s/tests/tests.rc Wed May 21 12:32:17 2014 +0100
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
VALUE "ProductName", "ProductName\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Mon, 10 Mar 2014 10:53:35 GMT\0"
+ VALUE "ProductDate", "Wed, 21 May 2014 10:01:27 GMT\0"
END
END