--- 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 $'
! !