'From Squeak3.2alpha of 1 November 2001 [latest update: #4599] on 2 January 2002 at 10:21:27 pm'! "Change Set: someModuleTests-hg Date: 2 January 2002 Author: Henrik Gedenryd The ModuleTests and ModuleStorageTests should pass, but especially the latter tests are incomplete as yet. The DeltaModuleTests are obviously far from done. The PoolTests are obsolete and should really be removed. The ModuleSystemIntegrityTests are not unit tests as such. Moreover the stock image has non-readonly bindings for pool vars and some globals, causing one integrity test to fail."! TestCase subclass: #ModuleSystemIntegrityTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Tests'! !ModuleSystemIntegrityTests commentStamp: '' prior: 0! Test that the modules system is in a consistent state. They may be useful for verifying the state of the image if problems arise.! TestCase subclass: #ModuleTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Tests'! ModuleTests subclass: #DeltaModuleTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Tests'! ModuleTests subclass: #ModuleStorageTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Language-Modules-Tests'! !ModuleSystemIntegrityTests methodsFor: 'system integrity tests' stamp: 'hg 12/9/2001 20:17'! testIntegrityOfModuleOfClasses "check that each class points to the module it is defined in" "this is really a test of the current state of the image" | good allBad | allBad _ OrderedCollection new. Module root deepSubmodulesDo: [:mod | mod == Module smalltalk ifFalse: [ mod allClassesDo: [:cl | good _ cl module == mod. good ifFalse: [allBad add: {cl. cl module. mod}]]]]. self should: [allBad isEmpty]! ! !ModuleSystemIntegrityTests methodsFor: 'system integrity tests' stamp: 'hg 12/9/2001 20:17'! testIntegrityOfReadOnlyModuleDefinitions "all modular name defs shoud use read-only associations" "this is really a test of the current state of the image" | good allBad | allBad _ OrderedCollection new. self allAssociationsEverywhereDo: [:ass :mod | good _ ass isMemberOf: ReadOnlyVariableBinding. good ifFalse: [allBad add: {ass. mod}]]. self should: [allBad isEmpty]! ! !ModuleSystemIntegrityTests methodsFor: 'system integrity tests' stamp: 'hg 12/9/2001 20:17'! testIntegrityOfWeakClassBindings "all classes under Squeak should also appear in Smalltalk" "this is really a test of the current state of the image, and only applies to weak modules" | good allBad binding | Preferences strongModules ifTrue: [^self]. allBad _ OrderedCollection new. Module squeak deepClassesDo: [:cl | binding _ Module smalltalk localAssocFor: cl name ifAbsent: [nil]. good _ binding value == cl. good ifFalse: [allBad add: {cl. binding}]]. self should: [allBad isEmpty]! ! !ModuleSystemIntegrityTests methodsFor: 'system integrity tests' stamp: 'hg 12/9/2001 20:17'! testIntegrityOfWeakNameDefinitions "check that same def in Smalltalk and modules have same association" "this is really a test of the current state of the image, and applies only to weak modules" | good allBad | Preferences strongModules ifTrue: [^self]. allBad _ OrderedCollection new. self allAssociationsEverywhereDo: [:ass :mod | (Module smalltalk localAssocFor: ass key ifAbsent: [nil]) ifNotNilDo: [:sass | sass value == ass value ifTrue: [ good _ ass == sass and: [ (mod localExportedAssocFor: ass key ifAbsent: [sass]) == sass]. good ifFalse: [allBad add: {ass. mod}]]]]. self should: [allBad isEmpty]! ! !ModuleSystemIntegrityTests methodsFor: 'utility' stamp: 'hg 12/9/2001 20:17'! allAssociationsEverywhereDo: aBlock Module root deepSubmodulesDo: [:mod | mod ~~ Module smalltalk ifTrue: [ mod definedNames associationsDo: [:ass | aBlock value: ass value: mod]]]! ! !ModuleSystemIntegrityTests methodsFor: 'utility' stamp: 'hg 12/16/2001 20:17'! testIntegrityOfAllLiterals "check that global literals in CompiledMethods will be bound to the exact same association object if recompiled (this is stronger than just the same name or value)" | badOnes | badOnes _ OrderedCollection new. badOnes addAll: (Module root deepUnresolvedRefsWithScheme: Module root defaultBindingScheme). self should: [badOnes isEmpty] ! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 1/2/2002 14:23'! testCreateModule self setupHomeModule. self verifyHomeModuleExists! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 12/18/2001 10:32'! testCreateSubmoduleRefs "test creating ModuleReferences that should be unresolved unless they are asked to resolve themselves" self setupHomeModule. self setupSubmoduleRefs. self shouldnt: [self alphaRef isModuleResolved]. self shouldnt: [self betaRef isModuleResolved]. ! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 12/26/2001 20:42'! testCreateSubmodules self testResolveSubmoduleRefs. self verifySubmodulesExist! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 12/18/2001 10:26'! testCreatingModuleFromPath "non-passive fromPath: (forceCreate = true) should create modules & modulerefs as needed" | alphaPath | self setupHomeModule. "should resolve unresolved moduleRef" self setupSubmoduleRefs. self assert: self alphaRef isModuleResolved not. alphaPath _ self alphaRef module. self should: [(Module fromPath: alphaPath forceCreate: true) notNil]. self should: [self alphaRef isModuleResolved]. self should: [(Module @ alphaPath) == self alphaRef module]. "should create module and moduleRef" self should: [ (Module fromPath: (self pathForTestModules copyWith: self betaModuleName) forceCreate: true) notNil]. self should: [self betaModule notNil]. ! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 12/18/2001 11:49'! testPassiveModuleFromPath "passive fromPath: (forceCreate = false) should not create anything" "should create neither module nor moduleRef" self setupHomeModule. self should: [(Module @ self alphaModulePath) isNil]. self shouldnt: [ self homeModule neighborModuleRefs anySatisfy: [:ref | ref alias == self alphaModuleName]]. "should not resolve unresolved moduleRef" self setupSubmoduleRefs. self assert: self alphaRef isModuleResolved not. self should: [(Module @ self alphaRef module) isNil]. self should: [self alphaRef isModuleResolved not].! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 1/2/2002 14:23'! verifyHomeModuleExists self should: [self homeModule notNil]. self should: [self homeModule parentModule ifNotNilDo: [:parent | parent path = self pathForTestModules allButLast]].! ! !ModuleTests methodsFor: 'module creation tests' stamp: 'hg 12/26/2001 20:42'! verifySubmodulesExist self should: [self homeModule submodules size = 2]! ! !ModuleTests methodsFor: 'module contents' stamp: 'hg 12/26/2001 20:42'! testCreateClasses self setupAllModules. self should: [self setupParentClass notNil]. self should: [self setupDaughterClass notNil]. self should: [self setupGrandDaughterClass notNil]. self verifyClassesExist! ! !ModuleTests methodsFor: 'module contents' stamp: 'hg 12/26/2001 20:41'! verifyClassesExist self should: [self accessParentClass notNil]. self should: [self accessDaughterClass notNil]. self should: [self accessGrandDaughterClass notNil]. self should: [self accessParentClass superclass == Object]. self should: [self accessDaughterClass superclass == self accessParentClass]. self should: [self accessGrandDaughterClass superclass == self accessDaughterClass]. ! ! !ModuleTests methodsFor: 'code analysis' stamp: 'hg 12/16/2001 21:20'! testDeclareExternalRefs self class module deepDeclareExternalRefs. self should: [self class module deepUnresolvedRefs isEmpty]! ! !ModuleTests methodsFor: 'code analysis' stamp: 'hg 12/16/2001 18:58'! testLocalUnresolvedRefs self should: [self class module localUnresolvedRefs isKindOf: Collection]! ! !ModuleTests methodsFor: 'module resolution' stamp: 'hg 12/18/2001 10:36'! testFindSubmoduleRef | ref badRef | self setupHomeModule. self setupSubmoduleRefs. self setupSubmodules. ref _ ModuleReference onPath: self betaModule path. self should: [ref findModuleFromPathAndVersion notNil]. self should: [ref isModuleResolved]. badRef _ ModuleReference onPath: (self betaModule path copyWith: Float pi). self shouldnt: [badRef findModuleFromPathAndVersion notNil]. self shouldnt: [badRef isModuleResolved]. ! ! !ModuleTests methodsFor: 'module resolution' stamp: 'hg 12/18/2001 10:32'! testResolveSubmoduleRefs self setupHomeModule. self setupSubmoduleRefs. self should: [self alphaRef findModuleFromPathAndVersion isNil]. self should: [self betaRef findModuleFromPathAndVersion isNil]. self should: [self alphaRef createModuleFromPathAndVersion notNil]. self should: [self betaRef createModuleFromPathAndVersion notNil]. self should: [self alphaRef isModuleResolved]. self should: [self betaRef isModuleResolved]. ! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 11:48'! alphaModule ^Module @ self alphaModulePath! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:17'! alphaModuleName ^#AlphaTest! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 11:47'! alphaModulePath ^self pathForTestModules copyWith: self alphaModuleName! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:27'! alphaRef ^self homeModule neighborModuleRefs detect: [:ref | ref name = self alphaModuleName] ifNone: [nil]! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:20'! betaModule ^Module @ (self pathForTestModules copyWith: self betaModuleName)! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:18'! betaModuleName ^#BetaTest! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:27'! betaRef ^self homeModule neighborModuleRefs detect: [:ref | ref name = self betaModuleName] ifNone: [nil]! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:01'! homeModule ^Module @ self pathForTestModules! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/16/2001 15:32'! pathForTestModules ^#(Temporary ModuleTestingRange)! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/9/2001 22:45'! setupAllModules self setupHomeModule. self setupSubmoduleRefs. self setupSubmodules.! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/9/2001 22:46'! setupAllModulesAndContents self testCreateClasses! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:10'! setupHomeModule | testHomePath | testHomePath _ self pathForTestModules. self assert: self homeModule isNil. Module fromPath: testHomePath forceCreate: true. ! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:27'! setupSubmoduleRefs self assert: self homeModule submodules isEmpty. self homeModule submodule: nil name: self alphaModuleName version: nil importNames: false. self homeModule submodule: nil name: self betaModuleName version: nil importNames: false. ! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:28'! setupSubmodules self assert: self homeModule submodules isEmpty. self assert: self alphaRef notNil. self assert: self betaRef notNil. self alphaRef createModuleFromPathAndVersion. self betaRef createModuleFromPathAndVersion ! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 12/18/2001 10:38'! tearDown self shield: [ Module smalltalk removeName: self pathForTestModules last; removeName: #AlphaTest; removeName: #BetaTest; removeName: self parentClassName; removeName: self daughterClassName; removeName: self grandDaughterClassName]. {self betaModule. self alphaModule. self homeModule} do: [:module | (module notNil and: [module isKindOf: Module]) ifTrue: [self shield: [module cleanOutModule]]]. Module @ self pathForTestModules allButLast ifNotNilDo: [:m | self shield: [ m removeNeighborModule: self homeModule]]. self assert: self homeModule isNil! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/18/2001 10:35'! accessDaughterClass self assert: self betaModule notNil. ^self betaModule definitionFor: self daughterClassName ifAbsent: [nil]. ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/18/2001 10:31'! accessGrandDaughterClass self assert: self alphaModule notNil. ^self alphaModule definitionFor: self grandDaughterClassName ifAbsent: [nil]. ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/18/2001 10:35'! accessParentClass self assert: self homeModule notNil. ^self homeModule definitionFor: self parentClassName ifAbsent: [nil]. ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/9/2001 20:00'! daughterClassName ^#TestBetty ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/9/2001 20:01'! grandDaughterClassName ^#TestAudrey ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/9/2001 20:00'! parentClassName ^#TestMama ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/18/2001 10:35'! setupDaughterClass | mama | self assert: self betaModule notNil. mama _ self accessParentClass. ^mama subclass: self daughterClassName instanceVariableNames: 'e' classVariableNames: '' poolDictionaries: '' category: self betaModule simulatedCategory. ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/26/2001 20:42'! setupGrandDaughterClass | mama | self verifySubmodulesExist. mama _ self accessDaughterClass. self assert: mama notNil. ^mama subclass: self grandDaughterClassName instanceVariableNames: 'f' classVariableNames: '' module: self alphaModule ! ! !ModuleTests methodsFor: 'sample classes' stamp: 'hg 12/18/2001 10:03'! setupParentClass ^Object subclass: self parentClassName instanceVariableNames: 'a b' classVariableNames: 'C D' module: self homeModule! ! !ModuleTests methodsFor: 'utility' stamp: 'hg 12/15/2001 11:02'! shield: aBlock aBlock on: Exception do: [:ex | ]! ! !DeltaModuleTests methodsFor: 'integrity tests' stamp: 'hg 12/9/2001 22:20'! testIntegrityOfMetaClasses | bad | bad _ OrderedCollection new. Module root deepSubmodulesDo: [:m | m == Module smalltalk ifFalse: [ m allClassesDo: [:cl | cl class theNonMetaClass == cl ifFalse: [ bad add: cl]]]]. self should: [bad isEmpty].! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 12/16/2001 22:53'! testCompositeStoreModulesInCache self toTestStoreModulesInCache: false! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 12/18/2001 10:07'! testLoadModulesFromCache self testStandaloneStoreModulesInCache. self unloadModules. self setupHomeModule. self homeModule repository cache defineModuleFromFile; loadModuleContents. ! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 12/16/2001 22:53'! testStandaloneStoreModulesInCache self toTestStoreModulesInCache: true! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 1/2/2002 14:21'! toTestStoreModulesInCache: standalone | warnings | self verifyTestModulesNotPresent. self setupAllModulesAndContents. standalone ifTrue: [self setupStandaloneRepositories]. self shouldnt: [self homeModule repository cache checkRepositoryExists]. self shouldnt: [self homeModule repository cache checkDefinitionFileOK]. "self shouldnt: [self homeModule repository cache checkContentsFilesOK]." self shouldnt: [self homeModule repository cache checkCompleteModuleContentsOK]. self should: [standalone = (self homeModule repository compositeModules size = 1)]. "catch missing dependencies warning and verify the number of times it occurs" warnings _ 0. [self homeModule repository cache ensureDeepUpload] on: Warning do: [:ex | warnings _ warnings + 1. ex resume: true]. self should: [ warnings = (standalone ifTrue: [3] ifFalse: [1])]. self should: [self homeModule repository cache checkRepositoryExists]. self should: [self homeModule repository cache checkDefinitionFileOK]. self should: [self homeModule repository cache checkContentsFilesOK]. self should: [self homeModule repository cache checkCompleteModuleContentsOK]. ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 12/18/2001 12:15'! testInstallCompositeModulesFromCache self toTestInstallModulesFromCache: false forPath: self pathForTestModules ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 12/18/2001 12:16'! testInstallCompositeModulesOutOfOrderFromCache self toTestInstallModulesFromCache: false forPath: self alphaModulePath ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 12/18/2001 12:15'! testInstallStandaloneModulesFromCache self toTestInstallModulesFromCache: true forPath: self pathForTestModules ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 12/18/2001 12:16'! testInstallStandaloneModulesOutOfOrderFromCache self toTestInstallModulesFromCache: true forPath: self alphaModulePath ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 1/2/2002 14:21'! toTestInstallModulesFromCache: standalone forPath: path self toTestStoreModulesInCache: standalone. self unloadModules. self verifyTestModulesNotPresent. ModuleInstaller testFullyInstallFromPath: path. self verifySubmodulesExist. self verifyClassesExist ! ! !ModuleStorageTests methodsFor: 'repository tests' stamp: 'hg 12/18/2001 10:33'! testImplicitRepository self setupAllModules. self should: [self alphaModule repository isImplicit]. self shouldnt: [self alphaModule repository isStandalone]. self shouldnt: [self alphaModule repository standaloneRepository == self alphaModule repository]. ! ! !ModuleStorageTests methodsFor: 'repository tests' stamp: 'hg 12/18/2001 10:33'! testStandaloneRepository self setupAllModules. Repository standaloneOn: self alphaModule. self should: [self alphaModule repository isStandalone]. self shouldnt: [self alphaModule repository isImplicit]. self should: [self alphaModule repository standaloneRepository == self alphaModule repository]. ! ! !ModuleStorageTests methodsFor: 'unload tests' stamp: 'hg 1/2/2002 14:21'! testUnloadEmptyModules self setupAllModules. self unloadModules. self verifyTestModulesNotPresent! ! !ModuleStorageTests methodsFor: 'unload tests' stamp: 'hg 1/2/2002 14:21'! testUnloadFilledModules self setupAllModulesAndContents. self unloadModules. self verifyTestModulesNotPresent! ! !ModuleStorageTests methodsFor: 'unload tests' stamp: 'hg 1/2/2002 14:20'! verifyTestModulesNotPresent self should: [(Module @ self pathForTestModules) isNil]! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 12/18/2001 10:08'! deleteCacheDirectories super tearDown. self setupAllModules. self shield: [self homeModule repository cache deepDeleteDirectory]. self deny: self homeModule repository cache directory exists! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 12/26/2001 23:04'! setupStandaloneRepositories Repository standaloneOn: self homeModule. Repository standaloneOn: self alphaModule. Repository standaloneOn: self betaModule. self verifyStandaloneRepositories! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 12/15/2001 11:01'! tearDown self deleteCacheDirectories. super tearDown.! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 12/18/2001 10:08'! unloadModules self assert: self homeModule notNil. ModuleInstaller unload: self homeModule. ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 12/26/2001 23:04'! verifyStandaloneRepositories self assert: self homeModule repository isStandalone. self assert: self alphaModule repository isStandalone. self assert: self betaModule repository isStandalone. ! ! !ModuleStorageTests reorganize! ('storage tests' testCompositeStoreModulesInCache testLoadModulesFromCache testStandaloneStoreModulesInCache toTestStoreModulesInCache:) ('installer tests' testInstallCompositeModulesFromCache testInstallCompositeModulesOutOfOrderFromCache testInstallStandaloneModulesFromCache testInstallStandaloneModulesOutOfOrderFromCache toTestInstallModulesFromCache:forPath:) ('repository tests' testImplicitRepository testStandaloneRepository) ('unload tests' testUnloadEmptyModules testUnloadFilledModules verifyTestModulesNotPresent) ('sample repositories' deleteCacheDirectories setupStandaloneRepositories tearDown unloadModules verifyStandaloneRepositories) ! ModuleTests removeSelector: #allAssociationsEverywhereDo:! ModuleTests removeSelector: #testIntegrityOfAllLiterals! ModuleTests removeSelector: #testIntegrityOfModuleOfClasses! ModuleTests removeSelector: #testIntegrityOfReadOnlyModuleDefinitions! ModuleTests removeSelector: #testIntegrityOfWeakClassBindings! ModuleTests removeSelector: #testIntegrityOfWeakNameDefinitions! !ModuleTests reorganize! ('module creation tests' testCreateModule testCreateSubmoduleRefs testCreateSubmodules testCreatingModuleFromPath testPassiveModuleFromPath verifyHomeModuleExists verifySubmodulesExist) ('module contents' testCreateClasses verifyClassesExist) ('code analysis' testDeclareExternalRefs testLocalUnresolvedRefs) ('module resolution' testFindSubmoduleRef testResolveSubmoduleRefs) ('sample modules' alphaModule alphaModuleName alphaModulePath alphaRef betaModule betaModuleName betaRef homeModule pathForTestModules setupAllModules setupAllModulesAndContents setupHomeModule setupSubmoduleRefs setupSubmodules tearDown) ('sample classes' accessDaughterClass accessGrandDaughterClass accessParentClass daughterClassName grandDaughterClassName parentClassName setupDaughterClass setupGrandDaughterClass setupParentClass) ('utility' shield:) !