'From Squeak3.8beta of ''2 November 2004'' [latest update: #6365] on 10 November 2004 at 7:03:19 pm'! "Change Set: PrimCallController 1.0 Date: 16 June 2004 Author: Stephan Rudlof Audience: (plugin) developers, SUnitTest writers Requires: Squeak3.7beta (may work with older versions) md: changed categorie to be Tests-PrimCallController A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is helpful for e.g. testing of plugins. Dis/en-abling prims by a PCC works for *both* internal and external modules!! This package contains two concrete PCCs using totally different mechanisms for dis/en-abling prims, each has its value (see below). History -------- 1.0 - First release bundled with many SUnitTests; therefrom I think it is stable. Excerpt from the class comment of PrimCallControllerAbstract ------------------------------------------------------------------------ A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is an abstract class, instantiate one of the subclasses PCCByLiterals and PCCByCompilation. External prim calls are used to access internal and external modules (plugins) as shown by SmalltalkImage current listLoadedModules. SmalltalkImage current listBuiltinModules. Note: not loaded external modules (since they have not been called so far) are not shown by these methods. Highlight: dis/en-abling prims by a PCC works for both internal and external modules!! To help you choosing the right subclass, some properties are listed in the following table: Functionality/Property | PCCByLiterals PCCByCompilation ------------------------------------------------------------------------------------------------------ testing plugins | suited not suited permanent disabling of external prim calls | no yes ------------------------------------------------------------------------------------------------------ method changes visible in changeset | no yes enabling survives snapshot/compilation | yes yes disabling survives snapshot/compilation | no yes speed disabling | fast medium speed enabling | fast slow CompiledMethod pointer valid after en/dis-abling | yes no "! Object subclass: #PrimCallControllerAbstract instanceVariableNames: 'treatedMethods logStream changeStatusOfFailedCallsFlag' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! !PrimCallControllerAbstract commentStamp: 'sr 6/16/2004 09:42' prior: 0! A PrimCallController (PCC) serves for switching external prim calls (primitiveExternalCall) on and off: this is an abstract class, instantiate one of the subclasses PCCByLiterals and PCCByCompilation. External prim calls are used to access internal and external modules (plugins) as shown by SmalltalkImage current listLoadedModules. SmalltalkImage current listBuiltinModules. Note: not loaded external modules (since they have not been called so far) are not shown by these methods. Highlight: dis/en-abling prims by a PCC works for both internal and external modules!! To help you choosing the right subclass, some properties are listed in the following table: Functionality/Property | PCCByLiterals PCCByCompilation ------------------------------------------------------------------------------------------------------ testing plugins | suited not suited permanent disabling of external prim calls | no yes ------------------------------------------------------------------------------------------------------ method changes visible in changeset | no yes enabling survives snapshot/compilation | yes yes disabling survives snapshot/compilation | no yes speed disabling | fast medium speed enabling | fast slow CompiledMethod pointer valid after en/dis-abling | yes no Important: Be careful with mixing the use of different PCCs!! PCCByLiterals does not see prims disabled by PCCByCompilation and vice versa. For playing around you should start with PCCByLiterals; use PCCByCompilation only, if you know what you are doing!! In protocols 'ui controlling', 'ui logging' and 'ui querying' (please look into this class) are the most important user interface methods. Thereafter the methods in 'ui testing' could be of interest. Useful expressions: Controlling: "Factorial example" | pcc tDisabled tEnabled tEnabled2 | pcc _ PCCByLiterals new logStream: Transcript. "logStream set here for more info" pcc disableCallsIntoModule: 'LargeIntegers'. tDisabled _ [1000 factorial] timeToRun. pcc enableDisabled. tEnabled _ [1000 factorial] timeToRun. tEnabled2 _ [1000 factorial] timeToRun. {tDisabled. tEnabled. tEnabled2} Note: You shouldn't switch off module 'LargeIntegers' for a longer time, since this slows down your system. Querying: PCCByLiterals new methodsWithCall. "all calls" PCCByLiterals new methodsWithCall: 'prim1'. "call in all modules or without module" PCCByLiterals new methodsWithCallIntoModule: nil. "all calls without module" PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers'. "all calls into module 'LargeIntegers'" PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers' forClass: Integer. "all calls into module 'LargeIntegers' in class Integer" PCCByLiterals new methodsWithCallIntoModule: 'LargeIntegers' forClasses: Integer withAllSubclasses. "all calls into module 'LargeIntegers' in class Integer withAllSubclasses" | pcc | (pcc _ PCCByLiterals new) methodsWithCall collect: [:mRef | {mRef. pcc extractCallModuleNames: mRef}]. Structure: treatedMethods Dictionary of MethodReferences->#disabled/#enabled -- contains changed methods and how they are changed last logStream WriteStream -- shows info about changed methods ifNotNil changeStatusOfFailedCalls Boolean -- if status of failed calls should be changed, default is false! ]style[(165 13 5 16 339 26 792 10 84 8 120 31 82 4 118 19 17 18 2 452 29 37 18 15 56 1 18 26 35 2 18 26 79 26 122 26 170 79 1 320)f2FAccuny#12,f2LPCCByLiterals Comment;,f2FAccuny#12,f2LPCCByCompilation Comment;,f2FAccuny#12,f2FAccuny#12b,f2FAccuny#12,f2FAccuny#12b,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2FAccuny#12b,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2FAccuny#15,f2FAccuny#12,f2,f2u,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2,f2FAccuny#12,f2! PrimCallControllerAbstract subclass: #PCCByCompilation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! !PCCByCompilation commentStamp: 'sr 6/16/2004 09:00' prior: 0! This class is for switching external prim calls (primitiveExternalCall) on and off. It is best suited for permanently switching plugin calls off while preserving the possibility to switch them on later. For plugin testing purposes you probably should use PCCByLiterals for temporarily switch on/off them instead. It works on a source code basis by compilation: Disabling works by putting an enabled prim call into a special comment followed by a recompile to transform it into a disabled one. Enabling works by pulling the disabled prim call out of the special comment followed by a recompile to transform it into an enabled one. As a consequence, enabling of prims only works with method sources containing the mentioned special comment, which normally has been generated by this tool for disabling the corresponding prim. Please look into superclass PrimCallControllerAbstract for more info and the user interface. Structure: No instVars here: look into superclass. Implementation note: To harden it for sunit testing purposes some special accessing of the source code has been necessary: to avoid accessing different processes a sources file at once, followed by generating garbage, the process priority of actions leading to these accesses has been increased (sunit tests run in the background). A better solution would be to introduce a source file locking mechanism.! ]style[(107 11 138 13 5 11 62 14 3 9 124 8 245 9 36 9 26 28 26 93 20 384)f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2LPCCByLiterals Comment;,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2FAccuny#12b,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2,f2FAccuny#12,f3FAccuny#12,f2FAccuny#12,f2,f2LPrimCallControllerAbstract Comment;,f2,FAccuny#15uf2,f2! PrimCallControllerAbstract subclass: #PCCByLiterals instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! !PCCByLiterals commentStamp: 'sr 6/16/2004 09:14' prior: 0! This class is for switching external prim calls (primitiveExternalCall) on and off. It is best suited for plugin testing purposes with temporarily switching plugin calls off and on. For permanently switching plugin calls off while preserving the possibility to switch them on later, you should use PCCByCompilation instead. It works by manipulating literals in the CompiledMethods: Disabling works by changing the function index in the first literal of the CompiledMethod to a negative value (-2). This leads to a fast fail (value -2 is used for disabling to make a difference to the standard failed value of -1). Enabling works by changing the function index in the first literal of the CompiledMethod to 0, followed by flushing the method cache. This enforces a fresh lookup. Please look into superclass PrimCallControllerAbstract for more info and the user interface. Structure: No instVars here: look into superclass.! ]style[(136 11 40 11 101 16 10 1 9 2 14 8 26 9 224 8 157 28 26 91)f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2LPCCByCompilation Comment;,f2FAccuny#12,f2,f2FAccuny#12,f2FAccuny#12b,f2FAccuny#12,f2FAccuny#12b,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2FAccuny#12i,f2FAccuny#12,f2,f2LPrimCallControllerAbstract Comment;,f2! ClassTestCase subclass: #PrimCallControllerAbstractTest instanceVariableNames: 'pcc doNotMakeSlowTestsFlag' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! !PrimCallControllerAbstractTest commentStamp: 'sr 6/15/2004 19:20' prior: 0! PrimCallController tests. Tests are here, but this class isAbstract and won't be tested. Tests are done in the subclasses, which inherit the tests here. If you want to perform some more very slow tests, change doNotMakeSlowTestsFlag in >>setUp.! PrimCallControllerAbstractTest subclass: #PCCByCompilationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! !PCCByCompilationTest commentStamp: 'sr 6/14/2004 22:05' prior: 0! PCCByCompilation tests. Tests are in the superclass and inherited from there.! PrimCallControllerAbstractTest subclass: #PCCByLiteralsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-PrimCallController'! !PCCByLiteralsTest commentStamp: 'sr 6/14/2004 22:05' prior: 0! PCCByLiterals tests. Tests are in the superclass and inherited from there.! !BlockContext methodsFor: 'scheduling' stamp: 'sr 6/14/2004 15:19'! valueAt: blockPriority "Evaluate the receiver (block), with another priority as the actual one and restore it afterwards. The caller should be careful with using higher priorities." | activeProcess result outsidePriority | activeProcess := Processor activeProcess. outsidePriority := activeProcess priority. activeProcess priority: blockPriority. result := self ensure: [activeProcess priority: outsidePriority]. "Yield after restoring lower priority to give the preempted processes a chance to run." blockPriority > outsidePriority ifTrue: [Processor yield]. ^ result! ! !MethodReference methodsFor: '*PrimCallController' stamp: 'sr 6/14/2004 15:11'! compiledMethod ^ self actualClass compiledMethodAt: methodSymbol! ! !MethodReference methodsFor: '*PrimCallController' stamp: 'sr 6/4/2004 01:55'! sourceString ^ (self actualClass sourceCodeAt: self methodSymbol) asString! ! !PrimCallControllerAbstract methodsFor: 'accessing' stamp: 'sr 6/11/2004 04:52'! changeStatusOfFailedCallsFlag ^changeStatusOfFailedCallsFlag! ! !PrimCallControllerAbstract methodsFor: 'accessing' stamp: 'sr 6/11/2004 04:12'! logStream ^logStream! ! !PrimCallControllerAbstract methodsFor: 'accessing' stamp: 'sr 6/2/2004 05:27'! treatedMethods ^treatedMethods! ! !PrimCallControllerAbstract methodsFor: 'initialize-release' stamp: 'sr 6/11/2004 05:39'! initialize treatedMethods _ Dictionary new. " logStream _ Transcript." changeStatusOfFailedCallsFlag _ false! ! !PrimCallControllerAbstract methodsFor: 'logging' stamp: 'sr 6/11/2004 05:12'! log: aString self logStream ifNotNil: [self logStream cr; show: '[' , self className , '] ' , aString]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 17:39'! changeStatusOfFailedCalls "En/dis-able not only dis/en-abled calls, but also failed ones. Using this feature can hide serious problems." changeStatusOfFailedCallsFlag := true! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 01:15'! disableCallIn: aMethodRef "Disables enabled external prim call." (self existsEnabledCallIn: aMethodRef) ifFalse: [self changeStatusOfFailedCallsFlag ifTrue: [(self existsFailedCallIn: aMethodRef) ifFalse: [^ self error: 'no enabled or failed prim call found']] ifFalse: [^ self error: 'no enabled prim call found']]. self privateDisableCallIn: aMethodRef. self treatedMethods at: aMethodRef put: #disabled. self logStream ifNotNil: [self log: 'Call ' , (self extractCallModuleNames: aMethodRef) printString , ' in ' , aMethodRef actualClass name , '>>' , aMethodRef methodSymbol , ' disabled.']! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 17:30'! disableCallInCompiledMethod: aCompiledMethod "Disables external prim call." self changeCallCompiledMethod: aCompiledMethod enable: false! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 17:31'! disableCallInMethod: selector class: classOrSymbol "Disables external prim call." self changeCallMethod: selector class: classOrSymbol enable: false! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 01:35'! disableCallsIntoModule: aModule "Disables enabled external prim calls in aModule." | methods | methods := self methodsWithEnabledCallIntoModule: aModule. self changeStatusOfFailedCallsFlag ifTrue: [methods addAll: (self methodsWithFailedCallIntoModule: aModule)]. methods isEmpty ifTrue: [^ self error: 'no enabled ' , (self changeStatusOfFailedCallsFlag ifTrue: ['or failed '] ifFalse: ['']) , 'prim calls for module ' , aModule , ' found']. methods do: [:mRef | self disableCallIn: mRef]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 02:01'! disableCallsIntoModule: aModule forClasses: classes "Disables enabled external prim calls in aModule for classes." | methods | methods := self methodsWithEnabledCallIntoModule: aModule forClasses: classes. self changeStatusOfFailedCallsFlag ifTrue: [methods addAll: (self methodsWithFailedCallIntoModule: aModule forClasses: classes)]. methods isEmpty ifTrue: [^ self error: 'no enabled ' , (self changeStatusOfFailedCallsFlag ifTrue: ['or failed '] ifFalse: ['']) , 'prim calls for module ' , aModule , ' in given classes found']. methods do: [:mRef | self disableCallIn: mRef]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/11/2004 06:44'! disableEnabled "Disables these external prim calls, which are formerly enabled by self." self treatedMethods keysAndValuesDo: [:mRef :status | status == #enabled ifTrue: [self disableCallIn: mRef]]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/14/2004 02:05'! enableCallIn: aMethodRef "Enables disabled external prim call." (self existsDisabledCallIn: aMethodRef) ifTrue: [self privateEnableCallIn: aMethodRef] ifFalse: [self changeStatusOfFailedCallsFlag ifTrue: [(self existsFailedCallIn: aMethodRef) ifTrue: [self privateEnableViaLiteralIn: aMethodRef] ifFalse: [^ self error: 'no disabled or failed prim call found']] ifFalse: [^ self error: 'no disabled prim call found']]. self treatedMethods at: aMethodRef put: #enabled. self logStream ifNotNil: [self log: 'Call ' , (self extractCallModuleNames: aMethodRef) printString , ' in ' , aMethodRef actualClass name , '>>' , aMethodRef methodSymbol , ' enabled.']! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 17:31'! enableCallInCompiledMethod: aCompiledMethod "Enables disabled external prim call." self changeCallCompiledMethod: aCompiledMethod enable: true! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 17:31'! enableCallInMethod: selector class: classOrSymbol "Enables disabled external prim call." self changeCallMethod: selector class: classOrSymbol enable: true! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 01:36'! enableCallsIntoModule: aModule "Enables disabled external prim calls in aModule." | methods | methods := self methodsWithDisabledCallIntoModule: aModule. self changeStatusOfFailedCallsFlag ifTrue: [methods addAll: (self methodsWithFailedCallIntoModule: aModule)]. methods isEmpty ifTrue: [^ self error: 'no disabled ' , (self changeStatusOfFailedCallsFlag ifTrue: ['or failed '] ifFalse: ['']) , 'prim calls for module ' , aModule , ' found']. methods do: [:mRef | self enableCallIn: mRef]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 02:01'! enableCallsIntoModule: aModule forClasses: classes "Enables disabled external prim calls in aModule for classes." | methods | methods := self methodsWithDisabledCallIntoModule: aModule forClasses: classes. self changeStatusOfFailedCallsFlag ifTrue: [methods addAll: (self methodsWithFailedCallIntoModule: aModule forClasses: classes)]. methods isEmpty ifTrue: [^ self error: 'no disabled ' , (self changeStatusOfFailedCallsFlag ifTrue: ['or failed '] ifFalse: ['']) , 'prim calls for module ' , aModule , ' in given classes found']. methods do: [:mRef | self enableCallIn: mRef]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/11/2004 06:42'! enableDisabled "Enables these external prim calls, which are formerly disabled by self." self treatedMethods keysAndValuesDo: [:mRef :status | status == #disabled ifTrue: [self enableCallIn: mRef]]! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/15/2004 17:41'! preserveStatusOfFailedCalls "Do not en/dis-able failed calls (default)." changeStatusOfFailedCallsFlag := false! ! !PrimCallControllerAbstract methodsFor: 'ui controlling' stamp: 'sr 6/11/2004 06:45'! switchStored "Disables enabled and enables disabled (see corresponding method comments). " self treatedMethods keysAndValuesDo: [:mRef :status | status == #enabled ifTrue: [self disableCallIn: mRef] ifFalse: [self enableCallIn: mRef]]! ! !PrimCallControllerAbstract methodsFor: 'ui logging' stamp: 'sr 6/11/2004 04:17'! logStream: aStreamOrNil "If aStreamOrNil is notNil, there will be shown dis/en-abling prim call info; nil means no logging." logStream := aStreamOrNil! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/10/2004 21:15'! extractCallModuleNames: aMethodRef "Returns prim call and module name as call->module Association." self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 21:27'! methodsWithCall "Returns all methods containing external prim calls." self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 02:15'! methodsWithCall: primName ^ self methodsWithCall: primName enabled: nil! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 02:12'! methodsWithCall: primName intoModule: moduleNameOrNil ^ self methodsWithCall: primName intoModule: moduleNameOrNil enabled: nil! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 19:20'! methodsWithCallIntoModule: moduleNameOrNil ^ self methodsWithCallIntoModule: moduleNameOrNil enabled: nil! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 19:30'! methodsWithCallIntoModule: moduleNameOrNil forClass: class ^ self methodsWithCallIntoModule: moduleNameOrNil forClasses: {class}! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 19:30'! methodsWithCallIntoModule: moduleNameOrNil forClasses: classes ^ self methodsWithCallIntoModule: moduleNameOrNil forClasses: classes enabled: nil! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 21:36'! methodsWithCompiledCall "Returns all methods containing compiled in external prim calls. If the by compilation subclass has disabled some, this method does *not* return all methods containing prim calls (use >>methodsWithCall in this case). " ^ (SystemNavigation new allMethodsSelect: [:method | method primitive = 117]) reject: [:method | method actualClass == ProtoObject]! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 21:28'! methodsWithDisabledCall "Returns all methods containing disabled external prim calls." self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:24'! methodsWithDisabledCall: primName ^ self methodsWithCall: primName enabled: false! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:25'! methodsWithDisabledCall: primName intoModule: moduleNameOrNil ^ self methodsWithCall: primName intoModule: moduleNameOrNil enabled: false! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:25'! methodsWithDisabledCallIntoModule: moduleNameOrNil ^ self methodsWithCallIntoModule: moduleNameOrNil enabled: false! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:24'! methodsWithDisabledCallIntoModule: moduleNameOrNil forClass: class ^ self methodsWithDisabledCallIntoModule: moduleNameOrNil forClasses: {class}! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:20'! methodsWithDisabledCallIntoModule: moduleNameOrNil forClasses: classes ^ self methodsWithCallIntoModule: moduleNameOrNil forClasses: classes enabled: false! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/14/2004 21:28'! methodsWithEnabledCall "Returns all methods containing enabled external prim calls." ^ self methodsWithCompiledCall select: [:mRef | (mRef compiledMethod literals first at: 4) >= 0]! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:15'! methodsWithEnabledCall: primName ^ self methodsWithCall: primName enabled: true! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:16'! methodsWithEnabledCall: primName intoModule: moduleNameOrNil ^ self methodsWithCall: primName intoModule: moduleNameOrNil enabled: true! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:11'! methodsWithEnabledCallIntoModule: moduleNameOrNil ^ self methodsWithCallIntoModule: moduleNameOrNil enabled: true! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 05:46'! methodsWithEnabledCallIntoModule: moduleNameOrNil forClass: class ^ self methodsWithEnabledCallIntoModule: moduleNameOrNil forClasses: {class}! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:07'! methodsWithEnabledCallIntoModule: moduleNameOrNil forClasses: classes ^ self methodsWithCallIntoModule: moduleNameOrNil forClasses: classes enabled: true! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 20:47'! methodsWithFailedCall "Returns all methods containing failed external prim calls." ^ self methodsWithCompiledCall select: self blockSelectFailedCall! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 01:40'! methodsWithFailedCallForClass: class ^ class selectors collect: [:sel | MethodReference new setStandardClass: class methodSymbol: sel] thenSelect: [:mRef | self existsFailedCallIn: mRef]! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 01:44'! methodsWithFailedCallForClasses: classes | result | result := OrderedCollection new. classes do: [:class | result addAll: (self methodsWithFailedCallForClass: class)]. ^ result! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 19:58'! methodsWithFailedCallIntoModule: moduleNameOrNil ^ self methodsWithFailedCall select: (self blockSelectModuleName: moduleNameOrNil)! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 02:19'! methodsWithFailedCallIntoModule: moduleNameOrNil forClass: class ^ self methodsWithFailedCallIntoModule: moduleNameOrNil forClasses: {class}! ! !PrimCallControllerAbstract methodsFor: 'ui querying' stamp: 'sr 6/15/2004 19:58'! methodsWithFailedCallIntoModule: moduleNameOrNil forClasses: classes ^ (self methodsWithFailedCallForClasses: classes) select: (self blockSelectModuleName: moduleNameOrNil)! ! !PrimCallControllerAbstract methodsFor: 'ui testing' stamp: 'sr 6/11/2004 07:31'! existsCallIn: aMethodRef self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'ui testing' stamp: 'sr 6/9/2004 02:12'! existsDisabledCallIn: aMethodRef self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'ui testing' stamp: 'sr 6/11/2004 06:34'! existsEnabledCallIn: aMethodRef ^ (self existsCompiledCallIn: aMethodRef) and: [(aMethodRef compiledMethod literals first at: 4) >= 0]! ! !PrimCallControllerAbstract methodsFor: 'ui testing' stamp: 'sr 6/15/2004 20:46'! existsFailedCallIn: aMethodRef ^ (self existsCompiledCallIn: aMethodRef) and: [self blockSelectFailedCall value: aMethodRef]! ! !PrimCallControllerAbstract methodsFor: 'private' stamp: 'sr 6/10/2004 21:32'! extractCallModuleNamesFromLiterals: aMethodRef | firstLiteral | firstLiteral := aMethodRef compiledMethod literals first. ^ (firstLiteral at: 2) -> (firstLiteral at: 1)! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 19:49'! blockSelectCallName: callName ^ [:mRef | (self extractCallModuleNames: mRef) key = callName]! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 20:45'! blockSelectFailedCall "Precondition: mRef references compiledCall." ^ [:mRef | (mRef compiledMethod literals first at: 4) = -1]! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 19:50'! blockSelectModuleName: moduleNameOrNil ^ [:mRef | (self extractCallModuleNames: mRef) value = moduleNameOrNil]! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 17:30'! changeCallCompiledMethod: aCompiledMethod enable: enableFlag "Enables disabled or disables enabled external prim call by recompiling method with prim call taken from comment." | who methodRef | who := aCompiledMethod who. methodRef := MethodReference new setStandardClass: (who at: 1) methodSymbol: (who at: 2). enableFlag ifTrue: [self enableCallIn: methodRef] ifFalse: [self disableCallIn: methodRef]! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 17:31'! changeCallMethod: selector class: classOrSymbol enable: enableFlag "Enables disabled or disables enabled external prim call by recompiling method with prim call taken from comment." | methodRef | methodRef := MethodReference new setStandardClass: (classOrSymbol isSymbol ifTrue: [Smalltalk at: classOrSymbol] ifFalse: [classOrSymbol]) methodSymbol: selector. enableFlag ifTrue: [self enableCallIn: methodRef] ifFalse: [self disableCallIn: methodRef]! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/11/2004 06:31'! existsCompiledCallIn: aMethodRef "This just means that there is a compiled in external prim call: from the by compiler subclass point of view disabled prim calls not visible by this method are also prim calls." ^ aMethodRef compiledMethod primitive = 117! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 19:59'! methodsWithCall: callName enabled: enabledFlag ^ (self methodsWithCallEnabled: enabledFlag) select: (self blockSelectCallName: callName)! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 20:24'! methodsWithCall: callName intoModule: moduleNameOrNil enabled: enabledFlag ^ ((self methodsWithCallEnabled: enabledFlag) select: (self blockSelectCallName: callName)) select: (self blockSelectModuleName: moduleNameOrNil)! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/14/2004 19:17'! methodsWithCallEnabled: enabledFlag ^ enabledFlag ifNil: [self methodsWithCall] ifNotNil: [enabledFlag ifTrue: [self methodsWithEnabledCall] ifFalse: [self methodsWithDisabledCall]]! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/14/2004 19:19'! methodsWithCallForClass: class enabled: enabledFlag ^ class selectors collect: [:sel | MethodReference new setStandardClass: class methodSymbol: sel] thenSelect: (enabledFlag ifNil: [[:mRef | self existsCallIn: mRef]] ifNotNil: [enabledFlag ifTrue: [[:mRef | self existsEnabledCallIn: mRef]] ifFalse: [[:mRef | self existsDisabledCallIn: mRef]]])! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/13/2004 20:00'! methodsWithCallForClasses: classes enabled: enabledFlag | result | result := OrderedCollection new. classes do: [:class | result addAll: (self methodsWithCallForClass: class enabled: enabledFlag)]. ^ result! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 19:55'! methodsWithCallIntoModule: moduleNameOrNil enabled: enabledFlag ^ (self methodsWithCallEnabled: enabledFlag) select: (self blockSelectModuleName: moduleNameOrNil)! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/15/2004 19:57'! methodsWithCallIntoModule: moduleNameOrNil forClasses: classes enabled: enabledFlag ^ (self methodsWithCallForClasses: classes enabled: enabledFlag) select: (self blockSelectModuleName: moduleNameOrNil)! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/14/2004 01:34'! privateDisableCallIn: aMethodRefWithExternalCall "Disables enabled or failed external prim call." self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/14/2004 01:33'! privateEnableCallIn: aMethodRefWithExternalCall "Enables disabled external prim call." self subclassResponsibility! ! !PrimCallControllerAbstract methodsFor: 'private user interface' stamp: 'sr 6/14/2004 02:09'! privateEnableViaLiteralIn: aMethodRef "Enables external prim call by filling function ref literal with zero for 'non called'." aMethodRef compiledMethod literals first at: 4 put: 0. Object flushCache! ! !PCCByCompilation methodsFor: 'string constants' stamp: 'sr 6/7/2004 03:30'! comment ^ '{prim disabled by ', self className, '} '! ! !PCCByCompilation methodsFor: 'string constants' stamp: 'sr 6/7/2004 03:31'! disabledPrimStartString ^ '"', self comment, self enabledPrimStartString! ! !PCCByCompilation methodsFor: 'string constants' stamp: 'sr 6/7/2004 03:31'! disabledPrimStopChar "end of disabling comment" ^ $"! ! !PCCByCompilation methodsFor: 'string constants' stamp: 'sr 6/7/2004 03:31'! enabledPrimStartString ^ '! ! !PCCByCompilation methodsFor: 'ui querying' stamp: 'sr 6/11/2004 06:33'! extractCallModuleNames: aMethodRef ^ (self existsCompiledCallIn: aMethodRef) ifTrue: [self extractCallModuleNamesFromLiterals: aMethodRef] ifFalse: [| src | "try source" "higher priority to avoid source file accessing errors" [src := aMethodRef sourceString] valueAt: self higherPriority. self extractCallNamesFromPrimString: ((self extractDisabledPrimStringFrom: src) ifNil: ["no disabled prim string found" ^ nil]) first]! ! !PCCByCompilation methodsFor: 'ui querying' stamp: 'sr 6/14/2004 21:38'! methodsWithCall "Expensive!! For just querying the system unaffected by an instance of this class use PCCByLiterals instead." ^ self methodsWithCompiledCall , self methodsWithDisabledCall! ! !PCCByCompilation methodsFor: 'ui querying' stamp: 'sr 6/15/2004 04:51'! methodsWithDisabledCall "Answer a SortedCollection of all the methods that contain, in source code, the substring indicating a disabled prim." "The alternative implementation ^ SystemNavigation new allMethodsWithSourceString: self disabledPrimStartString matchCase: true also searches in class comments." | list classCount string | string := self disabledPrimStartString. list := Set new. 'Searching all method source code...' displayProgressAt: Sensor cursorPoint from: 0 to: Smalltalk classNames size * 2 "classes with their metaclasses" during: [:bar | classCount := 0. SystemNavigation default allBehaviorsDo: [:class | bar value: (classCount := classCount + 1). class selectorsDo: [:sel | | src | "higher priority to avoid source file accessing errors" [src := class sourceCodeAt: sel] valueAt: self higherPriority. (src findString: string startingAt: 1 caseSensitive: true) > 0 ifTrue: [sel == #DoIt ifFalse: [list add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]]]. ^ list asSortedCollection! ! !PCCByCompilation methodsFor: 'ui testing' stamp: 'sr 6/11/2004 07:26'! existsCallIn: aMethodRef "Here existsCompiledCallIn: (see also comment there) is sufficient to query for enabled and failed, but not for disabled prim calls: so check for disabled ones in sources, too." ^ (self existsCompiledCallIn: aMethodRef) or: [self existsDisabledCallIn: aMethodRef]! ! !PCCByCompilation methodsFor: 'ui testing' stamp: 'sr 6/11/2004 07:07'! existsDisabledCallIn: aMethodRef | src | ^ (self existsCompiledCallIn: aMethodRef) not and: ["higher priority to avoid source file accessing errors" [src := aMethodRef sourceString] valueAt: self higherPriority. self methodSourceContainsDisabledCall: src]! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:26'! disabled2EnabledPrimMethodString: aSourceString | start stop primString extract | extract := self extractDisabledPrimStringFrom: aSourceString. primString := extract at: 1. start := extract at: 2. stop := start + primString size - 1. ^ aSourceString copyReplaceFrom: start to: stop with: (self disabled2EnabledPrimString: primString)! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:26'! disabled2EnabledPrimString: aDisabledPrimString "remove comment quotes and comment after first comment quote" | enabledPrimString | enabledPrimString := aDisabledPrimString copyFrom: self comment size + 2 to: aDisabledPrimString size - 1. ^ enabledPrimString! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:28'! enabled2DisabledPrimMethodString: aSourceString | start stop primString extract | extract := self extractEnabledPrimStringFrom: aSourceString. primString := extract at: 1. start := extract at: 2. stop := start + primString size - 1. ^ aSourceString copyReplaceFrom: start to: stop with: (self enabled2DisabledPrimString: primString)! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:28'! enabled2DisabledPrimString: anEnabledPrimString | disabledPrimString | disabledPrimString := '"' , self comment , anEnabledPrimString , '"'. ^ disabledPrimString! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:28'! extractCallNamesFromPrimString: aString "method works for both enabled and disabled prim strings" " (tokens at: 4 ifAbsent: [nil])! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/11/2004 07:10'! extractDisabledPrimStringFrom: aSourceString | startString start stop | startString := self disabledPrimStartString. start := aSourceString findString: startString. start = 0 ifTrue: [^ nil]. stop := aSourceString indexOf: self disabledPrimStopChar startingAt: start + startString size. stop = 0 ifTrue: [^ nil]. ^ {aSourceString copyFrom: start to: stop. start}! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:29'! extractEnabledPrimStringFrom: aSourceString | startString start stop | startString := self enabledPrimStartString. start := aSourceString findString: startString. start = 0 ifTrue: [^ nil]. stop := aSourceString indexOf: self enabledPrimStopChar startingAt: start + startString size. stop = 0 ifTrue: [^ nil]. ^ {aSourceString copyFrom: start to: stop. start}! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/7/2004 03:29'! higherPriority "this priority seems to be necessary to avoid source file accessing errors" ^ Processor userSchedulingPriority + 1! ! !PCCByCompilation methodsFor: 'private' stamp: 'sr 6/11/2004 07:06'! methodSourceContainsDisabledCall: methodSource ^ (methodSource findString: self disabledPrimStartString) ~= 0! ! !PCCByCompilation methodsFor: 'private user interface' stamp: 'sr 6/14/2004 01:37'! privateDisableCallIn: aMethodRef "Disables enabled or failed external prim call by recompiling method with prim call commented out, will be called by superclass." | src newMethodSource | "higher priority to avoid source file accessing errors" [src := aMethodRef sourceString] valueAt: self higherPriority. newMethodSource := self enabled2DisabledPrimMethodString: src. "higher priority to avoid source file accessing errors" [aMethodRef actualClass compile: newMethodSource classified: (aMethodRef actualClass whichCategoryIncludesSelector: aMethodRef methodSymbol) notifying: nil] valueAt: self higherPriority! ! !PCCByCompilation methodsFor: 'private user interface' stamp: 'sr 6/14/2004 02:10'! privateEnableCallIn: aMethodRef "Enables disabled external prim call by recompiling method with prim call taken from disabling comment, will be called by superclass." | src newMethodSource | "higher priority to avoid source file accessing errors" [src := aMethodRef sourceString] valueAt: self higherPriority. newMethodSource := self disabled2EnabledPrimMethodString: src. "higher priority to avoid source file accessing errors" [aMethodRef actualClass compile: newMethodSource classified: (aMethodRef actualClass whichCategoryIncludesSelector: aMethodRef methodSymbol) notifying: nil] valueAt: self higherPriority! ! !PCCByLiterals methodsFor: 'ui querying' stamp: 'sr 6/11/2004 07:04'! extractCallModuleNames: aMethodRef ^ (self existsCallIn: aMethodRef) ifTrue: [self extractCallModuleNamesFromLiterals: aMethodRef]! ! !PCCByLiterals methodsFor: 'ui querying' stamp: 'sr 6/11/2004 07:05'! methodsWithCall ^ self methodsWithCompiledCall! ! !PCCByLiterals methodsFor: 'ui querying' stamp: 'sr 6/14/2004 21:24'! methodsWithDisabledCall ^ self methodsWithCompiledCall select: [:mRef | (mRef compiledMethod literals first at: 4) = -2]! ! !PCCByLiterals methodsFor: 'ui testing' stamp: 'sr 6/11/2004 07:04'! existsCallIn: aMethodRef "Here >>existsCompiledCallIn: (see also comment there) is sufficient to query for all enabled, failed and disabled prim calls; for the by compiler version it is not sufficient for disabled ones." ^ self existsCompiledCallIn: aMethodRef! ! !PCCByLiterals methodsFor: 'ui testing' stamp: 'sr 6/11/2004 07:30'! existsDisabledCallIn: aMethodRef ^ (self existsCompiledCallIn: aMethodRef) and: [(aMethodRef compiledMethod literals first at: 4) = -2]! ! !PCCByLiterals methodsFor: 'private user interface' stamp: 'sr 6/14/2004 01:35'! privateDisableCallIn: aMethodRef "Disables enabled or failed external prim call by filling function ref literal with special fail value, will be called by superclass." aMethodRef compiledMethod literals first at: 4 put: -2! ! !PCCByLiterals methodsFor: 'private user interface' stamp: 'sr 6/14/2004 02:07'! privateEnableCallIn: aMethodRef "Enables disabled external prim call." self privateEnableViaLiteralIn: aMethodRef! ! !PrimCallControllerAbstractTest methodsFor: 'helper' stamp: 'sr 6/14/2004 22:56'! avoidSlowTest ^ doNotMakeSlowTestsFlag and: [pcc class = PCCByCompilation]! ! !PrimCallControllerAbstractTest methodsFor: 'helper' stamp: 'sr 6/7/2004 08:56'! disabledCallRefs ^ self disabledCallSelectors collect: [:sel | MethodReference new setStandardClass: self class methodSymbol: sel]! ! !PrimCallControllerAbstractTest methodsFor: 'helper' stamp: 'sr 6/7/2004 08:57'! enabledCallRefs ^ self enabledCallSelectors collect: [:sel | MethodReference new setStandardClass: self class methodSymbol: sel]! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:46'! compiledMethodsToExampleModule ^ self methodSelectorsToExampleModule collect: [:sel | self class >> sel]! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/14/2004 00:11'! failedCallRef ^ MethodReference new setStandardClass: self class methodSymbol: self failedCallSelector! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:46'! methodRefsToExampleModule ^ self methodSelectorsToExampleModule collect: [:sym | MethodReference new setStandardClass: self class methodSymbol: sym]! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/7/2004 13:58'! noExternalCallRef ^ MethodReference new setStandardClass: self class methodSymbol: self noExternalCallSelector! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:47'! numOfCallsExampleModule ^ self methodSelectorsToExampleModule size! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/14/2004 23:34'! singularCallRef ^ MethodReference new setStandardClass: self class methodSymbol: self singularCallSelector! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:49'! wrongCallRef ^ MethodReference new setStandardClass: self class methodSymbol: #nonExistingCall! ! !PrimCallControllerAbstractTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:49'! wrongClassRef ^ MethodReference new setStandardClass: Integer methodSymbol: self methodSelectorsToExampleModule first! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 04:37'! setUp super setUp. pcc := self classToBeTested new. "set failed call" (self class >> self failedCallSelector) literals first at: 4 put: -1. "set it to false for some very slow tests..." doNotMakeSlowTestsFlag := true! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:54'! testChangeFailedCallFailing pcc preserveStatusOfFailedCalls. self should: [pcc enableCallIn: self failedCallRef] raise: TestResult error. self should: [pcc disableCallIn: self failedCallRef] raise: TestResult error! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 00:41'! testChangeFailedCallSucceedingDisable pcc changeStatusOfFailedCalls. pcc disableCallIn: self failedCallRef. self assert: (pcc existsDisabledCallIn: self failedCallRef). "necessary for PCCByCompilation (to make it visible for initialization again)" pcc enableCallIn: self failedCallRef! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 00:34'! testChangeFailedCallSucceedingEnable pcc changeStatusOfFailedCalls. pcc enableCallIn: self failedCallRef. self assert: (pcc existsEnabledCallIn: self failedCallRef)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 02:43'! testDisableCallsIntoModule "wrong module" self should: [pcc disableCallsIntoModule: 'totallyRandom4711'] raise: TestResult error. "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "disabling" pcc disableCallsIntoModule: self exampleModuleName. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "not enabled!!" self should: [pcc disableCallsIntoModule: self exampleModuleName] raise: TestResult error. "enabling" self methodRefsToExampleModule do: [:ref | pcc enableCallIn: ref]. "all enabled now" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not enabled!!" self should: [pcc disableCallsIntoModule: self failModuleName] raise: TestResult error. pcc changeStatusOfFailedCalls. pcc disableCallsIntoModule: self failModuleName. self assert: (pcc existsDisabledCallIn: self failedCallRef). "postcondition" pcc enableCallIn: self failedCallRef ! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:24'! testDisableCallsIntoModuleForClasses "wrong module" self should: [pcc disableCallsIntoModule: 'totallyRandom4711' forClasses: {self class}] raise: TestResult error. "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "disabling" pcc disableCallsIntoModule: self exampleModuleName forClasses: {self class}. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "not enabled!!" self should: [pcc disableCallsIntoModule: self exampleModuleName forClasses: {self class}] raise: TestResult error. "enabling" self methodRefsToExampleModule do: [:ref | pcc enableCallIn: ref]. "all enabled now" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not enabled!!" self should: [pcc disableCallsIntoModule: self failModuleName forClasses: {self class}] raise: TestResult error. pcc changeStatusOfFailedCalls. pcc disableCallsIntoModule: self failModuleName forClasses: {self class}. self assert: (pcc existsDisabledCallIn: self failedCallRef). "postcondition" pcc enableCallIn: self failedCallRef ! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 02:43'! testEnableCallsIntoModule self avoidSlowTest ifTrue: [^ self]. "wrong module" self should: [pcc enableCallsIntoModule: 'totallyRandom4711'] raise: TestResult error. "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [pcc enableCallsIntoModule: self exampleModuleName] raise: TestResult error. "disabling" self methodRefsToExampleModule do: [:ref | pcc disableCallIn: ref]. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "enabling" "now this should work" pcc enableCallsIntoModule: self exampleModuleName. "all enabled now" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [pcc enableCallsIntoModule: self failModuleName] raise: TestResult error. pcc changeStatusOfFailedCalls. pcc enableCallsIntoModule: self failModuleName. self assert: (pcc existsEnabledCallIn: self failedCallRef) ! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:43'! testEnableCallsIntoModuleForClasses "wrong module" self should: [pcc enableCallsIntoModule: 'totallyRandom4711' forClasses: {self class}] raise: TestResult error. "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [pcc enableCallsIntoModule: self exampleModuleName forClasses: {self class}] raise: TestResult error. "disabling" self methodRefsToExampleModule do: [:ref | pcc disableCallIn: ref]. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "enabling" "now this should work" pcc enableCallsIntoModule: self exampleModuleName forClasses: {self class}. "all enabled now" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [pcc enableCallsIntoModule: self failModuleName forClasses: {self class}] raise: TestResult error. pcc changeStatusOfFailedCalls. pcc enableCallsIntoModule: self failModuleName forClasses: {self class}. self assert: (pcc existsEnabledCallIn: self failedCallRef) ! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:45'! testEnableDisableCallIn | refs | refs := self methodRefsToExampleModule. "wrong call" self should: [pcc disableCallIn: self wrongCallRef] raise: TestResult error. "wrong class" self should: [pcc disableCallIn: self wrongClassRef] raise: TestResult error. "wrong call" self should: [pcc enableCallIn: self wrongCallRef] raise: TestResult error. "wrong class" self should: [pcc enableCallIn: self wrongClassRef] raise: TestResult error. "no external call" self should: [pcc enableCallIn: self noExternalCallRef] raise: TestResult error. "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [refs do: [:ref1 | pcc enableCallIn: ref1]] raise: TestResult error. "disabling" refs do: [:ref2 | pcc disableCallIn: ref2]. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "not enabled!!" self should: [refs do: [:ref3 | pcc disableCallIn: ref3]] raise: TestResult error. "enabling" "now this should work" refs do: [:ref4 | pcc enableCallIn: ref4]. "all enabled now" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "try caches" pcc disableEnabled. "all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. pcc enableDisabled. "all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 00:07'! testEnableDisableCallInCompiledMethod "Note: >>compiledMethodsToExampleModule has to be called frequently, since the CMs are changing with a successful compile!!" "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [self compiledMethodsToExampleModule do: [:cm1 | pcc enableCallInCompiledMethod: cm1]] raise: TestResult error. "disabling" self compiledMethodsToExampleModule do: [:cm2 | pcc disableCallInCompiledMethod: cm2]. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "not enabled!!" self should: [self compiledMethodsToExampleModule do: [:cm3 | pcc disableCallInCompiledMethod: cm3]] raise: TestResult error. "enabling" "now this should work" self compiledMethodsToExampleModule do: [:cm4 | pcc enableCallInCompiledMethod: cm4]. self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "try caches" pcc disableEnabled. "all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. pcc enableDisabled. "all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:57'! testEnableDisableCallInMethodClass | sels | sels := self methodSelectorsToExampleModule. "wrong call" self should: [pcc disableCallInMethod: #nonExistingCall class: self class] raise: TestResult error. "wrong class" self should: [pcc disableCallInMethod: sels first class: Integer] raise: TestResult error. "wrong call" self should: [pcc enableCallInMethod: #nonExistingCall class: self class] raise: TestResult error. "wrong class" self should: [pcc enableCallInMethod: sels first class: Integer] raise: TestResult error. self should: [pcc enableCallInMethod: self noExternalCallSelector class: self class] raise: TestResult error. "precondition: all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "not disabled!!" self should: [sels do: [:sel1 | pcc enableCallInMethod: sel1 class: self class]] raise: TestResult error. "disabling" sels do: [:sel2 | pcc disableCallInMethod: sel2 class: self class]. "now all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. "not enabled!!" self should: [sels do: [:sel3 | pcc disableCallInMethod: sel3 class: self class]] raise: TestResult error. "enabling" "now this should work" sels do: [:sel4 | pcc enableCallInMethod: sel4 class: self class]. "all enabled now" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. "try caches" pcc disableEnabled. "all disabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. pcc enableDisabled. "all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:46'! testExistsCallIn self deny: (pcc existsCallIn: self noExternalCallRef). self enabledCallRefs , self disabledCallRefs , {self failedCallRef} do: [:callRef | self assert: (pcc existsCallIn: callRef)]! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:47'! testExistsDisabledCallIn self deny: (pcc existsDisabledCallIn: self noExternalCallRef). self deny: (pcc existsDisabledCallIn: self failedCallRef). self enabledCallRefs do: [:callRef | self deny: (pcc existsDisabledCallIn: callRef)]. self disabledCallRefs do: [:disabledRef | self assert: (pcc existsDisabledCallIn: disabledRef)]! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:48'! testExistsEnabledCallIn self deny: (pcc existsEnabledCallIn: self noExternalCallRef). self deny: (pcc existsEnabledCallIn: self failedCallRef). self enabledCallRefs do: [:callRef | self assert: (pcc existsEnabledCallIn: callRef)]. self disabledCallRefs do: [:disabledRef | self deny: (pcc existsEnabledCallIn: disabledRef)]! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:49'! testExistsFailedCallIn self deny: (pcc existsFailedCallIn: self noExternalCallRef). self enabledCallRefs , self disabledCallRefs do: [:callRef | self deny: (pcc existsFailedCallIn: callRef)]. self assert: (pcc existsFailedCallIn: self failedCallRef)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 23:25'! testMethodsWithCallAndMethodsWithDisabledCall | methodRefs disabledMethodRefs enabledMethodRefs failedMethodRefs | self avoidSlowTest ifTrue: [^ self]. disabledMethodRefs := pcc methodsWithDisabledCall. self assert: disabledMethodRefs size > 0. enabledMethodRefs := pcc methodsWithEnabledCall. self assert: enabledMethodRefs size > 0. failedMethodRefs := pcc methodsWithFailedCall. self assert: failedMethodRefs size > 0. methodRefs := pcc methodsWithCall. self assert: methodRefs size = (disabledMethodRefs size + enabledMethodRefs size + failedMethodRefs size)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 22:54'! testMethodsWithCallIntoModule | methodRefs | self avoidSlowTest ifTrue: [^ self]. "precondition: all enabled" pcc disableCallIn: self methodRefsToExampleModule first. methodRefs := pcc methodsWithCallIntoModule: self exampleModuleName. self assert: methodRefs size = self numOfCallsExampleModule. "postcondition" pcc enableCallIn: self methodRefsToExampleModule first! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 22:32'! testMethodsWithCallIntoModuleForClass "precondition: all enabled" | methodRefs | pcc disableCallIn: self methodRefsToExampleModule first. methodRefs := pcc methodsWithCallIntoModule: self exampleModuleName forClass: self class. self assert: methodRefs size = self numOfCallsExampleModule. "postcondition" pcc enableCallIn: self methodRefsToExampleModule first. methodRefs := pcc methodsWithCallIntoModule: nil forClass: self class. self assert: (methodRefs size = 2 and: [| methodCoreStrings | methodCoreStrings := methodRefs collect: [:mRef | mRef methodSymbol allButFirst asString]. (methodCoreStrings includes: 'ExternalCallWithoutModule') and: [methodCoreStrings includes: 'DisabledExternalCallWithoutModule']])! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 22:31'! testMethodsWithCallIntoModuleForClasses "precondition: all enabled" | methodRefs | pcc disableCallIn: self methodRefsToExampleModule first. methodRefs := pcc methodsWithCallIntoModule: self exampleModuleName forClasses: {self class}. self assert: methodRefs size = self numOfCallsExampleModule. "postcondition" pcc enableCallIn: self methodRefsToExampleModule first. methodRefs := pcc methodsWithCallIntoModule: nil forClasses: {self class}. self assert: (methodRefs size = 2 and: [| methodCoreStrings | methodCoreStrings := methodRefs collect: [:mRef | mRef methodSymbol allButFirst asString]. (methodCoreStrings includes: 'ExternalCallWithoutModule') and: [methodCoreStrings includes: 'DisabledExternalCallWithoutModule']])! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:36'! testMethodsWithCallX | methodRefs | self avoidSlowTest ifTrue: [^ self]. methodRefs := pcc methodsWithCall: self singularCallName. self assert: methodRefs size = 1! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:34'! testMethodsWithCallXIntoModule | methodRefs | self avoidSlowTest ifTrue: [^ self]. methodRefs := pcc methodsWithCall: self singularCallName intoModule: self moduleNameWithSingularCallName. self assert: methodRefs size = 1. methodRefs := pcc methodsWithCall: self singularCallName intoModule: self moduleNameNotWithSingularCallName. self assert: methodRefs isEmpty! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 23:04'! testMethodsWithDisabledCallIntoModule | methodRefs | self avoidSlowTest ifTrue: [^ self]. "precondition: all enabled" pcc disableCallIn: self methodRefsToExampleModule first. methodRefs := pcc methodsWithDisabledCallIntoModule: self exampleModuleName. self assert: methodRefs size = 1. "postcondition" pcc enableCallIn: self methodRefsToExampleModule first! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 22:37'! testMethodsWithDisabledCallIntoModuleForClass "precondition: all enabled" | methodRefs | self methodRefsToExampleModule do: [:ref | pcc disableCallIn: ref]. methodRefs := pcc methodsWithDisabledCallIntoModule: self exampleModuleName forClass: self class. self assert: methodRefs size = self numOfCallsExampleModule. "postcondition" self methodRefsToExampleModule do: [:ref | pcc enableCallIn: ref]. methodRefs := pcc methodsWithDisabledCallIntoModule: nil forClass: self class. self assert: methodRefs size = 1 & (methodRefs first methodSymbol allButFirst = 'DisabledExternalCallWithoutModule')! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:46'! testMethodsWithDisabledCallIntoModuleForClasses "precondition: all enabled" | methodRefs | self methodRefsToExampleModule do: [:ref | pcc disableCallIn: ref]. methodRefs := pcc methodsWithDisabledCallIntoModule: self exampleModuleName forClasses: {self class}. self assert: methodRefs size = self numOfCallsExampleModule. "postcondition" self methodRefsToExampleModule do: [:ref | pcc enableCallIn: ref]. methodRefs := pcc methodsWithDisabledCallIntoModule: nil forClasses: {self class}. self assert: methodRefs size = 1 & (methodRefs first methodSymbol allButFirst = 'DisabledExternalCallWithoutModule')! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 23:38'! testMethodsWithDisabledCallX | methodRefs | self avoidSlowTest ifTrue: [^ self]. "precondition: all enabled" pcc disableCallIn: self singularCallRef. methodRefs := pcc methodsWithDisabledCall: self singularCallName. self assert: methodRefs size = 1 & (methodRefs first methodSymbol = self singularCallName). "postcondition" pcc enableCallIn: self singularCallRef! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 23:42'! testMethodsWithDisabledCallXIntoModule "precondition: all enabled" | methodRefs | self avoidSlowTest ifTrue: [^ self]. "precondition: all enabled" pcc disableCallIn: self singularCallRef. methodRefs := pcc methodsWithDisabledCall: self singularCallName intoModule: self moduleNameWithSingularCallName. self assert: methodRefs size = 1. methodRefs := pcc methodsWithDisabledCall: self singularCallName intoModule: self moduleNameNotWithSingularCallName. self assert: methodRefs isEmpty. "postcondition" pcc enableCallIn: self singularCallRef! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 07:13'! testMethodsWithEnabledCall | methodRefs | methodRefs := pcc methodsWithEnabledCall. self assert: methodRefs size > 0! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 07:17'! testMethodsWithEnabledCallIntoModule | methodRefs | methodRefs := pcc methodsWithEnabledCallIntoModule: self exampleModuleName. self assert: methodRefs size = self numOfCallsExampleModule! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/14/2004 22:43'! testMethodsWithEnabledCallIntoModuleForClass "precondition: all enabled" | methodRefs | methodRefs := pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class. self assert: methodRefs size = self numOfCallsExampleModule. methodRefs := pcc methodsWithEnabledCallIntoModule: nil forClass: self class. self assert: methodRefs size = 1 & (methodRefs first methodSymbol allButFirst = 'ExternalCallWithoutModule')! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 07:12'! testMethodsWithEnabledCallIntoModuleForClasses "precondition: all enabled" | methodRefs | methodRefs := pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClasses: {self class}. self assert: methodRefs size = self numOfCallsExampleModule. methodRefs := pcc methodsWithEnabledCallIntoModule: nil forClasses: {self class}. self assert: methodRefs size = 1 & (methodRefs first methodSymbol allButFirst = 'ExternalCallWithoutModule')! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:16'! testMethodsWithEnabledCallX | methodRefs | methodRefs := pcc methodsWithEnabledCall: self singularCallName. self assert: methodRefs size = 1 & (methodRefs first methodSymbol = self singularCallName)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 07:17'! testMethodsWithEnabledCallXIntoModule "precondition: all enabled" | methodRefs | methodRefs := pcc methodsWithEnabledCall: self singularCallName intoModule: self moduleNameWithSingularCallName. self assert: methodRefs size = 1. methodRefs := pcc methodsWithEnabledCall: self singularCallName intoModule: self moduleNameNotWithSingularCallName. self assert: methodRefs isEmpty! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:07'! testMethodsWithFailedCall | methodRefs | methodRefs := pcc methodsWithFailedCall. self assert: methodRefs size >= 1 & ((methodRefs select: [:mRef | mRef methodSymbol = self failedCallSelector]) size = 1)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:11'! testMethodsWithFailedCallForClass | methodRefs | methodRefs := pcc methodsWithFailedCallForClass: self class. self assert: methodRefs size = 1 & (methodRefs asArray first methodSymbol = self failedCallSelector)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 02:54'! testMethodsWithFailedCallIntoModule | methodRefs | methodRefs := pcc methodsWithFailedCallIntoModule: self failModuleName. self assert: methodRefs size = 1 & (methodRefs first methodSymbol = self failedCallSelector)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/15/2004 03:13'! testMethodsWithFailedCallIntoModuleForClass | methodRefs | methodRefs := pcc methodsWithFailedCallIntoModule: self failModuleName forClass: self class. self assert: methodRefs size = 1 & (methodRefs first methodSymbol = self failedCallSelector)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:58'! testSwitchPrimCallOffOn | res | pcc disableCallInMethod: self realExternalCallOrPrimitiveFailedSelector class: self class. self should: [self perform: self realExternalCallOrPrimitiveFailedSelector] raise: TestResult error. pcc enableCallInMethod: self realExternalCallOrPrimitiveFailedSelector class: self class. self shouldnt: [res := self perform: self realExternalCallOrPrimitiveFailedSelector] raise: TestResult error. self assert: res isString! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:46'! testSwitchStored | refs | "all enabled, precondition" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. refs := self methodRefsToExampleModule. "fill cache" refs do: [:ref | pcc disableCallIn: ref]. "enable one" pcc enableCallIn: refs first. self assert: (pcc existsEnabledCallIn: refs first). self assert: (pcc existsDisabledCallIn: refs second). "switching" pcc switchStored. "now the checks go vice versa" self assert: (pcc existsDisabledCallIn: refs first). self assert: (pcc existsEnabledCallIn: refs second). pcc enableCallIn: refs first. self assert: (pcc existsEnabledCallIn: refs first)! ! !PrimCallControllerAbstractTest methodsFor: 'tests' stamp: 'sr 6/11/2004 06:46'! testTryCaches | refs | "all enabled, precondition" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. refs := self methodRefsToExampleModule. "fill cache" refs do: [:ref | pcc disableCallIn: ref]. "try caches" pcc enableDisabled. "all enabled" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule. pcc disableEnabled. self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = 0. pcc enableDisabled. "all enabled, postcondition" self assert: (pcc methodsWithEnabledCallIntoModule: self exampleModuleName forClass: self class) size = self numOfCallsExampleModule! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/11/2004 05:22'! classToBeTested ^ PCCByCompilation! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:36'! disabledCallSelectors ^ #(#cDisabledRealExternalCall #cDisabledRealExternalCallNaked #cDisabledRealExternalCallOrPrimitiveFailed #cDisabledExternalCallWithoutModule )! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:34'! enabledCallSelectors ^ #(#cRealExternalCall #cRealExternalCallNaked #cRealExternalCallOrPrimitiveFailed #cExternalCallWithoutModule )! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:44'! exampleModuleName ^ 'CPCCT'! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/15/2004 02:42'! failModuleName ^ 'CFailModule'! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/14/2004 00:14'! failedCallSelector ^ #cFailedCall! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:40'! methodSelectorsToExampleModule ^ #(#cExternalCall1 #cExternalCall2 )! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:47'! moduleNameNotWithSingularCallName ^ 'CNotOne'! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:47'! moduleNameWithSingularCallName ^ 'COne'! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 09:52'! noExternalCallSelector ^ #cNoExternalCall! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:28'! realExternalCallOrPrimitiveFailedSelector ^ #cRealExternalCallOrPrimitiveFailed! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:54'! singularCallName "occurrs exactly once as prim call name in >>cSingularExternalCall" ^ 'cSingularExternalCall'! ! !PCCByCompilationTest methodsFor: 'constants' stamp: 'sr 6/14/2004 23:33'! singularCallSelector ^ #cSingularExternalCall! ! !PCCByCompilationTest methodsFor: 'example module' stamp: 'sr 6/15/2004 20:49'! cExternalCall1 ! ! !PCCByCompilationTest methodsFor: 'example module' stamp: 'sr 6/15/2004 20:49'! cExternalCall2 self primitiveFailed! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/11/2004 05:36'! cDisabledExternalCallWithoutModule "{prim disabled by PCCByCompilation} " ^ 'Hello World!!'! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 23:54'! cDisabledRealExternalCall "{prim disabled by PCCByCompilation} " ^ 'Hello World!!'! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 23:54'! cDisabledRealExternalCallNaked "{prim disabled by PCCByCompilation} "! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 23:54'! cDisabledRealExternalCallOrPrimitiveFailed "{prim disabled by PCCByCompilation} " self primitiveFailed! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/7/2004 09:48'! cExternalCallWithoutModule ^ 'Hello World!!'! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/15/2004 20:48'! cFailedCall ^ 'failed call'! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/7/2004 09:48'! cNoExternalCall ^ 'Hello World!!'! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! cRealExternalCall ^ 'Hello World!!'! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! cRealExternalCallNaked ! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/15/2004 20:49'! cRealExternalCallOrPrimitiveFailed self primitiveFailed! ! !PCCByCompilationTest methodsFor: 'test methods' stamp: 'sr 6/15/2004 04:35'! cSingularExternalCall ^ 'Hello World!!'! ! !PCCByLiteralsTest methodsFor: 'tests' stamp: 'sr 6/7/2004 11:30'! setUp super setUp. "disable external calls" (self class selectors select: [:sel | sel beginsWith: 'lDisabled']) do: [:sel | (self class >> sel) literals first at: 4 put: -2]! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/11/2004 05:23'! classToBeTested ^ PCCByLiterals! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:37'! disabledCallSelectors ^ #(#lDisabledRealExternalCall #lDisabledRealExternalCallNaked #lDisabledRealExternalCallOrPrimitiveFailed #lDisabledExternalCallWithoutModule )! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:34'! enabledCallSelectors ^ #(#lRealExternalCall #lRealExternalCallNaked #lRealExternalCallOrPrimitiveFailed #lExternalCallWithoutModule )! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:45'! exampleModuleName ^ 'LPCCT'! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/15/2004 02:42'! failModuleName ^ 'LFailModule'! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/14/2004 00:12'! failedCallSelector ^ #lFailedCall! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:41'! methodSelectorsToExampleModule ^ #(#lExternalCall1 #lExternalCall2 )! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:47'! moduleNameNotWithSingularCallName ^ 'LNotOne'! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 08:47'! moduleNameWithSingularCallName ^ 'LOne'! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:16'! noExternalCallSelector ^ #lNoExternalCall! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:29'! realExternalCallOrPrimitiveFailedSelector ^ #lRealExternalCallOrPrimitiveFailed! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/7/2004 10:54'! singularCallName "occurrs exactly once as prim call name in >>lSingularExternalCall" ^ 'lSingularExternalCall'! ! !PCCByLiteralsTest methodsFor: 'constants' stamp: 'sr 6/14/2004 23:32'! singularCallSelector ^ #lSingularExternalCall! ! !PCCByLiteralsTest methodsFor: 'example module' stamp: 'sr 6/7/2004 08:39'! lExternalCall1 ! ! !PCCByLiteralsTest methodsFor: 'example module' stamp: 'sr 6/7/2004 08:39'! lExternalCall2 self primitiveFailed! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/7/2004 08:51'! lDisabledExternalCallWithoutModule ^ 'Hello World!!'! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! lDisabledRealExternalCall ^ 'Hello World!!'! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! lDisabledRealExternalCallNaked ! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! lDisabledRealExternalCallOrPrimitiveFailed "primitiveExternalCall" self primitiveFailed! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/7/2004 09:59'! lExternalCallWithoutModule "primitiveExternalCall" ^ 'Hello World!!'! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/15/2004 02:41'! lFailedCall ^ 'failed call'! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/7/2004 09:57'! lNoExternalCall ^ 'Hello World!!'! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! lRealExternalCall ^ 'Hello World!!'! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! lRealExternalCallNaked ! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/13/2004 21:14'! lRealExternalCallOrPrimitiveFailed self primitiveFailed! ! !PCCByLiteralsTest methodsFor: 'test methods' stamp: 'sr 6/7/2004 10:52'! lSingularExternalCall ^ 'Hello World!!'! ! !PrimCallControllerAbstractTest class methodsFor: 'Testing' stamp: 'sr 6/7/2004 11:59'! isAbstract ^ true! ! !PCCByCompilationTest class methodsFor: 'Testing' stamp: 'sr 6/7/2004 12:01'! isAbstract ^ false! ! !PCCByLiteralsTest class methodsFor: 'Testing' stamp: 'sr 6/7/2004 12:01'! isAbstract ^ false! !