--- a/packages/Package.st Tue May 13 08:04:48 2003 +0200
+++ b/packages/Package.st Tue May 13 11:43:44 2003 +0200
@@ -27,6 +27,13 @@
privateIn:Package
!
+Object subclass:#ClassSide
+ instanceVariableNames:'instanceSide'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Package::PackagedClass
+!
+
Object subclass:#PackagedMethod
instanceVariableNames:'name package category source ownedClassName'
classVariableNames:''
@@ -88,7 +95,7 @@
examples
"
- more examples to be added:
+ more examples to be added:
[exBegin]
... add code fragment for
... executable example here ...
@@ -136,14 +143,6 @@
^ self named:aString withClasses:nil withMethods:methods addToManager:nil
! !
-!Package class methodsFor:'constant'!
-
-emptyDictionaryConstant
- "could eventually be a variable in class... but i doubt it would buy is
- much time savings..."
- ^ Dictionary new
-! !
-
!Package class methodsFor:'defaults'!
defaultBlockedMethodsCollection
@@ -176,10 +175,6 @@
^ self named:#'__NoProject__'.
!
-packageHandlerClass
- ^ StxPackageHandler
-!
-
packageManager
^ self packageManagerClass smalltalkPackageManager.
!
@@ -432,9 +427,11 @@
"add an overridden method. under #package -> #methodClassName -> #packagedMethod"
| methodClassName |
methodClassName := aPackagedMethod ownedClassName.
+ "so that we have this method stored"
+ self addPackagedMethod:aPackagedMethod.
(((overriddenMethodChanges at:byPackageNamed ifAbsentPut:[Dictionary new])
- at:methodClassName ifAbsentPut:[Dictionary new]) at:aPackagedMethod name put:aPackagedMethod)
+ at:methodClassName ifAbsentPut:[Set new]) add:aPackagedMethod name)
!
addPackagedClass:aPackagedClass
@@ -450,7 +447,9 @@
addPackagedMethod:aPackagedMethod
"add or replace aPackagedMethod from the receiver"
- ^ (self packagedMethodsAtClassNamed:aPackagedMethod ownedClassName ifAbsentPut:[Dictionary new])
+ | aPackagedMethodsOwnedClass |
+ aPackagedMethodsOwnedClass := aPackagedMethod ownedClassName.
+ ^ (self packagedMethodsAtClassNamed:aPackagedMethodsOwnedClass ifAbsentPut:[Dictionary new])
at:aPackagedMethod name put:aPackagedMethod.
!
@@ -500,7 +499,7 @@
(dictionaryOfMethodNamesAndPackagedMethods :=
aDictionaryOfClassNamesAndPackagedMethods at:aClassName ifAbsent:[nil]).
dictionaryOfMethodNamesAndPackagedMethods ifNotNil:[
- removedPackagedMethod := (dictionaryOfMethodNamesAndPackagedMethods removeKey:aMethodName ifAbsent:[nil]).
+ removedPackagedMethod := (dictionaryOfMethodNamesAndPackagedMethods remove:aMethodName ifAbsent:[nil]).
removedPackagedMethod ifNotNil:[ "once found it can just exit as there should not be any more here!!"
^ self
].
@@ -523,15 +522,19 @@
"add a representation of a class (PackagedClass) to the receiver.
Look in aClass to see if we need to add any blocked methods - this could
be done by the manager but is done locally to avoid too many message sends"
-
- self basicAddedPackagedClass:(self newPackagedClass:aClass).
+ | newPackagedClass |
+ self assert:(aClass isMeta not).
+ newPackagedClass := (self newPackagedClass:aClass).
+ self basicAddedPackagedClass:newPackagedClass.
(aClass methodDictionary copy) keysAndValuesDo:[:aMethodName :aMethod |
(aMethod package == self name) ifFalse:[
- self addBlockedMethodNamed:aMethodName forClassNamed:aClass name
+ newPackagedClass addBlockedMethodNamed:aMethodName.
].
].
^ aClass
+
+
!
basicAddedMethod:aMethod
@@ -539,7 +542,7 @@
as dirty"
| aPackagedMethod aMethodName aMethodClassName|
- aMethodClassName := aMethod mclass name.
+ aMethodClassName := aMethod mclass name asSymbol.
aMethodName := aMethod name.
(self includesPackagedClassNamed:aMethodClassName) ifTrue:[
@@ -689,7 +692,16 @@
!
packagedClassNamed:aSymbol ifAbsent:aBlock
- ^ (packagedClasses at:aSymbol ifAbsent:[aBlock value])
+ | classWithoutClassEnding |
+ classWithoutClassEnding := (aSymbol asString copyUpTo:Character space) asSymbol.
+
+ (classWithoutClassEnding size < aSymbol asString size) ifTrue:[
+ "here i am making a crude assumption that aSymbol is refering to the class side of a class.
+ whether i should check if this is true or not is another matter..."
+ ^ (packagedClasses at:classWithoutClassEnding ifAbsent:[^ aBlock value]) classSide
+ ].
+
+ ^ (packagedClasses at:aSymbol "or classWithoutClassEnding" ifAbsent:[^ aBlock value])
!
packagedMethodNamed:aSymbol forClassNamed:aClassName
@@ -833,7 +845,7 @@
originalMethodDefinition :=
(self newPackagedMethodSelector:methodBeingOverridden name
- className:methodBeingOverridden mclass name
+ className:methodBeingOverridden mclass name asSymbol
source:methodBeingOverridden source).
originalMethodDefinition ifNil:[
@@ -873,6 +885,16 @@
self changed:#overrideMethod: with:methodBeingOverridden
!
+removeFromSystem
+ self packagedClassesDo:[:aPackagedClass |
+ aPackagedClass removeFromSystem
+ ].
+
+ self packagedMethodsDo:[:aPackagedMethod |
+ aPackagedMethod removeFromSystem
+ ].
+!
+
removeOverriddenClassNamed:aClassNameSymbol
^ self removeOverriddenClassNamed:aClassNameSymbol ifAbsent:[self error:'Class not found!!']
@@ -1040,7 +1062,7 @@
| previousVersion aMethodName aClassName aPackagedMethod byPackageName |
aMethodName := aMethodChange selector.
- aClassName := aMethodChange className.
+ aClassName := aMethodChange className asSymbol.
previousVersion := aMethodChange previousVersion.
aPackagedMethod := self
newPackagedMethodSelector:aMethodName
@@ -1054,6 +1076,8 @@
This is because as is noted in - 'Context note' - above"
^ self newMethodChanged:aMethodChange
].
+
+ self halt.
previousVersion package asSymbol == self name ifTrue:[
^ self addOverriddenMethodChange:aPackagedMethod byPackageNamed:byPackageName.
].
@@ -1082,7 +1106,7 @@
"
| aMethodName aClassName methodBeingRemoved overriddenByPackage |
aMethodName := aMethodRemoveChange selector.
- aClassName := aMethodRemoveChange className.
+ aClassName := aMethodRemoveChange className asSymbol.
methodBeingRemoved := aMethodRemoveChange previousVersion.
(self blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName) ifTrue:[
@@ -1237,13 +1261,7 @@
!Package methodsFor:'enumerating'!
-classNamesDo:aOneArgBlock
- self classNames do:[:aClassName|
- aOneArgBlock value:aClassName
- ].
-!
-
-classesDo:aBlock
+classesInSystemDo:aBlock
self packagedClassesDo:[:aPackage | | aClass |
(aClass"orNil" := aPackage classInSmalltalk) ifNotNil:[
aBlock value:aClass
@@ -1251,24 +1269,21 @@
].
!
-looseMethodNamesAndClassNamesDo:aTwoArgBlock
- self looseMethods do:[:aMethod |
- aTwoArgBlock value:aMethod name value:aMethod ownedClassName
- ].
-!
-
-looseMethodsAndClassNamesDo:aTwoArgBlock
- self looseMethods do:[:aMethod |
- aTwoArgBlock value:aMethod name value:aMethod ownedClassName
- ].
-!
-
-looseMethodsDo:aBlock
+loosePackagedMethodsDo:aBlock
self looseMethods do:aBlock.
!
packagedClassesDo:aOneArgBlock
^ packagedClasses do:aOneArgBlock
+!
+
+packagedMethodsDo:aBlock
+ self packagedMethods values do:[:aDicOfPackagedMethods |
+ aDicOfPackagedMethods values do:aBlock
+ ].
+
+
+
! !
!Package methodsFor:'factory'!
@@ -1338,7 +1353,7 @@
!
initializeClasses
- self classesDo:[:aClass |
+ self classesInSystemDo:[:aClass |
aClass initialize.
].
!
@@ -1349,7 +1364,7 @@
myName := self name.
self isDirty:false.
self isInstalled:true.
- self classesDo:[:aClass |
+ self classesInSystemDo:[:aClass |
aClass setPackage:myName.
"get initial information"
packagedClass := (self packagedClassNamed:aClass name).
@@ -1394,10 +1409,6 @@
^ blockedMethods includes:aMethodName
!
-definesClassNamed:aClassSymbol
- ^ (self packagedClassNamed:aClassSymbol) notNil
-!
-
definesSelector:aMethodSymbol forClassNamed:aClassSymbol
"checks to see if the receiver defines a method selector associated
with a class symbol."
@@ -1426,89 +1437,8 @@
!
includesPackagedClassNamed:aSymbol
- | classWithoutClassEnding |
- classWithoutClassEnding := (aSymbol asString copyUpTo:Character space) asSymbol.
-
- ^ (self packagedClassNamed:classWithoutClassEnding) notNil
-!
-
-isDependentOnMethodCategoryChange:aMethodCategoryChange
- "if you want to later to be dependent on this MethodCategoryChange needs to probably store the
- previous version in its already available instance variable. Implement this method also in DefaultPackage.
- Also do we really need a MethodCategoryChange as well as a MethodCategoryRenameChange??"
- ^ false
-!
-
-isDependentOnMethodCategoryRenameChange:aMethodChange
- "if you want to later to be dependent on this MethodCategoryChange needs to probably store the
- previous version in its already available instance variable. Implement this method also in DefaultPackage.
- Also do we really need a MethodCategoryChange as well as a MethodCategoryRenameChange??"
- ^ false
-!
-
-isDependentOnMethodChange:aMethodChange
- "a method as changed. If the receiver is responsible for the change return true
- or false."
- | previousVersion aMethodChangeSelector aMethodChangeClassName |
- aMethodChangeSelector := aMethodChange selector.
- aMethodChangeClassName := aMethodChange className.
-
- (previousVersion := aMethodChange previousVersion) ifNotNil:[
- previousVersion package == self name ifTrue:[
- ^ true
- ].
- ].
- (self includesPackagedClassNamed:aMethodChange className asSymbol) ifTrue:[
- (self blockedMethodsIncludeMethodName:aMethodChangeSelector forClassNamed:aMethodChangeClassName) ifTrue:[
- ^ false.
- ].
-
- ( self
- overriddenChangesIncludesMethodName:aMethodChange selector
- forClassNamed:aMethodChange changeClass name) ifTrue:[
- ^ false.
- ].
- previousVersion ifNil:[
- ^ true
- ].
-
- ].
-
- aMethodChange package == self name ifTrue:[
- ^ true
- ].
- ^ false
-!
-
-isDependentOnMethodRemoveChange:aMethodRemoveChange
- "a method as been removed. If the receiver is responsible for the change return true
- or false."
- | previousVersion aMethodChangeSelector aMethodChangeClassName |
- aMethodChangeSelector := aMethodRemoveChange selector.
- aMethodChangeClassName := aMethodRemoveChange className.
-
- (previousVersion := aMethodRemoveChange previousVersion) ifNotNil:[
- previousVersion package == self name ifTrue:[
- ^ true
- ].
- ].
- (self includesPackagedClassNamed:aMethodRemoveChange className asSymbol) ifTrue:[
- (self blockedMethodsIncludeMethodName:aMethodChangeSelector forClassNamed:aMethodChangeClassName) ifTrue:[
- ^ true.
- ].
-
- (self
- overriddenChangesIncludesMethodName:aMethodRemoveChange selector
- forClassNamed:aMethodRemoveChange changeClass name) ifTrue:[
- ^ false.
- ].
-
- ].
-
- aMethodRemoveChange package == self name ifTrue:[
- ^ true
- ].
- ^ false
+
+ ^ (self packagedClassNamed:aSymbol) notNil
!
isOverridden
@@ -1538,12 +1468,12 @@
!
overriddenChangesIncludesMethodName:aMethodName forClassNamed:aClassName
- | aDicOfPackageMethods |
+ | aSetOfPackageMethods |
overriddenMethodChanges values do:[:aDicOfClassNamesAndMethods |
- aDicOfPackageMethods := (aDicOfClassNamesAndMethods at:aClassName ifAbsent:[nil]).
- aDicOfPackageMethods ifNotNil:[
- (aDicOfPackageMethods at:aMethodName ifAbsent:[nil]) ifNotNil:[
+ aSetOfPackageMethods := (aDicOfClassNamesAndMethods at:aClassName ifAbsent:[nil]).
+ aSetOfPackageMethods ifNotNil:[
+ (aSetOfPackageMethods includes:aMethodName) ifTrue:[
^ true
].
].
@@ -1660,7 +1590,7 @@
!
uninstallClasses
- self classesDo:[:aClass |
+ self classesInSystemDo:[:aClass |
aClass removeFromSystem.
]
!
@@ -1670,16 +1600,9 @@
!
uninstallLooseMethods
- self looseMethodsDo:[:aLooseMethod |
+ self loosePackagedMethodsDo:[:aLooseMethod |
aLooseMethod removeFromSystem.
].
-!
-
-uninstallLooseMethodsFromPackage:aPackage in:aPackageManager
- aPackage looseMethodsDo:[:aLooseMethod |
- aLooseMethod removeFromSystem.
- ].
- #ToLookAt.
! !
!Package::PackagedClass class methodsFor:'instance creation'!
@@ -1704,53 +1627,6 @@
^ (self basicNew name:aClassName package:aPackage).
! !
-!Package::PackagedClass methodsFor:'* As yet uncategorized *'!
-
-definesSelector:aSelector
- ^ package definesSelector:aSelector forClassNamed:name
-!
-
-packagedMethods
- | isMyClassInSmalltalkGone possibleClassRemoved classInSmalltalk definedMethods packagedMethodsInClass |
-
- possibleClassRemoved := ClassRemoveChange::ClassBeingRemovedQuery query.
- isMyClassInSmalltalkGone := possibleClassRemoved notNil.
-
- isMyClassInSmalltalkGone ifTrue:[
- definedMethods := possibleClassRemoved methodDictionary copy values select:[:aMethod |
- self definesSelector:aMethod name
- ].
-
- ^ definedMethods collect:[:aMethod |
- package newPackagedMethodWithMethod:aMethod
- ].
- ].
- packagedMethodsInClass := (package packagedMethods at:name ifAbsent:[Dictionary new]).
-
- (classInSmalltalk := Smalltalk classNamed: name) ifNil:[
- ^ packagedMethodsInClass
- ].
-
- definedMethods := classInSmalltalk methodDictionary copy values select:[:aMethod |
- self definesSelector:aMethod name
- ].
- "get from package or create on the fly packaged methods"
- ^ definedMethods collect:[:aMethod |
- packagedMethodsInClass at:aMethod name ifAbsent:[
- package newPackagedMethodWithMethod:aMethod
- ].
- ].
-!
-
-removeFromSystem
- | class |
- self removeFromPackage.
- (class := Smalltalk classNamed:name) ifNotNil:[
- class removeFromSystem.
- ].
-
-! !
-
!Package::PackagedClass methodsFor:'accessing'!
category
@@ -1949,6 +1825,15 @@
^ nil
!
+classSide
+ "an interface to the class side of the receiver"
+ ^ ClassSide instanceSide:self.
+!
+
+definesSelector:aSelector
+ ^ package definesSelector:aSelector forClassNamed:name
+!
+
isInSmalltalk
"if evaluates to false, it should not be in Smalltalk."
| classInSmalltalk|
@@ -1967,8 +1852,40 @@
^ package markDirty
!
-overriddenChangesIncludesMethodName:arg
- ^ package overriddenChangesIncludesMethodName:arg forClassNamed:name
+overriddenChangesIncludesMethodName:aMethodName
+ ^ package overriddenChangesIncludesMethodName:aMethodName forClassNamed:name
+!
+
+packagedMethods
+ | isMyClassInSmalltalkGone possibleClassRemoved classInSmalltalk definedMethods packagedMethodsInClass |
+
+ possibleClassRemoved := ClassRemoveChange::ClassBeingRemovedQuery query.
+ isMyClassInSmalltalkGone := possibleClassRemoved notNil.
+
+ isMyClassInSmalltalkGone ifTrue:[
+ definedMethods := possibleClassRemoved methodDictionary copy values select:[:aMethod |
+ self definesSelector:aMethod name
+ ].
+
+ ^ definedMethods collect:[:aMethod |
+ package newPackagedMethodWithMethod:aMethod
+ ].
+ ].
+ packagedMethodsInClass := (package packagedMethods at:name ifAbsent:[Dictionary new]).
+
+ (classInSmalltalk := Smalltalk classNamed: name) ifNil:[
+ ^ packagedMethodsInClass
+ ].
+
+ definedMethods := classInSmalltalk methodDictionary copy values select:[:aMethod |
+ self definesSelector:aMethod name
+ ].
+ "get from package or create on the fly packaged methods"
+ ^ definedMethods collect:[:aMethod |
+ packagedMethodsInClass at:aMethod name ifAbsent:[
+ package newPackagedMethodWithMethod:aMethod
+ ].
+ ].
!
removeBlockedMethodNamed:aMethodName
@@ -1979,6 +1896,14 @@
^ package basicRemoveClassNamed:name
!
+removeFromSystem
+ | class |
+ self removeFromPackage.
+ (class := self classInSmalltalk) ifNotNil:[
+ class removeFromSystem.
+ ].
+!
+
removeOverriddenMethodNamed:aMethodName
^ package removeOverriddenMethodNamed:aMethodName forClassNamed:name.
! !
@@ -2029,14 +1954,99 @@
^ false
! !
+!Package::PackagedClass::ClassSide class methodsFor:'instance creation'!
+
+instanceSide:aPackagedClass
+ ^ self basicNew instanceSide:aPackagedClass
+! !
+
+!Package::PackagedClass::ClassSide methodsFor:'accessing'!
+
+instanceSide
+ "return the value of the instance variable 'instanceSide' (automatically generated)"
+
+ ^ instanceSide
+!
+
+instanceSide:something
+ "set the value of the instance variable 'instanceSide' (automatically generated)"
+
+ instanceSide := something.
+!
+
+name
+ ^ (instanceSide name, ' class') asSymbol
+!
+
+package
+ ^ instanceSide package
+! !
+
+!Package::PackagedClass::ClassSide methodsFor:'api'!
+
+addBlockedMethodNamed:aMethodName
+ ^ self package addBlockedMethodNamed:aMethodName forClassNamed:self name
+!
+
+addMethodNamed:aMethodName
+ | aPackagedMethod |
+ (self blockedMethodsIncludeMethodName:aMethodName) ifTrue:[
+ self removeBlockedMethodNamed:aMethodName.
+ self markDirty.
+ ^ aPackagedMethod.
+ ].
+
+ (self overriddenChangesIncludesMethodName:aMethodName) ifTrue:[
+ "it should not be consider overriden anymore has the method has just been
+ added to the receiver!! And we dont need to add it as an extra method either
+ as i now am a 'holder for this method!!' But to show this i need to mark myself dirty"
+ self markDirty.
+ self removeOverriddenMethodNamed:aMethodName.
+ ^ aPackagedMethod.
+ ].
+
+ "if i am here the method is in effect added as the package the receiver is related to
+ knows the class and does not include any blocked methods for the method aMethodName"
+!
+
+basicRemoveMethodNamed:aMethodName ifAbsent:aBlock
+ (self blockedMethodsIncludeMethodName:aMethodName) ifTrue:[
+ ^ aBlock value
+ ]. "the receiver does not know this method!!"
+
+ self addBlockedMethodNamed:aMethodName.
+
+ (self overriddenChangesIncludesMethodName:aMethodName) ifTrue:[
+ self removeOverriddenMethodNamed:aMethodName
+ ].
+!
+
+blockedMethodsIncludeMethodName:aMethodName
+ ^ self package blockedMethodsIncludeMethodName:aMethodName forClassNamed:self name.
+!
+
+markDirty
+ ^ self package markDirty
+!
+
+overriddenChangesIncludesMethodName:aMethodName
+ ^ self package overriddenChangesIncludesMethodName:aMethodName forClassNamed:self name
+!
+
+removeBlockedMethodNamed:aMethodName
+ ^ self package removeBlockedMethodNamed:aMethodName forClassNamed:self name
+!
+
+removeOverriddenMethodNamed:aMethodName
+ ^ self package removeOverriddenMethodNamed:aMethodName forClassNamed:self name.
+! !
+
!Package::PackagedMethod class methodsFor:'instance creation'!
-name:aMethodName ownedClassName: aClassName category:aCategory package:aPackageName source:source
- ^ self basicNew name:aMethodName ownedClassName: aClassName category:aCategory package:aPackageName source:source
-!
-
-name:aMethodName ownedClassName: aClassName package:aPackageName source:source
- ^ self basicNew name:aMethodName ownedClassName: aClassName package:aPackageName source:source
+name:aMethodName ownedClassName: aClassName category:aCategory package:aPackage source:source
+ self assert:(aClassName isSymbol).
+ self assert:(aMethodName isSymbol).
+ ^ self basicNew name:aMethodName ownedClassName: aClassName category:aCategory package:aPackage source:source
! !
!Package::PackagedMethod methodsFor:'accessing'!
@@ -2069,12 +2079,6 @@
^ isCommitted
!
-isCommitted:something
- "set the value of the instance variable 'isCommitted' (automatically generated)"
-
- isCommitted := something.
-!
-
methodInImage
| myClass |
myClass := Smalltalk classNamed:ownedClassName.
@@ -2103,23 +2107,6 @@
source := sourceArg.
!
-name:nameArg ownedClassName:classNameArg package:packageArg
- "set instance variables (automatically generated)"
-
- name := nameArg.
- ownedClassName := classNameArg.
- package := packageArg.
-!
-
-name:nameArg ownedClassName:classNameArg package:packageArg source:sourceArg
- "set instance variables (automatically generated)"
-
- name := nameArg.
- ownedClassName := classNameArg.
- package := packageArg.
- source := sourceArg.
-!
-
ownedClass
^ Compiler evaluate:ownedClassName
in:nil
@@ -2144,7 +2131,7 @@
ownedClassName:something
"set the value of the instance variable 'className' (automatically generated)"
-
+ self assert:(something isSymbol).
ownedClassName := something.
!
@@ -2324,5 +2311,5 @@
!Package class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/packages/Package.st,v 1.4 2003-05-09 12:21:12 james Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/packages/Package.st,v 1.5 2003-05-13 09:43:08 james Exp $'
! !
--- a/packages/PackageSmalltalkManipulationTestCases.st Tue May 13 08:04:48 2003 +0200
+++ b/packages/PackageSmalltalkManipulationTestCases.st Tue May 13 11:43:44 2003 +0200
@@ -441,6 +441,55 @@
]
! !
+!PackageSmalltalkManipulationTestCases methodsFor:'test - fileIn type'!
+
+testMethod_FileIn
+ "I can across an error in the GUI builder when it tried to recompile a method on the class side!!
+ it decided to change the package of the old class confusing the package completely!!
+ "
+ | package1 method1 packageClassIsIn packageMethodIsIn |
+ [
+ package1 := packageManager newPackageNamed:#'package1'.
+
+ self createClassNamed:#QWERTZ2.
+ self createMethodFor:QWERTZ2 source:'testBasicMethodCreation 1 + 1'.
+ method1 := QWERTZ2 compiledMethodAt:#testBasicMethodCreation.
+
+ packageClassIsIn := packageManager packageNamed:QWERTZ2 package.
+ packageMethodIsIn := packageManager packageNamed:method1 package.
+
+ self assert:(packageMethodIsIn definesSelector:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+ self assert:(packageMethodIsIn isDependentOnMethodNamed:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+
+ packageManager addMethod:method1 toPackage:package1.
+ self assert:(package1 definesSelector:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+ self assert:(package1 isDependentOnMethodNamed:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+
+ " The test!!!!!! "
+ method1 sourceCode halt.
+ self createMethodFor:QWERTZ2 source:'testBasicMethodCreation 1 + 1'.
+
+ method1 := QWERTZ2 compiledMethodAt:#testBasicMethodCreation.
+ packageMethodIsIn := packageManager packageNamed:method1 package.
+
+ self assert:(packageMethodIsIn definesSelector:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+ self assert:(packageMethodIsIn isDependentOnMethodNamed:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+ "sometimes the #keep is done automatically. #keep meaning when a method is created a signal is asked for
+ and if not returned the method is either keep in the current project OR put into another one OR put into
+ the working package"
+ package1 ~= packageMethodIsIn ifTrue:[
+ self assert:(package1 definesSelector:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+ self shouldnt:(package1 isDependentOnMethodNamed:#testBasicMethodCreation forClassNamed:#QWERTZ2).
+ ].
+
+ ] ensure:[
+ packageManager unloadPackageNamed:#'package1'.
+ (Smalltalk classNamed:#QWERTZ2) ifNotNil:[
+ (Smalltalk classNamed:#QWERTZ2) removeFromSystem.
+ ].
+ ]
+! !
+
!PackageSmalltalkManipulationTestCases methodsFor:'test - moving'!
obsolete_test_moveClass1
@@ -1010,10 +1059,140 @@
packageManager unloadPackageNamed:#'package1'.
packageManager unloadPackageNamed:#'package2'.
]
+!
+
+testMethodRemoveClassSide
+ "Changes caught my the manager should not affect the packages state.
+ So a class removal should remove the class in Smalltalk yet the package should still keep hold of the
+ entire definition INCLUDING the methods it requires!!"
+ "This one tests if the methods are still kept within the pacakge as packagedMethods"
+ | package1 package2 packagedMethod1 method1 theClassName workingPackage |
+ [
+ package1 := packageManager newPackageNamed:#'package1'.
+ package2 := packageManager newPackageNamed:#'package2'.
+
+ self createClassNamed:#QWERTZ2.
+ workingPackage := packageManager packageNamed:QWERTZ2 package.
+ self createMethodFor:QWERTZ2 class source:'testBasicMethodCreation 1 + 1'.
+ self createMethodFor:QWERTZ2 class source:'testBasicMethodCreation2 1 + 1'.
+ method1 := QWERTZ2 class compiledMethodAt:#testBasicMethodCreation.
+ theClassName := (QWERTZ2 class name asSymbol).
+
+ packageManager moveClass:QWERTZ2 toPackage:package1.
+
+ self assert:(package1 includesPackagedClassNamed:theClassName).
+ self assert:(package1 definesSelector:method1 name forClassNamed:theClassName).
+
+
+ "This blocks method1 from package1"
+ packageManager moveMethod:method1 toPackage:package2.
+ self assert:(package1 includesPackagedClassNamed:theClassName).
+ "package1 stores method2 as blocked"
+ self shouldnt:(package1 definesSelector:method1 name forClassNamed:theClassName).
+
+
+ "Package2 should NOT define the class QWERTZ2 class but should define method2 which should also be in Smalltalk!!"
+ self shouldnt:(package2 includesPackagedClassNamed:theClassName).
+ self assert:(package2 definesSelector:method1 name forClassNamed:theClassName).
+ packagedMethod1 := (package2 packagedMethodNamed:method1 name forClassNamed:theClassName).
+ self assert:(packagedMethod1 isInSmalltalk).
+
+ (Smalltalk classNamed:theClassName) ifNotNil:[
+ (Smalltalk classNamed:theClassName) removeSelector:method1 name.
+ ].
+ "test that the CLASS is removed from Smalltalk BUT the package1 still retains it!!"
+ self assert:(package1 includesPackagedClassNamed:theClassName).
+ self shouldnt:(package1 definesSelector:#testBasicMethodCreation forClassNamed:theClassName).
+
+ "test that the METHOD is still blocked in package1!!"
+ self assert:(package2 definesSelector:#testBasicMethodCreation forClassNamed:theClassName).
+
+ "test that the METHOD is removed from Smalltalk BUT the package2 still retains it!!"
+ self assert:(package2 definesSelector:#testBasicMethodCreation forClassNamed:theClassName).
+ packagedMethod1 := (package2 packagedMethodNamed:#testBasicMethodCreation forClassNamed:theClassName).
+ self assert:(packagedMethod1 notNil).
+ self shouldnt:(packagedMethod1 isInSmalltalk).
+
+
+ ] ensure:[
+ packageManager unloadPackageNamed:#'package1'.
+ packageManager unloadPackageNamed:#'package2'.
+ (Smalltalk classNamed:theClassName) ifNotNil:[
+ (Smalltalk classNamed:#QWERTZ2) removeFromSystem.
+ ].
+ ]
+!
+
+testMethodRemoveClassSide2
+ "Changes caught my the manager should not affect the packages state.
+ So a class removal should remove the class in Smalltalk yet the package should still keep hold of the
+ entire definition INCLUDING the methods it requires!!"
+ "This one tests if the methods are still kept within the pacakge as packagedMethods"
+ | package1 package2 packagedMethod1 method1 theClassSideName |
+
+ [
+ "prerequisites"
+ self assert:(Smalltalk classNamed:#QWERTZ2) isNil.
+
+ package1 := packageManager newPackageNamed:#'package1'.
+ package2 := packageManager newPackageNamed:#'package2'.
+
+ self createClassNamed:#QWERTZ2.
+ theClassSideName := QWERTZ2 class name asSymbol.
+ self createMethodFor:QWERTZ2 class source:'testBasicMethodCreation 1 + 1'.
+ self createMethodFor:QWERTZ2 class source:'testBasicMethodCreation2 1 + 1'.
+ method1 := QWERTZ2 class compiledMethodAt:#testBasicMethodCreation.
+
+ packageManager moveClass:QWERTZ2 toPackage:package1.
+ self assert:(package1 definesSelector:method1 name forClassNamed:theClassSideName).
+ self assert:(package1 isDependentOnMethodNamed:method1 name forClassNamed:theClassSideName).
+
+ "This blocks method1 from package1"
+ packageManager addMethod:method1 toPackage:package2.
+
+ self assert:(package1 includesPackagedClassNamed:theClassSideName).
+ "package1 stores method2 as overridden"
+ self assert:(package1 definesSelector:method1 name forClassNamed:theClassSideName).
+ self shouldnt:(package1 isDependentOnMethodNamed:method1 name forClassNamed:theClassSideName).
+
+
+ "Package2 should NOT define the class but should define method2 which should also be in Smalltalk!!"
+ self shouldnt:(package2 includesPackagedClassNamed:theClassSideName).
+ self assert:(package2 definesSelector:method1 name forClassNamed:theClassSideName).
+ packagedMethod1 := (package2 packagedMethodNamed:method1 name forClassNamed:theClassSideName).
+ self assert:(packagedMethod1 isInSmalltalk).
+
+ (Smalltalk classNamed:#QWERTZ2) ifNotNil:[
+ QWERTZ2 class removeSelector:method1 name.
+ ].
+ "test that the CLASS is removed from Smalltalk BUT the package1 still retains it!!"
+ self assert:(package1 includesPackagedClassNamed:theClassSideName).
+ self assert:(package1 definesSelector:#testBasicMethodCreation forClassNamed:theClassSideName).
+ self shouldnt:(package1 isDependentOnMethodNamed:#testBasicMethodCreation forClassNamed:theClassSideName).
+
+ "test that the METHOD is still defined but overridden in package1!!"
+
+ self assert:(package2 definesSelector:#testBasicMethodCreation forClassNamed:theClassSideName).
+ self shouldnt:(package2 isDependentOnMethodNamed:#testBasicMethodCreation forClassNamed:theClassSideName).
+
+ "test that the METHOD is removed from Smalltalk BUT the package2 still retains it!!"
+ self assert:(package2 definesSelector:#testBasicMethodCreation forClassNamed:theClassSideName).
+ packagedMethod1 := (package2 packagedMethodNamed:#testBasicMethodCreation forClassNamed:theClassSideName).
+ self assert:(packagedMethod1 notNil).
+ self shouldnt:(packagedMethod1 isInSmalltalk).
+
+
+ ] ensure:[
+ (Smalltalk classNamed:#QWERTZ2) ifNotNil:[
+ (Smalltalk classNamed:#QWERTZ2) removeFromSystem.
+ ].
+ packageManager unloadPackageNamed:#'package1'.
+ packageManager unloadPackageNamed:#'package2'.
+ ]
! !
!PackageSmalltalkManipulationTestCases class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/packages/PackageSmalltalkManipulationTestCases.st,v 1.3 2003-05-13 06:04:48 james Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/packages/PackageSmalltalkManipulationTestCases.st,v 1.4 2003-05-13 09:43:44 james Exp $'
! !