SystemOrganization addCategory: #'BogusInfo-Base'! SystemOrganization addCategory: #'BogusInfo-Testing'! TestResource subclass: #BogusSnapshotResource instanceVariableNames: 'snapshot' classVariableNames: '' poolDictionaries: '' category: 'BogusInfo-Testing'! !BogusSnapshotResource methodsFor: 'accessing' stamp: 'cwp 9/8/2004 23:46'! package ^ MCPackage named: 'Bogus'! ! !BogusSnapshotResource methodsFor: 'restoring' stamp: 'cwp 9/9/2004 00:23'! restoreClass: aClassName | definition | definition _ snapshot definitions detect: [:ea | ea isClassDefinition and: [ea className = aClassName]] ifNone: [^ self removeClass: aClassName]. definition load! ! !BogusSnapshotResource methodsFor: 'restoring' stamp: 'cwp 9/9/2004 00:26'! restoreMethod: ref | definition | definition _ snapshot definitions detect: [:ea | ea isMethodDefinition and: [ea className = ref classSymbol] and: [ea selector = ref methodSymbol]] ifNone: [^ self removeMethod: ref]. definition load! ! !BogusSnapshotResource methodsFor: 'running' stamp: 'cwp 6/4/2006 19:12'! setUp snapshot _ self package snapshot.! ! !BogusSnapshotResource methodsFor: 'accessing' stamp: 'cwp 9/9/2004 01:18'! snapshot ^ snapshot! ! Object subclass: #BogusDamage instanceVariableNames: 'references renames' classVariableNames: '' poolDictionaries: '' category: 'BogusInfo-Testing'! !BogusDamage class methodsFor: 'as yet unclassified' stamp: 'cwp 2/28/2006 18:16'! new ^ self basicNew initialize! ! !BogusDamage methodsFor: 'recording' stamp: 'cwp 9/9/2004 01:32'! add: aSelector ofClass: aClassName self add: aSelector ofClass: aClassName isMeta: false! ! !BogusDamage methodsFor: 'recording' stamp: 'cwp 9/9/2004 01:32'! add: aSelector ofClass: aClassName isMeta: aBoolean | ref | ref _ MethodReference new. ref setClassSymbol: aClassName classIsMeta: aBoolean methodSymbol: aSelector stringVersion: ''. references add: ref! ! !BogusDamage methodsFor: 'recording' stamp: 'cwp 10/17/2004 19:21'! addRenameOf: oldName to: newName renames at: oldName put: newName! ! !BogusDamage methodsFor: 'accessing' stamp: 'cwp 9/9/2004 01:38'! definitions ^ BogusSnapshotResource current snapshot definitions! ! !BogusDamage methodsFor: 'initializing' stamp: 'cwp 10/17/2004 19:09'! initialize references _ Set new. renames _ Dictionary new.! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 9/9/2004 01:36'! removeClass: aClassName (Smalltalk at: aClassName ifAbsent: [^ self]) removeFromSystem! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 9/9/2004 01:36'! removeMethod: ref (Smalltalk at: ref classSymbol ifAbsent: [^ self]) removeSelector: ref methodSymbol! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 4/1/2006 23:35'! repair references do: [:ea | self repair: ea]. renames keysAndValuesDo: [:key :value | self repair: key renamedTo: value]. ! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 9/10/2004 01:22'! repair: ref ref methodSymbol = #Definition ifTrue: [^ self repairClass: ref classSymbol]. ref methodSymbol = #Comment ifTrue: [^ self repairComment: ref classSymbol]. ref methodSymbol = #Categories ifTrue: [self repairCategories: ref actualClass. self repairCategories: ref actualClass class. ^ self]. self repairMethod: ref! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 10/17/2004 19:21'! repair: oldName renamedTo: newName Smalltalk renameClassNamed: newName as: oldName! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 4/1/2006 23:34'! repairCategories: aClass | categories specs selectors | categories _ Dictionary new. self definitions do: [:ea | (ea isMethodDefinition and: [ea className = aClass name] and: [ea classIsMeta = aClass isMeta]) ifTrue: [(categories at: ea category ifAbsentPut: [Set new]) add: ea selector]]. specs _ Array streamContents: [:stream | categories keys asSortedArray do: [:cat | selectors _ categories at: cat. stream nextPut: (selectors asSortedArray copyWithFirst: cat)]]. aClass organization changeFromCategorySpecs: specs. aClass organization removeEmptyCategories. ! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 9/9/2004 01:34'! repairClass: aClassName | definition | definition _ self definitions detect: [:ea | ea isClassDefinition and: [ea className = aClassName]] ifNone: [^ self removeClass: aClassName]. definition load! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 9/9/2004 01:35'! repairComment: className | definition | definition _ self definitions detect: [:ea | ea isClassDefinition and: [ea className = className]] ifNone: []. definition ifNotNil: [(Smalltalk at: className ifAbsent: [^ self]) comment: definition comment stamp: definition commentStamp] ! ! !BogusDamage methodsFor: 'repairing' stamp: 'cwp 9/9/2004 01:36'! repairMethod: ref | definition | definition _ self definitions detect: [:ea | ea isMethodDefinition and: [ea className = ref classSymbol] and: [ea selector = ref methodSymbol]] ifNone: [^ self removeMethod: ref]. definition load! ! Object subclass: #BogusInfo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'BogusInfo-Base'! !BogusInfo class methodsFor: 'source' stamp: 'cwp 5/30/2004 10:33'! aASource ^ 'a ^ $a'! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/30/2004 15:56'! aCategories ^ #(numbers letters other #'*bogusext' #'*bogusext-testing')! ! !BogusInfo class methodsFor: 'source' stamp: 'cwp 5/30/2004 09:29'! aComment ^ 'Comment for BogusA'! ! !BogusInfo class methodsFor: 'source' stamp: 'cwp 5/30/2004 09:29'! aFiveSource ^ 'five ^ self two + self three'! ! !BogusInfo class methodsFor: 'source' stamp: 'cwp 5/30/2004 10:12'! aOneSource ^ 'one ^ 1'! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/30/2004 08:52'! bInstVarNames ^ #('firstInstanceVariableB' 'secondInstanceVariableB')! ! !BogusInfo class methodsFor: 'packaging' stamp: 'cwp 5/30/2004 10:14'! baseCategory ^ 'Bogus-Base'! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/30/2004 10:47'! baseClassNames "The names of the classes in package Bogus in alphabetical order" ^ #(BogusA BogusB BogusC BogusE)! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/30/2004 15:52'! baseClasses ^ self baseClassNames collect: [:ea | Smalltalk at: ea ifAbsent: [self error: 'Class ', ea, 'missing']]! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/27/2004 16:55'! classMethodsA ^ #(a acceptsLoggingOfCompilation b)! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/30/2004 10:47'! classNames "The names of the classes in package Bogus in alphabetical order" ^ #(BogusA BogusB BogusC BogusE BogusF BogusG BogusH BogusI BogusJ BogusPool)! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/27/2004 17:14'! classes "The classes in Bogus as instances of Class" ^ self classNames collect: [:ea | Smalltalk at: ea ifAbsent: [self error: 'Class ', ea, 'is missing']].! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 5/27/2004 17:11'! instanceMethodsA "The methods of BogusA that belong to package Bogus in alphabetical order by selector" ^ #( #a #b #bogusHopefullyUniqueSelector #bogusOtherUniqueSelector #five #isString #one #three #two )! ! !BogusInfo class methodsFor: 'listing' stamp: 'cwp 6/3/2004 15:52'! metaclasses ^ self classes collect: [:ea | ea class]! ! !BogusInfo class methodsFor: 'packaging' stamp: 'cwp 5/30/2004 18:48'! package ^ PackageInfo hidden: self packageName! ! !BogusInfo class methodsFor: 'packaging' stamp: 'cwp 5/30/2004 18:49'! packageName ^ 'Bogus'! ! !BogusInfo methodsFor: 'look in class' stamp: 'cwp 5/30/2004 08:42'! seeClassSide! ! TestCase subclass: #BogusTestCase instanceVariableNames: 'damage' classVariableNames: '' poolDictionaries: '' category: 'BogusInfo-Testing'! !BogusTestCase class methodsFor: 'as yet unclassified' stamp: 'cwp 12/20/2004 00:09'! resources ^ Array with: BogusSnapshotResource! ! !BogusTestCase methodsFor: 'running' stamp: 'cwp 3/1/2006 19:51'! runCase SystemChangeNotifier uniqueInstance doSilently: [super runCase]! ! !BogusTestCase methodsFor: 'running' stamp: 'cwp 3/1/2006 19:51'! runCaseAsFailure: aSemaphore SystemChangeNotifier uniqueInstance doSilently: [super runCaseAsFailure: aSemaphore]! ! !BogusTestCase methodsFor: 'running' stamp: 'cwp 10/17/2004 19:22'! setUp damage _ BogusDamage new! ! !BogusTestCase methodsFor: 'running' stamp: 'cwp 4/1/2006 23:20'! tearDown damage repair.! !