"
 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:''
	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."

    |p context|

    p := Processor activeProcess.
    [p notNil] whileTrue:[
        context := p environmentAt:#instrumentationContext ifAbsent:nil.
        context notNil ifTrue:[^ context ].
        p := p parentProcess
    ].
    ^ nil

    "
     InstrumentationContext current
    "

    "Created: / 08-08-2011 / 14:44:11 / cg"
! !

!InstrumentationContext class methodsFor:'running'!

run:aBlock
    "run aBlock with instrumentation enabled"

    |context|

    context := self new.
    [
        context beActiveIn:(Processor activeProcess).
        aBlock value
    ] ensure:[
        Processor activeProcess environmentAt:#instrumentationContext put:nil
    ].

    "
     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 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."

    aProcess environmentAt:#instrumentationContext put:self.

    "
     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 class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.1 2011-08-08 18:08:29 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.1 2011-08-08 18:08:29 cg Exp $'
! !