Pavel, This is incredible !
This is why we love Smalltalk, in what other language could you write it like that ? I love it. Sven On 21 Feb 2012, at 16:03, Pavel Krivanek wrote: > Hi, > > what about to intrroduce tests that will test coverage of tests? Some > improved version of the code below. Are there some tool for Smalltalk > showing uncovered lines of code? There are such tools in Java world > :-) One little problem is that this code do not work on Linux because > of a VM error that cause test failures on CI server too. > > Cheers, > Pavel > > | class test trace classTrace result | > > class := Time. > test := TimeTest. > > trace := Dictionary new. > > thisContext runSimulated: [test suite run] contextAtEachStep: [ :current | > | cls sel methods bytecodes | > cls := current method methodClass. > sel := current method selector. > methods := trace at: cls ifAbsentPut: Dictionary new. > bytecodes := methods at: sel ifAbsentPut: Set new. > bytecodes add: current pc.] > > trace . > > result := String streamContents: [:s | > > classTrace := trace at: class ifAbsent: nil. > classTrace > ifNil: [ > s nextPutAll: 'Class ', class name, ' not called'; cr. ] > ifNotNil: [ > s nextPutAll: class name; cr. > class selectorsDo: [:sel | > | m usedBytecodes allBytecodes | > m := class >> sel. > usedBytecodes := (classTrace at: sel ifAbsent: Set new) > size. > allBytecodes := 0. > m symbolicLinesDo: [:pc :lineForPC | allBytecodes := > allBytecodes + 1 ].. > s tab; nextPutAll: sel; nextPutAll: ' - '; nextPutAll: > (usedBytecodes / allBytecodes * 100) asFloat asString; nextPutAll: > '%'; cr. ]]. > ]. > result.. >
