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: 'lr 11/7/2009 18:42'! restoreClass: aClassName | definition | definition := snapshot definitions detect: [ :ea | ea isClassDefinition and: [ ea className = aClassName ] ] ifNone: [ ^ self removeClass: aClassName ]. definition load! ! !BogusSnapshotResource methodsFor: 'restoring' stamp: 'lr 11/7/2009 18:42'! 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: 'lr 11/7/2009 18:42'! 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: 'lr 11/7/2009 18:42'! 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: 'lr 11/7/2009 18:42'! 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: 'lr 11/7/2009 18:42'! 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: 'lr 11/7/2009 18:42'! repairClass: aClassName | definition | definition := self definitions detect: [ :ea | ea isClassDefinition and: [ ea className = aClassName ] ] ifNone: [ ^ self removeClass: aClassName ]. definition load! ! !BogusDamage methodsFor: 'repairing' stamp: 'lr 11/7/2009 18:42'! 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: 'djr 3/31/2010 12:04'! repairMethod: ref | definition | definition := self definitions detect: [ :ea | ea isMethodDefinition and: [ ea className = ref classSymbol ] and: [ ea selector = ref methodSymbol ] and: [ ea classIsMeta = ref classIsMeta ]] 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: 'lr 11/7/2009 18:42'! setUp damage := BogusDamage new! ! !BogusTestCase methodsFor: 'running' stamp: 'cwp 4/1/2006 23:20'! tearDown damage repair.! !