InstrumentationContext.st
author Claus Gittinger <cg@exept.de>
Tue, 05 Jun 2012 23:31:07 +0200
changeset 2874 68b98f42a54f
parent 2710 f2e7d18ca6c8
child 2942 2f6d164949bf
permissions -rw-r--r--
class definition changed:6 methods
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 2010 by eXept Software AG
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
              All Rights Reserved
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libcomp' }"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
Object variableSubclass:#InstrumentationContext
2710
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
    15
	instanceVariableNames:'inInstrumentedCode enabled coverageOnly'
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    16
	classVariableNames:'LastProcess LastInstrumentationContext
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    17
		GlobalInstrumentationContext'
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	poolDictionaries:''
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	category:'System-Compiler-Instrumentation'
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
!InstrumentationContext class methodsFor:'documentation'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
copyright
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
 COPYRIGHT (c) 2010 by eXept Software AG
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
              All Rights Reserved
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
 This software is furnished under a license and may be used
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 only in accordance with the terms of that license and with the
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 be provided or otherwise made available to, or used by, any
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 other person.  No title to or ownership of the software is
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
 hereby transferred.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
documentation
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    installed as a thread-local variable (instrumentationContext) by the
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    beActiveIn:aProcess method, instances of me keep some meta state while
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    instrumentation is ongoing. 
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    Especially, only in processes with a context are instrumentationInfo objects
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    updated. This has two advantages:
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    - it blocks recursive calls, while inside instrumentation code
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    - it blocks instrumentation from other processes (so only test-code is instrumented)
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
!InstrumentationContext class methodsFor:'instance creation'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
new
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    "return an initialized instance"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    ^ self basicNew initialize.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
!InstrumentationContext class methodsFor:'instance access'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
current
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    61
    "the current context for this running thread.
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    62
     walks along the parent-process chain, up to a possible global context"
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    64
    ^ self forProcess:(Processor activeProcess)
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    "
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
     InstrumentationContext current
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
    "
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    "Created: / 08-08-2011 / 14:44:11 / cg"
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    71
!
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    72
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    73
forProcess:aProcess
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    74
    "the context for this thread.
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    75
     walks along the parent-process chain, up to a possible global context"
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    76
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    77
    |p context|
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    78
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    79
    aProcess == LastProcess ifTrue:[
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    80
        ^ LastInstrumentationContext
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    81
    ].
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    82
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    83
    "/ future (need a faster parentProcess query)
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    84
    p := aProcess.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    85
    [p notNil] whileTrue:[
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    86
        context := p environmentAt:#instrumentationContext ifAbsent:nil.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    87
        context notNil ifTrue:[
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    88
            aProcess environmentAt:#instrumentationContext put:context.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    89
            context == 0 ifTrue:[
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    90
                context := nil.
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    91
            ].
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    92
            LastProcess := aProcess.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    93
            LastInstrumentationContext := context.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    94
            ^ context
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    95
        ].
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    96
        p := p parentProcess
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
    97
    ].
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    98
    aProcess environmentAt:#instrumentationContext put:(GlobalInstrumentationContext ? 0).      "/ could be nil
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
    99
    LastProcess := aProcess.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   100
    LastInstrumentationContext := GlobalInstrumentationContext.
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   101
    ^ GlobalInstrumentationContext.
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   102
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   103
    "
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   104
     InstrumentationContext current
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   105
    "
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   106
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   107
    "Created: / 17-08-2011 / 11:29:51 / cg"
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   110
!InstrumentationContext class methodsFor:'queries'!
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   111
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   112
hasGlobalInstrumentationContext
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   113
    ^ GlobalInstrumentationContext notNil
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   114
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   115
    "
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   116
     InstrumentationContext hasGlobalInstrumentationContext
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   117
    "
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   118
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   119
    "Created: / 21-09-2011 / 19:15:51 / cg"
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   120
! !
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   121
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
!InstrumentationContext class methodsFor:'running'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
run:aBlock
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    "run aBlock with instrumentation enabled"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
2657
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   127
    self new run:aBlock.
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    "
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
     Smalltalk loadPackage:'exept:regression'.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
     BTree withAllPrivateClasses 
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
        do:[:cls | cls recompileUsingCompilerClass:InstrumentingCompiler].
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
     InstrumentationContext
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
        run:[ RegressionTests::BinaryTreeTester suite run ].
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
     (Tools::NewSystemBrowser open)
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
        switchToClass:BTree;
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
        showCoverageInformation value:true
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
    "
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
    "Created: / 08-08-2011 / 15:47:10 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   143
