"
COPYRIGHT (c) 2010 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libcomp' }"
Object variableSubclass:#InstrumentationContext
instanceVariableNames:'inInstrumentedCode enabled'
classVariableNames:'CachedProcessToInstrumentationContextMapping
GlobalInstrumentationContext'
poolDictionaries:''
category:'System-Compiler-Instrumentation'
!
!InstrumentationContext class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2010 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
installed as a thread-local variable (instrumentationContext) by the
beActiveIn:aProcess method, instances of me keep some meta state while
instrumentation is ongoing.
Especially, only in processes with a context are instrumentationInfo objects
updated. This has two advantages:
- it blocks recursive calls, while inside instrumentation code
- it blocks instrumentation from other processes (so only test-code is instrumented)
"
! !
!InstrumentationContext class methodsFor:'instance creation'!
new
"return an initialized instance"
^ self basicNew initialize.
! !
!InstrumentationContext class methodsFor:'instance access'!
current
"the current context for this running thread.
walks along the parent-process chain, up to a possible global context"
^ self forProcess:(Processor activeProcess)
"
InstrumentationContext current
"
"Created: / 08-08-2011 / 14:44:11 / cg"
!
forProcess:aProcess
"the context for this thread.
walks along the parent-process chain, up to a possible global context"
|p context|
CachedProcessToInstrumentationContextMapping isNil ifTrue:[
CachedProcessToInstrumentationContextMapping := WeakIdentityDictionary new.
].
context := CachedProcessToInstrumentationContextMapping at:aProcess ifAbsent:nil.
context == 0 ifTrue:[ ^ nil]. "/ special entry for a known nil value
context isNil ifTrue:[
"/ future (need a faster parentProcess query)
p := aProcess.
[p notNil] whileTrue:[
context := p environmentAt:#instrumentationContext ifAbsent:nil.
context notNil ifTrue:[
CachedProcessToInstrumentationContextMapping at:aProcess put:context.
^ context
].
p := p parentProcess
].
CachedProcessToInstrumentationContextMapping at:aProcess put:(GlobalInstrumentationContext ? 0). "/ known to be nil
context := GlobalInstrumentationContext.
].
^ context
"
InstrumentationContext current
"
"Created: / 17-08-2011 / 11:29:51 / cg"
! !
!InstrumentationContext class methodsFor:'running'!
run:aBlock
"run aBlock with instrumentation enabled"
self new run:aBlock.
"
Smalltalk loadPackage:'exept:regression'.
BTree withAllPrivateClasses
do:[:cls | cls recompileUsingCompilerClass:InstrumentingCompiler].
InstrumentationContext
run:[ RegressionTests::BinaryTreeTester suite run ].
(Tools::NewSystemBrowser open)
switchToClass:BTree;
showCoverageInformation value:true
"
"Created: / 08-08-2011 / 15:47:10 / cg"
! !
!InstrumentationContext class methodsFor:'utilities'!
setInstrumentationContext:aContextOrNil in:aProcess
"in order to keep the knowledge about which environment-variable is used
at least local..."
aProcess environmentAt:#instrumentationContext put:aContextOrNil
"Created: / 17-08-2011 / 11:53:19 / cg"
! !
!InstrumentationContext methodsFor:'accessing'!
enabled
^ enabled
!
enabled:aBoolean
enabled := aBoolean.
"Modified (format): / 08-08-2011 / 14:47:12 / cg"
!
inInstrumentedCode
^ inInstrumentedCode ? false
"Modified: / 07-08-2011 / 16:57:15 / cg"
!
inInstrumentedCode:aBoolean
inInstrumentedCode := aBoolean.
"Modified (format): / 08-08-2011 / 19:43:19 / cg"
! !
!InstrumentationContext methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
inInstrumentedCode := false.
enabled := true.
"/ super initialize. -- commented since inherited method does nothing
"Modified: / 08-08-2011 / 15:44:59 / cg"
! !
!InstrumentationContext methodsFor:'installing'!
beActiveIn:aProcess
"become the current instrumentaion context for a process."
self class setInstrumentationContext:self in:aProcess.
CachedProcessToInstrumentationContextMapping removeKey:aProcess ifAbsent:[].
"
InstrumentationContext new beActiveIn:(Processor activeProcess)
"
"Created: / 08-08-2011 / 14:46:09 / cg"
! !
!InstrumentationContext methodsFor:'queries'!
enabledAndNotInInstrumentedCode
^ enabled and:[ inInstrumentedCode not ]
"Created: / 08-08-2011 / 15:44:30 / cg"
! !
!InstrumentationContext methodsFor:'running'!
run:aBlock
"run aBlock with instrumentation enabled"
|activeProcess|
activeProcess := Processor activeProcess.
[
self beActiveIn:activeProcess.
aBlock value
] ensure:[
self class setInstrumentationContext:nil in:activeProcess
].
"Modified: / 17-08-2011 / 11:53:54 / cg"
! !
!InstrumentationContext class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.4 2011-08-21 10:33:50 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.4 2011-08-21 10:33:50 cg Exp $'
! !