!InstrumentationContext class methodsFor:'utilities'!
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   144
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   145
setGlobalInstrumentationContext:aContextOrNil
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   146
    "setup for global instrumentation: instrumentation is performed for all processes"
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   147
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   148
    GlobalInstrumentationContext := aContextOrNil.
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   149
    LastInstrumentationContext := LastProcess := nil.
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   150
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   151
    "Created: / 21-09-2011 / 19:07:00 / cg"
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   152
!
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   153
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   154
setInstrumentationContext:aContextOrNil in:aProcess
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   155
    "setup for process specific instrumentation: 
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   156
        instrumentation is aProcess"
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   157
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   158
    "in order to keep the knowledge about which environment-variable is used
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   159
     at least local..."
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   160
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   161
    aProcess environmentAt:#instrumentationContext put:aContextOrNil.
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   162
    LastInstrumentationContext := LastProcess := nil.
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   163
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   164
    "Created: / 17-08-2011 / 11:53:19 / cg"
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   165
! !
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   166
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
!InstrumentationContext methodsFor:'accessing'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
2710
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   169
coverageOnly
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   170
    "if on, only keep track of coverage (not counting);
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   171
     if off, we also count how often the code has been entered,
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   172
     and by which sender"
2710
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   173
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   174
    ^ coverageOnly
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   175
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   176
    "Created: / 23-08-2011 / 21:25:46 / cg"
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   177
!
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   178
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   179
coverageOnly:aBoolean
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   180
    "if on, only keep track of coverage (not counting);
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   181
     if off, we also count how often the code has been entered"
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   182
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   183
    coverageOnly := aBoolean.
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   184
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   185
    "Created: / 23-08-2011 / 21:25:37 / cg"
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   186
!
f2e7d18ca6c8 class definition
Claus Gittinger <cg@exept.de>
parents: 2706
diff changeset
   187
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
enabled
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
    ^ enabled
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
enabled:aBoolean
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
    enabled := aBoolean.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
    "Modified (format): / 08-08-2011 / 14:47:12 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
inInstrumentedCode
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
    ^ inInstrumentedCode ? false
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
    "Modified: / 07-08-2011 / 16:57:15 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
inInstrumentedCode:aBoolean
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
    inInstrumentedCode := aBoolean.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
    "Modified (format): / 08-08-2011 / 19:43:19 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
!InstrumentationContext methodsFor:'initialization'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
initialize
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
    "Invoked when a new instance is created."
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
    inInstrumentedCode := false.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
    enabled := true.
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
    "/ super initialize.   -- commented since inherited method does nothing
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
    "Modified: / 08-08-2011 / 15:44:59 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
!InstrumentationContext methodsFor:'installing'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   225
beActiveEverywhere
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   226
    "become the current instrumentaion context for all processes."
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   227
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   228
    self class setGlobalInstrumentationContext:self. 
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   229
    LastInstrumentationContext := LastProcess := nil.
2706
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   230
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   231
    "
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   232
     InstrumentationContext new beActiveEverywhere
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   233
    "
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   234
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   235
    "Created: / 21-09-2011 / 19:08:43 / cg"
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   236
!
Claus Gittinger <cg@exept.de>
parents: 2673
diff changeset
   237
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
beActiveIn:aProcess
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
    "become the current instrumentaion context for a process."
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
2672
ca4221b5143e changed: #beActiveIn:
Claus Gittinger <cg@exept.de>
parents: 2664
diff changeset
   241
    self class setInstrumentationContext:self in:aProcess.
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   242
    LastInstrumentationContext := LastProcess := nil.
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
    "
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
     InstrumentationContext new beActiveIn:(Processor activeProcess)
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
    "
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
    "Created: / 08-08-2011 / 14:46:09 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
!InstrumentationContext methodsFor:'queries'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
enabledAndNotInInstrumentedCode
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
    ^ enabled and:[ inInstrumentedCode not ]
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
    "Created: / 08-08-2011 / 15:44:30 / cg"
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
! !
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
2657
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   259
!InstrumentationContext methodsFor:'running'!
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   260
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   261
run:aBlock
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   262
    "run aBlock with instrumentation enabled"
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   263
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   264
    |activeProcess|
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   265
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   266
    activeProcess := Processor activeProcess.
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   267
2657
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   268
    [
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   269
        self beActiveIn:activeProcess.
2657
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   270
        aBlock value
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   271
    ] ensure:[
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   272
        self class setInstrumentationContext:nil in:activeProcess
2657
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   273
    ].
2664
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   274
c23a731f19c5 class definition
Claus Gittinger <cg@exept.de>
parents: 2657
diff changeset
   275
    "Modified: / 17-08-2011 / 11:53:54 / cg"
2657
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   276
! !
158e4e722319 added: #run:
Claus Gittinger <cg@exept.de>
parents: 2629
diff changeset
   277
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
!InstrumentationContext class methodsFor:'documentation'!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
version
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   281
    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.8 2012-06-05 21:31:07 cg Exp $'
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
!
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
version_CVS
2874
68b98f42a54f class definition
Claus Gittinger <cg@exept.de>
parents: 2710
diff changeset
   285
    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.8 2012-06-05 21:31:07 cg Exp $'
2629
d3561a472a75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
! !