'From Squeak3.3alpha of 30 January 2002 [latest update: #4744] on 14 February 2002 at 12:13:43 pm'! "Change Set: RemoteLoadingFixes-hg Date: 10 February 2002 Author: Henrik Gedenryd Fixes to make remote module up- and downloading work, plus lots more. Main feature #1: This also makes module unloading work without hitches. VMConstruction and Balloon3D had been made unloadable already. See this swiki page: http://minnow.cc.gatech.edu/squeak/2257 Main feature #2: Makes remote up-and downloading work properly. This uses ftp for uploads and http for downloads. You can try each one of these separately: ModuleInstaller fullyInstallFromPath: #(People hg ModuleDemos di KidsRefrigeratorMagnets) ""KidsRefrigeratorMagnet newGame"" ModuleInstaller fullyInstallFromPath: #(People hg ModuleDemos nk MagneticPoetry) ""NCMagnetRefrigerator setup"" ModuleInstaller fullyInstallFromPath: #(People hg ModuleDemos nk Connectors) ""NCButtonBar newClassDiagramToolbar openInWorld. NCButtonBar newFSMToolbar openInWorld"" Note the new preference in the modules panel that controls access to remote repositories. If you do mind a very cluttered desktop, ""NCMagnetRefrigerator setup"" gives you a cleanup button. ModuleInstaller fullyInstallFromPath: #(People hg ModuleDemos Comanche Swiki) ""ComSwikiLauncher openAsMorph"" ModuleInstaller fullyInstallFromPath: #(People hg ModuleDemos Comanche Kom Core) Keep the Transcript open to see progress messages, there are hooks for a proper progress dialog for the inclined. The last one loads just the core of Comanche without the Swiki module. I have tested that the core works but I haven't written test cases for the Swiki ;-) Note that these are just demos, not properly modularized, well-structured module versions of the above packages. "! TestCase subclass: #ModuleTests instanceVariableNames: '' classVariableNames: '' module: #(Squeak Language Modules Tests)! DeltaModuleTests subclass: #ModuleStorageTests instanceVariableNames: 'installerObject includeDeltas beComposite ' classVariableNames: '' module: #(Squeak Language Modules Tests)! !ModuleStorageTests commentStamp: '' prior: 0! Note that this class needs to run the storage tests first (to save time) and these need to pass for the other tests to be able to pass.! TestResource subclass: #RemoteModuleAccess instanceVariableNames: '' classVariableNames: 'TestFtpUrl TestHttpUrl TestPassword TestUser ' module: #(Squeak Language Modules Tests)! !RemoteModuleAccess commentStamp: '' prior: 0! To run these tests you need to have full-privileges access to the server where modules will be stored. Look at the class- side message #ftp:http: for how you can override the default location and use your own server. ! !Browser methodsFor: 'class list' stamp: 'hg 2/8/2002 09:32'! selectedClass "Answer the class that is currently selected. Answer nil if no selection exists." | name | (name _ self selectedClassName) ifNil: [^ nil]. ^Module root allDefinitionsFor: name onlyExported: false detect: [:value :module | value isBehavior and: [ self selectedSystemCategoryName = module simulatedCategory]]! ! !Class methodsFor: 'initialize-release' stamp: 'hg 2/13/2002 12:18'! removeFromSystem: logged "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver." "tell class to unload itself--it should already have been told to deactivate itself" self unload. self superclass ifNotNil:[ "If we have no superclass there's nothing to be remembered" self superclass addObsoleteSubclass: self]. self module removeClassFromSystem: self logged: logged. self obsolete! ! !Class methodsFor: 'initialize-release' stamp: 'hg 2/13/2002 12:20'! unload "Sent when a (Delta)Module holding the class is unloaded (removed). Does nothing, but may be overridden by (class-side) subclasses." ^self! ! !Module methodsFor: 'accessing' stamp: 'hg 2/9/2002 10:43'! definedNames ^self privateDefinedNames! ! !Module methodsFor: 'accessing' stamp: 'hg 2/9/2002 10:43'! exportedNames ^self privateExportedNames! ! !Module methodsFor: 'name lookup schemes' stamp: 'hg 2/10/2002 13:56'! weakDefinesName: varName ifTrue: assocBlock "Like the strong definesName but this one always uses the lookup rules for weak modularity. I.e. see all names exported from all external and submodules. " | assoc | "Look up name in home module. Treat all neighbors as imported. " assoc _ self localAssocFor: varName ifAbsent: [ "look in all external and submodules." self neighborModules do: [:mod | mod exportedAssocFor: varName ifPresent: [:a :m | assocBlock value: a. ^ true]]. nil]. assoc ifNotNil: [assocBlock value: assoc. ^true]. "Finally look it up globally. This is a compatibility patch for now. Look it up this way instead of in Smalltalk to test multiple name definitions. --Commented out or analysis of global references will always find names. " "Module root associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]." ^false! ! !Module methodsFor: 'strong name lookup' stamp: 'hg 9/30/2001 16:25'! allClassesDo: aBlock "Evaluate the argument, aBlock, for each class in this module." self definedNames valuesDo: [:value | (value isBehavior) ifTrue: [aBlock value: value]] ! ! !Module methodsFor: 'strong name lookup' stamp: 'hg 2/9/2002 10:43'! localExportedAssocFor: aString ifAbsent: aBlock "look up assoc for the given name. only look at exported names defined in this module" ^self exportedNames associationAt: aString asSymbol ifAbsent: aBlock ! ! !Module methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 10:41'! addAssoc: assoc export: exportIt self adoptIfUndeclared: assoc key. definedNames _ self privateDefinedNames add: assoc; yourself. exportIt ifTrue: [self exportName: assoc key]. self invalidateCaches! ! !Module methodsFor: 'changing defined names' stamp: 'hg 2/12/2002 14:09'! adoptIfUndeclared: aName | isUndeclared | isUndeclared _ (self localAssocFor: aName ifAbsent: [nil]) isNil and: [ Undeclared includesKey: aName]. isUndeclared ifTrue: [ definedNames _ self privateDefinedNames declare: aName from: Undeclared].! ! !Module methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 22:27'! defineName: aString as: value export: exportIt self privateDefinedNames at: aString asSymbol ifPresent: [:v | self notify: aString asText allBold, ' already defined in ', self pathAsMessages, '!!\Proceed will overwrite it.' withCRs]. ^self redefineName: aString as: value export: exportIt! ! !Module methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 22:30'! exportName: aString | assoc | assoc _ self localAssocFor: aString asSymbol ifAbsent: [self error: 'name not defined']. exportedNames _ self privateExportedNames removeKey: assoc key ifAbsent: []; add: assoc; yourself! ! !Module methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 10:44'! simplyRemoveName: aString self privateDefinedNames removeKey: aString asSymbol ifAbsent: []. self privateExportedNames removeKey: aString asSymbol ifAbsent: []. self invalidateCaches ! ! !Module methodsFor: 'defining module dependencies' stamp: 'hg 2/12/2002 13:23'! uses: aModuleOrPath "a shortcut for declaring that this module uses another module" (self externalModule: aModuleOrPath alias: nil version: nil importNames: false) resolveModule! ! !Module methodsFor: 'changing module composition' stamp: 'hg 2/9/2002 10:42'! cleanOutModule "Removing a module from the image ought to be as easy as removing from parent, but it ain't for compatibility reasons. Do other necessary things here." | classes | "classes have special removal needs" classes _ OrderedCollection new. self allClassesDo: [:cl | classes add: cl]. (ChangeSet superclassOrder: classes) reversed do: [:cl | cl removeFromSystem]. "under weak modules you must clear the names (from Smalltalk)" Preferences strongModules ifFalse: [ self privateDefinedNames keys do: [:name | self removeName: name]].! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 2/12/2002 14:33'! definition "Answer a String that builds the definition of the receiver as messages to it (don't print the receiver)." | aStream | aStream _ WriteStream on: (String new: 300). "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #version: . aStream crtab; nextPutAll:'version: '; print: self verbatimVersion. ^ aStream contents! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 2/11/2002 16:32'! neighborDefinitionsOn: aStream self privateNeighborModuleRefs do: [:ref | aStream nextPut: $;; crtab. ref storeOn: aStream]. ! ! !Module methodsFor: 'user interface' stamp: 'hg 2/9/2002 10:44'! moduleExplorerContents | list | list _ OrderedCollection new. list add: (ModuleExplorerWrapper with: self privateNeighborModuleRefs name: 'neighbor refs' model: self); add: (ModuleExplorerWrapper with: self privateDefinedNames name: 'defined names' model: self); add: (ModuleExplorerWrapper with: self privateExportedNames name: 'exported names' model: self). repository ifNotNil: [ list add: (ModuleExplorerWrapper with: self repository name: 'repository' model: self)]. self verbatimVersion ifNotNil: [ list add: (ModuleExplorerWrapper with: self verbatimVersion name: 'version' model: self)]. self annotations associationsDo: [:assoc | list _ list copyWith: (ModuleExplorerWrapper with: assoc value name: assoc key model: assoc)]. ^list ! ! !Module methodsFor: 'code analysis' stamp: 'hg 2/3/2002 14:37'! deepUnresolvedRefsWithScheme: bindingScheme | n localList dict | dict _ Dictionary new. 'Locating methods with unresolved global references...' displayProgressAt: Sensor cursorPoint from: 0 to: self deepSubAndDeltaModules size during: [:bar | n _ 0. self deepSubAndDeltaModules do: [:mod | bar value: (n_ n+1). localList _ mod localUnresolvedRefsWithScheme: bindingScheme. localList isEmpty ifFalse: [dict at: mod put: localList]. "mod setUnresolvedCount: localList size."]]. self zeroOutOfScopeCache. ^dict! ! !Module methodsFor: 'code analysis' stamp: 'hg 2/10/2002 19:41'! doesLookupOf: varName withScheme: bindingScheme giveTheAssoc: assoc useCache: varNamesCache | assocForVarName isTheSame isOK | self definesName: varName usingScheme: bindingScheme withCache: varNamesCache ifTrue: [:ass | assocForVarName _ ass]. assocForVarName ifNil: [^false]. isTheSame _ assocForVarName = assoc. "isOkSuperInDelta _ (definitionForSuperClassName isKindOf: DeltaClass) and: [ definitionForSuperClassName name == self name]." isOK _ isTheSame. ^isOK ! ! !Module methodsFor: 'code analysis' stamp: 'hg 2/13/2002 15:55'! localUnresolvedRefsWithScheme: bindingScheme "check that all used globals (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). Return the bad ones as MethodReferences." | badRefs isBad isUninterestingClass classAndMeta theSuperClass isOK assocForSuperClassName isCorrectlyDeclared | badRefs _ OrderedCollection new. self resetOutOfScopeCache. self allClassesDo: [:c | classAndMeta _ {c. (c isKindOf: DeltaClass) ifFalse: [c class] ifTrue: [c deltaForMetaclass] }. classAndMeta do: [:class | class methodDict keysAndValuesDo: [:selector :cm | isBad _ cm ~~ DeltaModule valueForUndefined and: [ cm literals anySatisfy: [:lit | lit isVariableBinding and: [lit key notNil] and: [ ((c definesName: lit key lookInSuper: true ifTrue: [:a |]) or: [ self doesLookupOf: lit key withScheme: bindingScheme giveTheAssoc: lit useCache: OutOfScopeCache]) not]]]. isBad ifTrue: [ badRefs add: ( MethodReference new setStandardClass: class methodSymbol: selector)]]]]. self allClassesDo: [:class | theSuperClass _ class superclass. isUninterestingClass _ class isObsolete | theSuperClass isNil. isUninterestingClass ifFalse: [ assocForSuperClassName _ theSuperClass module localAssocFor: theSuperClass name ifAbsent: [nil]. isCorrectlyDeclared _ self doesLookupOf: theSuperClass name withScheme: bindingScheme giveTheAssoc: assocForSuperClassName useCache: OutOfScopeCache]. isOK _ isUninterestingClass or: [isCorrectlyDeclared]. isOK ifFalse: [ badRefs add: ( MethodReference new setStandardClass: class methodSymbol: #'')]]. ^badRefs ! ! !Module methodsFor: 'code analysis' stamp: 'hg 2/3/2002 14:39'! viewDeepUnresolvedRefs "Root viewDeepUnresolvedRefs" Smalltalk browseMessageList: (self deepUnresolvedRefs values inject: #() into: [:all :refs | all, refs]) name: 'Deep Unresolved Global References from ', self pathAsMessages autoSelect: nil! ! !Module methodsFor: 'system conversion' stamp: 'hg 2/2/2002 13:08'! declareExternalRefsForSelector: selector inClass: aClass "for all unresolved globals in the method of the given selector and class, declare the global's defining module as one of my external modules" | varName definingModule cm lits isDefined | cm _ aClass compiledMethodAt: selector. lits _ cm literals. lits do: [:lit | lit isVariableBinding ifTrue: [ varName _ lit key ifNil: [lit value isBehavior ifTrue: [lit value theNonMetaClass name]]. isDefined _ self definesName: varName usingScheme: self weakOrStrongBindingScheme withCache: OutOfScopeCache ifTrue: [:a | ]. (isDefined or: [lit value == aClass]) ifFalse: [ definingModule _ Module root moduleDefining: varName. definingModule ifNotNil: [ "ensure that defining module exports it" "definingModule exportName: varName." self ensureExternalModule: definingModule]]]] ! ! !Module methodsFor: 'system conversion' stamp: 'hg 2/3/2002 14:48'! deepDeclareExternalRefs "Root deepDeclareExternalRefs" | n refsList | 'Declaring all external references...' displayProgressAt: Sensor cursorPoint from: 0 to: self deepSubAndDeltaModules size during: [:bar | n _ 0. self deepSubAndDeltaModules do: [:mod | refsList _ mod localUnresolvedRefsWithScheme: self weakOrStrongBindingScheme. mod resetOutOfScopeCache. mod localDeclareExternalRefsFor: refsList. bar value: (n_ n+1)]]. ! ! !Module methodsFor: 'system conversion' stamp: 'hg 2/11/2002 15:51'! localDeclareExternalRefsFor: refsList self resetOutOfScopeCache. self declareDefaultExternalModules. refsList do: [:ref | ref methodSymbol == #'' ifFalse: [ self declareExternalRefsForSelector: ref methodSymbol inClass: (ref actualClassForModule: self)] ifTrue: [ self ensureExternalModule: (ref actualClassForModule: self) superclass module]]. ^refsList size! ! !DeltaModule methodsFor: 'testing' stamp: 'hg 2/10/2002 19:46'! isDeltaClass: class | theNonMetaClass | (class isKindOf: DeltaClass) ifFalse: [^false]. theNonMetaClass _ class isMeta ifTrue: [class theNonMetaClass] ifFalse: [class]. self definitionFor: theNonMetaClass name ifAbsent: [^false]. self baseModule definitionFor: theNonMetaClass name ifAbsent: [^false]. ^true! ! !DeltaModule methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 22:29'! addAssoc: assoc export: exportIt "by default add DeltaAssociation with previousValue indicating undefined. Store assoc not just the value so that other code can refer to this definition and be correctly preserved." | deltaAssoc | deltaAssoc _ DeltaAssociation key: assoc key value: assoc deactivatedValue: assoc key -> DeltaModule valueForUndefined. ^super addAssoc: deltaAssoc export: exportIt ! ! !DeltaModule methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 20:59'! redefineName: aString as: value export: exportIt "special version so as not to also put globals in Smalltalk" aString first isUppercase ifFalse: [ self notify: 'Global names should be Capitalized, but "', aString asText allBold, '" is not. This could cause various problems. Cancel to avoid creating this global name.']. self addAssoc: (ReadOnlyVariableBinding key: aString asSymbol value: value) export: exportIt ! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 2/13/2002 15:33'! fileOutMethodsOn: aStream moveSource: moveSource toFile: fileIndex | metaToUse | self allClassesDo: [:class | class fileOutContentsOn: aStream moveSource: moveSource toFile: fileIndex. metaToUse _ (self isDeltaClass: class) ifTrue: [class deltaForMetaclass] ifFalse: [class class]. metaToUse nonTrivial ifTrue: [ metaToUse fileOutContentsOn: aStream moveSource: moveSource toFile: fileIndex]]! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 2/9/2002 21:27'! deltaClassFor: baseClass | deltaClass deltaAssoc | deltaClass _ DeltaClass on: baseClass inDeltaModule: self. self redefineName: baseClass name as: deltaClass export: true. "note that class was already here, so it won't be removed on deactivation" deltaAssoc _ self localDeltaAssocFor: baseClass name ifAbsent: []. deltaAssoc deactivatedValue: deltaAssoc value. ^deltaClass. ! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 2/9/2002 22:49'! deltaClassFor: baseClassOrMeta forceCreate: create | baseClass deltaClass | baseClass _ baseClassOrMeta theNonMetaClass. baseClass module == self baseModule ifFalse: [ self error: baseClass name, ' is not defined in my base module']. deltaClass _ self newDefinitionFor: baseClass name ifAbsent: [ ^create ifTrue: [self deltaClassFor: baseClass]]. (deltaClass isKindOf: Class) ifFalse: [ self error: baseClass name, ' is not a class']. ^baseClassOrMeta isMeta ifFalse: [deltaClass] ifTrue: [deltaClass deltaForMetaclass]! ! !DeltaModule methodsFor: 'de/activating' stamp: 'hg 2/13/2002 12:05'! effectDefinitionChanges: shouldBeActive into: module "this includes newly created (non-Delta) classes" | newAssoc newValue currentValue | self privateDefinedNames associationsDo: [:deltaAssoc | newAssoc _ deltaAssoc valueWhenActive: shouldBeActive. newValue _ newAssoc value. (self isDeltaClass: newValue) ifFalse: [ currentValue _ module definitionFor: deltaAssoc key ifAbsent: [self class valueForUndefined]. deltaAssoc preserveCurrentValue: deltaAssoc key -> currentValue before: shouldBeActive. newValue = self class valueForUndefined ifFalse: [ [module addAssoc: newAssoc export: (self privateExportedNames includesKey: deltaAssoc key)] on: AttemptToWriteReadOnlyGlobal do: [:ex | ex resume: true]] ifTrue: [ (module localAssocFor: deltaAssoc key ifAbsent: [nil]) ifNotNilDo: [:a | deltaAssoc preserveCurrentValue: a before: shouldBeActive. module removeName: deltaAssoc key]]]].! ! !DeltaModule methodsFor: 'de/activating' stamp: 'hg 1/12/2002 16:12'! simplyEffectChanges: shouldBeActive "Make me be active or inactive. A DeltaModule is a modified version of its baseModule. Activating a DM means to modify its baseModule by installing its changes into it." self isActive = shouldBeActive ifTrue: [^nil]. self effectDefinitionChanges: shouldBeActive into: self baseModule. self effectMethodChangesConservatively: shouldBeActive. self effectClassFormatChanges: shouldBeActive.! ! !DeltaModule methodsFor: 'code analysis' stamp: 'hg 2/10/2002 19:47'! doesLookupOf: varName withScheme: bindingScheme giveTheAssoc: assoc useCache: varNamesCache | isTheSame isOK foundAssoc foundValue isBaseClassNotDeltaClass | self definesName: varName usingScheme: bindingScheme withCache: varNamesCache ifTrue: [:ass | foundAssoc _ ass]. foundAssoc ifNil: [^false]. isTheSame _ foundAssoc = assoc. foundValue _ foundAssoc value. isTheSame ifFalse: [self halt]. isBaseClassNotDeltaClass _ (self isDeltaClass: foundValue) and: [foundValue baseClass == assoc value] and: [(self importedAssocFor: varName ifPresent: [:a :m | ]) == assoc]. isOK _ isTheSame | isBaseClassNotDeltaClass. ^isOK ! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/9/2002 22:56'! allClassesDo: aBlock "Evaluate the argument, aBlock, for each class in this module." self privateDefinedNames valuesDo: [:value | (value value isBehavior) ifTrue: [aBlock value: value value]] ! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/10/2002 19:53'! definedNames | names | "self isActive ifTrue: [^self baseModule definedNames]." names _ Dictionary newFrom: self privateDefinedNames values. self baseModule definedNames associationsDo: [:assoc | names at: assoc key ifAbsent: [names add: assoc]]. ^names! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/10/2002 21:15'! exportedAssocFor: aString ifPresent: aBlock "modules looking 'into' me from outside will see base classes, but looking from inside me will see deltas" | assoc | assoc _ self baseModule localExportedAssocFor: aString asSymbol ifAbsent: [ self baseModule localExportedAssocFor: aString asSymbol ifAbsent: [ self importedAssocFor: aString ifPresent: [:ass :mod | aBlock value: ass value: mod. ^ass]. ^nil]]. aBlock value: assoc value: self. ^assoc! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/10/2002 19:55'! exportedNames | names | "self isActive ifTrue: [^self baseModule exportedNames]." names _ Dictionary newFrom: self privateExportedNames. self baseModule exportedNames associationsDo: [:assoc | names at: assoc key ifAbsent: [names add: assoc]]. ^names! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/9/2002 22:41'! localDeltaAssocFor: aString ifAbsent: aBlock ^self privateDefinedNames associationAt: aString asSymbol ifAbsent: aBlock! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/9/2002 22:47'! newDefinitionFor: aString ifAbsent: aBlock ^(self localDeltaAssocFor: aString ifAbsent: [^aBlock value]) value value! ! !DeltaModule methodsFor: 'accessing defined names' stamp: 'hg 2/9/2002 21:31'! oldDefinitionFor: aString ifAbsent: aBlock ^(self localDeltaAssocFor: aString ifAbsent: [^aBlock value]) deactivatedValue value! ! !Module class methodsFor: 'system conversion' stamp: 'hg 2/14/2002 09:36'! fromPath: modulePath forceCreate: create "return the module with the given path" "don't be case sensitive but preserve given case when creating names" | subref | ^modulePath inject: self root into: [:parentModule :localName | subref _ parentModule neighborModuleRefs detect: [:ref | ref refersToSubmodule | ref refersToDeltaModule and: [ ref name asLowercase = localName asLowercase]] ifNone: [ create ifTrue: [ parentModule == self root ifTrue: [ self error: 'You cannot add new modules at the top level.']. "creation phase 1: create unresolved reference (i.e. not the module)" parentModule submodule: nil name: localName version: nil importNames: false]]. (create and: [subref isModuleResolved not]) ifTrue: [ "creation phase 2: resolve the module reference" subref resolvedModule: (Module new version: nil parentModule: parentModule)]. (subref isNil or: [subref isModuleResolved not]) ifTrue: [^nil]. subref module]! ! !ModuleExplorer methodsFor: 'as yet unclassified' stamp: 'hg 2/11/2002 15:49'! trash "some example expressions to try" ^'NOTE: You may close this window at any time. will get a new one "try these on some modules (cmd-p / cmd-I)..." self deepDeclareExternalRefs. self viewDeepUnresolvedRefs. self path self deepIncomingRefsFromOutside: self self deepIncomingRefsFromOutside: parentModule self deepUniqueMessagesToOutside: self self defineClassExtensionsOutside: self self repository beStandalone self repository directory url ModuleInstaller upload: self ModuleInstaller fullyInstallFromPath: #(Temporary TestModule) ModuleInstaller unload: self Repository importChangesFromFileNamed: ''sample.cs'' intoModuleAt: #(Temporary TestModule) ' ! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 2/14/2002 10:25'! compositeLoadingDependenciesFor: module except: excludedModules "compute dependencies, taking into account that both ends of dependencies may reside in composite repositories" | allNeeded compositesNeeded | allNeeded _ IdentitySet new. module repository compositeModules do: [:mod | allNeeded addAll: ((self allModulesNeededBy: mod exceptForNeedsOf: excludedModules) copyWithoutAll: mod deepSubmodules)]. compositesNeeded _ allNeeded collect: [:mod | mod repository standaloneRepository module]. compositesNeeded remove: module ifAbsent: []. ^compositesNeeded! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 2/13/2002 17:35'! directlyReachableModulesFor: module "just preliminary" ^module neighborModules! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 2/13/2002 14:47'! ensureModuleDependenciesDeclared | badOnes stillBadOnes | self phase: 'Verifyifying dependencies for all uploaded modules.' progressTotal: 0. badOnes _ self startModule deepUnresolvedRefs. badOnes isEmpty ifTrue: [^self]. self notify: 'At least one module does not completely declare its module dependencies, which are needed to load the module properly. (There may be Undeclared references.) Proceed to attempt declaring the dependecies automatically from referenced global names, or cancel to do it manually.'. self note: 'Declaring dependencies...'. badOnes keysAndValuesDo: [:mod :refs | mod localDeclareExternalRefsFor: refs]. stillBadOnes _ badOnes keys select: [:mod | (mod localUnresolvedRefsWithScheme: mod weakOrStrongBindingScheme) notEmpty]. stillBadOnes isEmpty ifTrue: [^self noteDone]. stillBadOnes do: [:mod | self note: '>> Module ', mod printString, ' has undeclared dependencies.']. self notify: 'The attempt to declare used modules from referenced global names did not completely succeed. (There may be Undeclared references.) Proceed to go ahead anyway, otherwise cancel.'. ! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 2/10/2002 18:17'! orderWithinCompositeFor: modules ^self pureDependencyOrderFor: modules! ! !ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 2/10/2002 18:17'! pureDependencyOrderFor: modules | dependencies | dependencies _ modules asSet collect: [:mod | mod -> ((self allModulesNeededBy: mod exceptForNeedsOf: modules) copyWithoutAll: mod deepSubmodules)]. ^self modules: modules inDependencyOrderFrom: dependencies! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 2/3/2002 16:32'! ensureAllReachableModulesResolved: firstModuleRef "Ensure that all recursively reachable modules are defined. This is a basic breadth-first graph traversal algorithm. Note that moduleRefs at first are unresolved, i.e. have paths instead of modules in their module slot." | remaining refToResolve modulesDefined neighborRefsToScan | remaining _ OrderedCollection new. self addReferencesToResolve: (Array with: firstModuleRef) to: remaining. [remaining isEmpty] whileFalse: [ refToResolve _ remaining removeFirst. modulesDefined _ self ensureModuleResolved: refToResolve. neighborRefsToScan _ self refsToScanFrom: modulesDefined. self addReferencesToResolve: neighborRefsToScan to: remaining]! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 2/3/2002 16:34'! ensureModuleResolved: moduleRef "ensure that the Module object for the moduleRef is in the image and correctly defined. First ask the moduleRef to find a matching module for its path and version. If none, I first need to ensure that the module definition file is in the cache, then create the Module object from the definition. Return all modules that were defined--note that a composite repository may define more than one module at once. If module is created here, then assume it has a standalone repository since it must be loaded as itself, if it were part of another repository then it would have to be loaded together with it." | module modulesDefined definingRepository | moduleRef resolveModule ifNotNil: [^#()]. module _ moduleRef createModuleFromPathAndVersion. (self repositoryToUseFor: module) defineAsStandaloneOrNotFromDirectoryStructure. definingRepository _ (self repositoryToUseFor: module) standaloneRepository. self note: 'Loading definition for ', definingRepository module pathAndVersion literalPrintString,'...'. modulesDefined _ definingRepository defineCompositeModulesFromFile. "mark that modules were created" definedModules addAll: modulesDefined. moduleRef isModuleResolved ifFalse: [self error: 'Loading module definition failed.']. self noteDone. ^modulesDefined ! ! !ModuleInstaller methodsFor: 'defining modules' stamp: 'hg 2/11/2002 16:14'! refsToScanFrom: modules ^(modules inject: #() into: [:all :module | all, module repository referencesForNeededModules]) asIdentitySet.! ! !ModuleInstaller methodsFor: 'up/downloading modules' stamp: 'hg 2/10/2002 14:18'! checkStandaloneBeforeUpload self startModule repository isStandalone ifFalse: [ self error: 'An uploaded module must have a standalone repository.']! ! !ModuleInstaller methodsFor: 'up/downloading modules' stamp: 'hg 2/8/2002 11:33'! downloadModuleIntoCache: module | count | self note: 'Downloading ', module printString, '...'. count _ module repository namesOfContentsFilesToDownload size. "FTP may raise warnings, treat these as errors." [module repository ensureCompleteModuleInCache] on: Warning do: [:ex | self error: 'Download error']. self progressAdd: count. downloadedModules add: module. "record that module was downloaded" self noteDone ! ! !ModuleInstaller methodsFor: 'up/downloading modules' stamp: 'hg 2/8/2002 15:11'! ensureAllModulesDownloadedInCache "ensure that all loaded modules needing to be loaded have their necessary files in the cache." | modulesToDownload missingModules total | modulesToDownload _ self modulesToLoad asOrderedCollection reject: [:mod | mod repository cache checkCompleteModuleContentsOK]. self workOffline ifFalse: [ total _ ((modulesToDownload collect: [:mod | mod repository namesOfContentsFilesToDownload size]), #(0)) sum. self phase: 'Downloading module files.' progressTotal: total. modulesToDownload do: [:mod | self downloadModuleIntoCache: mod]]. missingModules _ definedModules reject: [:mod | mod repository cache checkCompleteModuleContentsOK]. missingModules notEmpty ifTrue: [ missingModules do: [:mod | self note: 'Complete contents for ', mod printString, ' not in cache.']. self error: 'Some modules missing in cache']. ! ! !ModuleInstaller methodsFor: 'up/downloading modules' stamp: 'hg 2/3/2002 14:21'! repositoryToUseFor: module ^self workOffline ifFalse: [module repository] ifTrue: [module repository cache]! ! !ModuleInstaller methodsFor: 'up/downloading modules' stamp: 'hg 2/3/2002 16:38'! storeStandaloneRepositoriesInCache | standaloneRepositories | self phase: 'Storing all modules in cache...' progressTotal: self startModule deepSubAndDeltaModules size. standaloneRepositories _ self startModule deepSubAndDeltaModules select: [:mod | mod repository isStandalone] thenCollect: [:mod | mod repository cache]. standaloneRepositories do: [:rep | rep ensurePreconditionsForUpload; storeModuleComposite. self progressAdd: rep compositeModules size]. self noteDone! ! !ModuleInstaller methodsFor: 'up/downloading modules' stamp: 'hg 2/11/2002 19:42'! uploadStandaloneRepositories | standaloneRepositories servers openSessions | self phase: 'Uploading all modules...' progressTotal: self startModule deepSubAndDeltaModules size. standaloneRepositories _ self startModule deepSubAndDeltaModules select: [:mod | mod repository isStandalone] thenCollect: [:mod | mod repository]. servers _ standaloneRepositories collect: [:rep | rep topRepository]. servers _ servers asSet. openSessions _ servers collect: [:rep | rep ensureLoggedInForWrite. rep directory wakeUp; yourself]. [(openSessions anySatisfy: [:serverDir | serverDir isAwake not]) ifTrue: [ self error: 'Could not connect to remote server.']. standaloneRepositories do: [:rep | rep ensurePreconditionsForUpload; uploadFromCache. self progressAdd: rep compositeModules size] ] ensure: [openSessions do: [:serverDir | serverDir sleep]]. self noteDone! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 2/4/2002 11:51'! ensureAllModulesLoaded "load the contents for all modules that need to be loaded" | totalSize modulesToLoad | modulesToLoad _ self modulesToLoad. totalSize _ modulesToLoad inject: 0 into: [:subTotal :module | subTotal + module repository cache sizeOfContentsFiles]. self phase: 'Loading all needed modules into image. ' progressTotal: totalSize. (self loadingOrderFor: modulesToLoad) do: [:module | self loadContentsForModule: module]! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 2/4/2002 11:52'! loadContentsForModule: module | allLoadedModules | self note: 'Loading contents for ', module printString, '...'. allLoadedModules _ module repository cache loadModuleContents. self progressAdd: module repository cache sizeOfContentsFiles. loadedModules addAll: allLoadedModules. self noteDone ! ! !ModuleInstaller methodsFor: '(un)loading' stamp: 'hg 2/13/2002 14:39'! modulesToLoad ^(definedModules collect: [:mod | mod repository standaloneRepository module] thenSelect: [:mod | mod repository isAbstract not]) asSet! ! !ModuleInstaller methodsFor: 'public' stamp: 'hg 2/13/2002 10:08'! fullyInstallModule "carry out all actions necessary to fully instate the module" self showProgressDuring: [ self gracefullyExecute: [ self ensureAllModulesDefined. self preserveUninstallInformation. self identifyConflicts. self ensureAllModulesDownloadedInCache. self ensureAllModulesLoaded. self ensureAllModulesActive. self initializeLoadedModules]]! ! !ModuleInstaller methodsFor: 'public' stamp: 'hg 2/3/2002 17:06'! fullyUninstallModule "carry out all actions necessary to fully remove all effects of this installation" self showProgressDuring: [ self gracefullyExecute: [ self reverseActivatedModules. self reverseLoadedModules. self reverseDefinedModules]]! ! !ModuleInstaller methodsFor: 'public' stamp: 'hg 2/10/2002 12:16'! uploadModule "carry out all actions necessary to upload the module and all submodules" self checkStandaloneBeforeUpload. self showProgressDuring: [ self ensureModuleDependenciesDeclared. self gracefullyExecute: [ self storeStandaloneRepositoriesInCache. self workOffline ifFalse: [self uploadStandaloneRepositories] ]] ! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 2/10/2002 18:20'! activationOrderFor: modules ^self pureDependencyOrderFor: modules! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 2/13/2002 18:57'! ensureAllModulesActive "Ensure that all necessary modules are active. Note that this is not symmetric with ensureDeactivate, external, non-submodules may be activated." | modulesToActivate eligibleModules orderedModulesToActivate | eligibleModules _ (self allModulesNeededBy: self startModule exceptForNeedsOf: #()) addAll: (self loadedModules ifNil: [Array with: self startModule]); yourself. modulesToActivate _ eligibleModules reject: [:module | module isActive]. orderedModulesToActivate _ self activationOrderFor: modulesToActivate. self phase: 'Activating modules...' progressTotal: modulesToActivate size. Preferences conservativeModuleDeActivation ifFalse: [self switchModulesWithBecome: orderedModulesToActivate beActive: true] ifTrue: [self switchModulesConservatively: orderedModulesToActivate beActive: true]. activatedModules _ orderedModulesToActivate. self noteDone! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 2/13/2002 12:35'! sendActivationMessages: beActive toClassesIn: module | selector mod | selector _ beActive ifTrue: [#activate] ifFalse: [#deactivate]. mod _ (module isKindOf: DeltaModule) ifTrue: [module baseModule] ifFalse: [module]. mod allClassesDo: [:cl | (cl class includesSelector: selector) ifTrue: [ cl perform: selector]]! ! !ModuleInstaller methodsFor: '(de)activating' stamp: 'hg 2/13/2002 12:35'! switchModulesConservatively: modules beActive: beActive "Switch the activation status of all given modules. Classes are modified by directly modifying method dictionaries, and recompiling classes to effect format changes." modules do: [:mod | beActive ifFalse: [self sendActivationMessages: false toClassesIn: mod]. mod isDeltaModule ifTrue: [mod simplyEffectChanges: beActive]. beActive ifTrue: [self sendActivationMessages: true toClassesIn: mod]. mod markAsActive: beActive. self progressAdd: 1].! ! !ModuleInstaller methodsFor: 'utilities' stamp: 'hg 2/3/2002 17:05'! gracefullyExecute: aBlock "wrap the execution of the block in progress notification and error handling routines" [[aBlock value. self done] on: Warning do: [:ex | ex resume: true] ] on: Error do: [:ex | withRecovery ifTrue: [ [ex signal] ensure: [ self revertGracefullyToStableState. self done]] ifFalse: [ex signal]]! ! !ModuleInstaller class methodsFor: 'instance creation' stamp: 'hg 2/3/2002 17:09'! do: selector forModule: mod ^self do: selector forModuleRef: ((mod parentModule refForNeighborModule: mod) ifNil: [ModuleReference onPath: mod path])! ! !ModuleInstaller class methodsFor: 'instance creation' stamp: 'hg 2/3/2002 17:09'! do: selector forModuleRef: moduleReference ^self do: selector forModuleRef: moduleReference withRecovery: true! ! !ModuleInstaller class methodsFor: 'start operations' stamp: 'hg 2/3/2002 15:14'! upload: mod ^self do: #uploadModule forModule: mod! ! !ModuleInstaller class methodsFor: 'debugging' stamp: 'hg 2/6/2002 16:03'! testActivate: mod ^self do: #ensureAllModulesActive forModuleRef: (mod parentModule refForNeighborModule: mod) withRecovery: false! ! !ModuleInstaller class methodsFor: 'debugging' stamp: 'hg 2/6/2002 16:03'! testUpload: mod ^self do: #uploadModule forModuleRef: (mod parentModule refForNeighborModule: mod) withRecovery: false! ! !ModuleRefactorer methodsFor: 'moving modules' stamp: 'hg 2/12/2002 11:13'! moveDeltaModule: mod toParent: newParent | ref | ref _ mod parentModule removeNeighborModule: mod. mod version: mod verbatimVersion parentModule: newParent. newParent privateAddNeighborModuleRef: ref! ! !ModuleReference methodsFor: 'installer support' stamp: 'hg 2/10/2002 17:54'! findModuleFromPathAndVersion "this is just preliminary" ^self specifiedModule ifNotNilDo: [:mod | ((mod isKindOf: Module) and: [ self acceptAnyVersion or: [self versionIdenticalTo: mod version]]) ifTrue: [self resolvedModule: mod]]! ! !ModuleReference methodsFor: 'installer support' stamp: 'hg 2/10/2002 17:55'! specifiedModule ^Module @ self specifiedPath! ! !ModuleReference methodsFor: 'printing' stamp: 'hg 2/12/2002 15:10'! storeOn: aStream "write a message string that will create myself if sent to a module" "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #externalModule:alias:version:importNames: . aStream nextPutAll: 'externalModule: ', self ensuredPath literalPrintString; nextPutAll: ' alias: '; print: self alias; nextPutAll: ' version: '; print: specifiedVersion; nextPutAll: ' importNames: '; print: self importNames ! ! !DeltaModuleReference methodsFor: 'resolving' stamp: 'hg 2/10/2002 18:06'! createModuleWithParent: parentModule | delta | delta _ DeltaModule baseModuleRef: ((ModuleReference onPath: self specifiedPathAndVersion) importNames: true) parentModule: parentModule. self ensureReferenceFrom: parentModule. self parentModule: nil. self resolvedModule: delta. ^self module! ! !DeltaModuleReference methodsFor: 'resolving' stamp: 'hg 2/10/2002 17:57'! rawParent "a special trick since deltas can't have aliases anyway" ^name! ! !DeltaModuleReference methodsFor: 'resolving' stamp: 'hg 2/10/2002 17:58'! specifiedModule ^self rawParent ifNotNilDo: [:parent | parent deltaModuleFor: Module @ self specifiedPath]! ! !DeltaModuleReference class methodsFor: 'as yet unclassified' stamp: 'hg 2/10/2002 15:06'! onPath: baseModulePath parentModule: parentModule ^(self onPath: baseModulePath) parentModule: parentModule; yourself! ! !ModuleSystemIntegrityTests methodsFor: 'system integrity tests' stamp: 'hg 2/13/2002 15:57'! 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 notNil and: [binding value == cl]. good ifFalse: [allBad add: {cl. binding}]]. self should: [allBad isEmpty]! ! !ModuleSystemIntegrityTests methodsFor: 'utility' stamp: 'hg 2/3/2002 14:37'! 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 _ (Module root deepUnresolvedRefsWithScheme: Module root defaultBindingScheme). self should: [badOnes isEmpty] ! ! !ModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:29'! verifyAllModuleContentsExist self verifyClassesExist; verifyGlobalsExist; "globals should not be initialized" verifyMethodsWork! ! !ModuleTests methodsFor: 'code analysis' stamp: 'hg 2/2/2002 15:43'! testDeclareExternalRefs self setupAllModulesAndContents. self homeModule deepDeclareExternalRefs. self should: [self homeModule deepUnresolvedRefs isEmpty]! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 2/2/2002 13:30'! pathForTestModules ^self pathForTestingArea copyWith: #HomeModule! ! !ModuleTests methodsFor: 'sample modules' stamp: 'hg 2/6/2002 22:57'! pathForTestingArea ^#(Temporary TestingRange)! ! !ModuleTests methodsFor: 'support' stamp: 'hg 2/12/2002 14:02'! cleanOut self shield: [ Module smalltalk removeName: self alphaModuleName; removeName: self betaModuleName; removeName: self globalVarName; removeName: self globalVarName2; removeName: self parentClassName; removeName: self daughterClassName; removeName: self grandDaughterClassName]. self allModules, self circularModules 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 allModules do: [:module | self assert: module isNil].! ! !ModuleTests methodsFor: 'support' stamp: 'hg 2/3/2002 21:46'! setUp "make sure that no cruft was left around that will disturb this test" self cleanOut! ! !ModuleTests methodsFor: 'support' stamp: 'hg 2/3/2002 18:15'! tearDown self cleanOut! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:54'! circularClassA ^self circularModuleA perform: self circularClassAName! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:39'! circularClassAName ^'CircularClassA'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:54'! circularClassB ^self circularModuleB perform: self circularClassBName! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:39'! circularClassBName ^'CircularClassB'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:39'! circularGlobalAName ^'CircularGlobalA'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:39'! circularGlobalBName ^'CircularGlobalB'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:33'! circularModuleA ^Module @ self circularModuleAPath! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:30'! circularModuleAName ^'CircularModuleA'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:31'! circularModuleAPath ^self pathForTestModules copyWith: self circularModuleAName! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:33'! circularModuleB ^Module @ self circularModuleBPath! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:31'! circularModuleBName ^'CircularModuleB'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:31'! circularModuleBPath ^self pathForTestModules copyWith: self circularModuleBName! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 14:03'! circularModules ^{self circularModuleA. self circularModuleB }! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:55'! circularTestSelector ^#myReferencesAreNotNil! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 14:06'! sampleCircularMethodASource ^self circularTestSelector, ' ^', self circularGlobalBName, ' notNil and: [', self circularClassBName,' isBehavior]' ! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 14:06'! sampleCircularMethodBSource ^self circularTestSelector, ' ^', self circularGlobalAName, ' notNil and: [', self circularClassAName,' isBehavior]' ! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:38'! setupCircularClassA ^Object subclass: self circularClassAName instanceVariableNames: '' classVariableNames: '' module: self circularModuleA! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:39'! setupCircularClassB ^Object subclass: self circularClassBName instanceVariableNames: '' classVariableNames: '' module: self circularModuleB! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:45'! setupCircularContentsA | classA | self circularModuleA defineName: self circularGlobalAName as: 13 export: true. classA _ self setupCircularClassA. classA compile: self sampleCircularMethodASource classified: 'test'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:45'! setupCircularContentsB | classB | self circularModuleB defineName: self circularGlobalBName as: 13 export: true. classB _ self setupCircularClassB. classB compile: self sampleCircularMethodBSource classified: 'test'! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 13:29'! setupCircularSubmodules Module fromPath: self circularModuleAPath forceCreate: true. Module fromPath: self circularModuleBPath forceCreate: true. ! ! !ModuleTests methodsFor: 'Undeclared tests' stamp: 'hg 2/12/2002 14:06'! testUnresolvedHandlesCircularDefinitions self setupCircularSubmodules. self setupCircularContentsA. self assert: self circularClassA notNil. self assert: (self circularClassA new respondsTo: self circularTestSelector). self deny: (self circularClassA new perform: self circularTestSelector). self setupCircularContentsB. self assert: self circularClassB notNil. self assert: (self circularClassB new respondsTo: self circularTestSelector). self should: [self circularClassB new perform: self circularTestSelector]. self should: [self circularClassA new perform: self circularTestSelector]. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:06'! accessNewClassInDelta self assert: self deltaForBeta notNil. ^self deltaForBeta newDefinitionFor: self newClassName ifAbsent: [nil].! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:07'! accessNewClassInstalled ^self betaModule definitionFor: self newClassName ifAbsent: [nil].! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:07'! newClassName ^'NewlyAddedClass'! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:04'! toCreateDeltaMethods | impl | impl _ self class classThatUnderstands: #daughterString. self accessDaughterDeltaClass copy: #daughterString from: impl. self accessDaughterDeltaClass copy: #methodToAdd from: DeltaModuleTests. self accessDaughterDeltaClass undefinedSelectors: #(methodToDelete). self accessGrandDaughterDeltaClass copy: #grandDaughterString from: impl. self accessNewClassInDelta copy: #daughterString from: impl. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 10:55'! toCreateDeltaModuleContents self toCreateAllModuleContents; toCreateDeltaClasses; toCreateNewClasses; toCreateDeltaMethods; toCreateMetaDeltaMethods; toCreateDeltaGlobals. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:04'! toCreateMetaDeltaMethods | impl | impl _ self class classThatUnderstands: #daughterString. self accessDaughterDeltaClass deltaForMetaclass copy: #daughterString from: impl. self accessDaughterDeltaClass deltaForMetaclass copy: #methodToAdd from: DeltaModuleTests. self accessDaughterDeltaClass deltaForMetaclass undefinedSelectors: #(methodToDelete). self accessGrandDaughterDeltaClass deltaForMetaclass copy: #grandDaughterString from: impl. self accessNewClassInDelta class copy: #daughterString from: impl. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:06'! toCreateNewClasses ^Object subclass: self newClassName instanceVariableNames: '' classVariableNames: '' module: self deltaForBeta! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:54'! validateDeltaClasses self should: [self accessDaughterDeltaClass notNil]. self should: [self accessGrandDaughterDeltaClass notNil]. self should: [self accessDaughterDeltaClass superclass == self accessParentClass]. self should: [self accessGrandDaughterDeltaClass superclass == self accessDaughterClass]. self shouldnt: [self accessDaughterDeltaClass deltaForMetaclass == self accessDaughterDeltaClass superclass]. self shouldnt: [self accessGrandDaughterDeltaClass deltaForMetaclass == self accessGrandDaughterDeltaClass superclass]. self should: [self accessNewClassInDelta notNil]. self shouldnt: [self accessNewClassInDelta superclass isKindOf: DeltaClass]. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/9/2002 22:48'! verifyDeltaGlobalsExist self should: [self deltaForBeta definesName: self globalVarName ifTrue: [:a|]]. self should: [self deltaForBeta definesName: self globalVarName2 ifTrue: [:a|]]. self should: [(self deltaForBeta newDefinitionFor: self globalVarName2 ifAbsent: [nil]) == DeltaModule valueForUndefined]. self should: [self deltaForAlpha definesName: self globalVarName ifTrue: [:a|]]. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/9/2002 22:47'! verifyDeltaGlobalsSet self should: [(self deltaForBeta newDefinitionFor: self globalVarName ifAbsent: [nil]) = self deltaGlobalValue]. self should: [(self deltaForAlpha newDefinitionFor: self globalVarName ifAbsent: [nil]) = self deltaGlobalValue]! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:25'! verifyMetaMethodsWork self should: [self accessParentClass parentString = super parentString]. self should: [self accessDaughterClass daughterString = super daughterString]. self should: [self accessDaughterClass methodToDelete]. self shouldnt: [self accessDaughterClass respondsTo: #methodToAdd]. self should: [self accessGrandDaughterClass grandDaughterString = super grandDaughterString]. self should: [self accessGrandDaughterClass daughterString = super daughterString]. self should: [self accessGrandDaughterClass methodToDelete].! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:39'! verifyMethodsInDelta self shouldnt: [(self accessDaughterDeltaClass methodDict at: #daughterString ifAbsent: [nil]) isNil]. self shouldnt: [(self accessDaughterDeltaClass methodDict at: #methodToAdd ifAbsent: [nil]) isNil]. self shouldnt: [(self accessDaughterDeltaClass methodDict at: #methodToDelete ifAbsent: [3]) = 3]. self shouldnt: [(self accessGrandDaughterDeltaClass methodDict at: #grandDaughterString ifAbsent: [nil]) isNil]. self shouldnt: [(self accessNewClassInDelta methodDict at: #daughterString ifAbsent: [nil]) isNil]. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:39'! verifyMethodsInMetaDelta self shouldnt: [(self accessDaughterDeltaClass deltaForMetaclass methodDict at: #daughterString ifAbsent: [nil]) isNil]. self shouldnt: [(self accessDaughterDeltaClass deltaForMetaclass methodDict at: #methodToAdd ifAbsent: [nil]) isNil]. self shouldnt: [(self accessDaughterDeltaClass deltaForMetaclass methodDict at: #methodToDelete ifAbsent: [3]) = 3]. self shouldnt: [(self accessGrandDaughterDeltaClass deltaForMetaclass methodDict at: #grandDaughterString ifAbsent: [nil]) isNil]. self shouldnt: [(self accessNewClassInDelta class methodDict at: #daughterString ifAbsent: [nil]) isNil]. ! ! !DeltaModuleTests methodsFor: 'module contents' stamp: 'hg 2/13/2002 11:28'! verifyMethodsWork self should: [self accessParentClass new parentString = super parentString]. self should: [self accessDaughterClass new daughterString = super daughterString]. self should: [self accessDaughterClass new methodToDelete]. self shouldnt: [self accessDaughterClass new respondsTo: #methodToAdd]. self should: [self accessGrandDaughterClass new grandDaughterString = super grandDaughterString]. self should: [self accessGrandDaughterClass new daughterString = super daughterString]. self should: [self accessGrandDaughterClass new methodToDelete].! ! !DeltaModuleTests methodsFor: 'sample modules' stamp: 'hg 2/3/2002 18:15'! cleanOut super cleanOut. self shield: [ Module smalltalk removeName: self ownerModulePath last]. self allDeltaTestModules do: [:module | (module notNil and: [module isKindOf: Module]) ifTrue: [self shield: [module cleanOutModule]]]. Module @ self ownerModulePath allButLast ifNotNilDo: [:m | self shield: [ m removeNeighborModule: self ownerModule]]. self allDeltaTestModules do: [:module | self assert: module isNil]! ! !DeltaModuleTests methodsFor: 'sample modules' stamp: 'hg 2/7/2002 09:50'! ownerModulePath ^self pathForTestingArea copyWith: #DeltaOwnerModule! ! !DeltaModuleTests methodsFor: 'sample modules' stamp: 'hg 2/2/2002 17:05'! unloadModules self ownerModule ifNotNil: [ ModuleInstaller unload: self ownerModule]. super unloadModules. ! ! !DeltaModuleTests methodsFor: 'module creation tests' stamp: 'hg 2/13/2002 11:12'! testCreateDeltaClasses self testCreateDeltaModules. self toCreateClasses; toCreateDeltaClasses; toCreateNewClasses. self validateDeltaClasses! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 1/12/2002 17:59'! testActivateDeactivateDeltaModules self testActivateDeltaModules. ModuleInstaller deactivate: self ownerModule. self verifyDeactivatedDeltaModulesWork! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 1/13/2002 21:04'! testActivateDeltaGlobals self testCreateDeltaGlobals. ModuleInstaller testActivate: self ownerModule. self verifyActivatedDeltaGlobals! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:36'! testActivateDeltaMethods self testCreateDeltaMethods; toCreateMetaDeltaMethods; toCreateMethods. ModuleInstaller testActivate: self ownerModule. self verifyActivatedDeltaMethodsWork; verifyActivatedMetaDeltaMethodsWork! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:48'! testDeactivateDeltaMethods self testCreateDeltaMethods; toCreateMetaDeltaMethods; toCreateMethods; toCreateClassMethods. ModuleInstaller deactivate: self ownerModule. self verifyDeactivatedDeltaMethodsWork; verifyDeactivatedMetaDeltaMethodsWork! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/10/2002 14:37'! verifyActivatedDeltaGlobals self should: [(self betaModule perform: self globalVarName) = self deltaGlobalValue]. self shouldnt: [self betaModule definesName: self globalVarName2 ifTrue: [:a | ]]. self should: [(self alphaModule perform: self globalVarName) = self deltaGlobalValue]. self should: [(self deltaForBeta oldDefinitionFor: self globalVarName ifAbsent: []) = self globalValue]. self should: [(self deltaForBeta oldDefinitionFor: self globalVarName2 ifAbsent: []) = self globalValue]. self should: [(self deltaForBeta localDeltaAssocFor: self globalVarName2 ifAbsent: []) deactivatedValue isKindOf: LookupKey]. "should preserve the association" self should: [(self deltaForAlpha oldDefinitionFor: self globalVarName ifAbsent: []) = DeltaModule valueForUndefined]. ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:37'! verifyActivatedDeltaMethodsWork self should: [self accessDaughterClass new daughterString = self daughterString]. self should: [self accessDaughterClass new methodToAdd]. self shouldnt: [self accessDaughterClass new respondsTo: #methodToDelete]. self should: [self accessGrandDaughterClass new grandDaughterString = self grandDaughterString]. self should: [self accessGrandDaughterClass new daughterString = self daughterString]. self should: [self accessGrandDaughterClass new methodToAdd]. self should: [self accessNewClassInstalled new daughterString = self daughterString]. ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:43'! verifyActivatedDeltaModulesWork self verifyActivatedDeltaGlobals; verifyActivatedNewClass; verifyActivatedDeltaMethodsWork; verifyActivatedMetaDeltaMethodsWork! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:37'! verifyActivatedMetaDeltaMethodsWork self should: [self accessDaughterClass daughterString = self daughterString]. self should: [self accessDaughterClass methodToAdd]. self shouldnt: [self accessDaughterClass respondsTo: #methodToDelete]. self should: [self accessGrandDaughterClass grandDaughterString = self grandDaughterString]. self should: [self accessGrandDaughterClass daughterString = self daughterString]. self should: [self accessGrandDaughterClass methodToAdd]. self should: [self accessNewClassInstalled new daughterString = self daughterString]. ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:18'! verifyActivatedNewClass self should: [self accessNewClassInstalled notNil]. ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:52'! verifyDeactivatedDeltaMethodsWork self verifyMethodsWork; verifyDeactivatedNewClass ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:19'! verifyDeactivatedDeltaModulesWork self verifyDeactivatedDeltaMethodsWork; verifyDeactivatedDeltaGlobals; verifyDeactivatedNewClass ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:57'! verifyDeactivatedMetaDeltaMethodsWork self verifyMetaMethodsWork; verifyDeactivatedNewClass ! ! !DeltaModuleTests methodsFor: 'de/activate tests' stamp: 'hg 2/13/2002 11:18'! verifyDeactivatedNewClass self should: [self accessNewClassInstalled isNil]. ! ! !DeltaModuleTests methodsFor: 'module resolution' stamp: 'hg 2/2/2002 15:50'! deltaForAlphaRef self ownerModule ifNil: [^nil]. ^self ownerModule neighborModuleRefs detect: [:ref | ((ref isModuleResolved and: [ref refersToDeltaModule]) ifFalse: [ref module] ifTrue: [ref module baseModuleRef ensuredPath]) = self alphaModulePath] ifNone: [nil]! ! !DeltaModuleTests methodsFor: 'module resolution' stamp: 'hg 2/2/2002 15:51'! deltaForBetaRef self ownerModule ifNil: [^nil]. ^self ownerModule neighborModuleRefs detect: [:ref | ((ref isModuleResolved and: [ref refersToDeltaModule]) ifFalse: [ref module] ifTrue: [ref module baseModuleRef ensuredPath]) = self betaModulePath] ifNone: [nil]! ! !DeltaModuleTests methodsFor: 'code analysis' stamp: 'hg 2/2/2002 15:53'! testDeclareDeltaExternalRefs self testCreateDeltaModuleContents. self ownerModule deepDeclareExternalRefs. self should: [self ownerModule deepUnresolvedRefs isEmpty]! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/11/2002 15:21'! testCheckCompositeWithDeltas self setComposite: true deltas: true. self cleanOutImage. self setupModulesAndRepositories. self verifyRepositories. self verifyRepositoryContents. ! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/11/2002 21:07'! testLoadModules "this is just a test to verify that loading problems are unrelated to the ModuleInstaller. The code here is not how loading is meant to be done." self beComposite: true. self useCache ifFalse: [ self clearOutCacheDirectories]. self setupHomeModule. Preferences setFlag: #accessOnlineModuleRepositories toValue: self useCache not during: [ self homeModule repository beStandalone. (self repositoryToUseFor: self homeModule) defineCompositeModulesFromFile; loadModuleContents]. self verifyAllModuleContentsExist! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/6/2002 23:26'! testStoreModulesComposite self setComposite: true deltas: false. self toTestStoreModules! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/6/2002 23:26'! testStoreModulesCompositeWithDeltas self setComposite: true deltas: true. self toTestStoreModules! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/6/2002 23:26'! testStoreModulesStandalone self setComposite: false deltas: false. self toTestStoreModules! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/6/2002 23:26'! testStoreModulesStandaloneWithDeltas self setComposite: false deltas: true. self toTestStoreModules! ! !ModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/8/2002 15:57'! toTestStoreModules | warnings | self cleanOut. self setupModulesAndRepositories. self verifyRepositories. "catch missing dependencies warning and verify the number of times it occurs" warnings _ 0. Preferences setFlag: #accessOnlineModuleRepositories toValue: self useCache not during: [ [ModuleInstaller testUpload: self homeModule parentModule] on: Warning do: [:ex | warnings _ warnings + 1. ex resume: true]]. self should: [warnings = 1]. self verifyRepositoryContents. ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/10/2002 17:41'! installFromReference: moduleReference Preferences setFlag: #accessOnlineModuleRepositories toValue: self useCache not during: [ installerObject _ ModuleInstaller do: #fullyInstallModule forModuleRef: moduleReference withRecovery: false]. ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/6/2002 23:23'! testInstallModulesComposite self setComposite: true deltas: false. self toTestInstallFromPath: self pathForTestModules ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/7/2002 09:44'! testInstallModulesCompositeOutOfOrder self setComposite: true deltas: false. self toTestInstallFromPath: self alphaModulePath ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/7/2002 09:43'! testInstallModulesCompositeWithDeltas self setComposite: true deltas: true. self toTestInstallFromPath: self ownerModulePath ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/6/2002 23:22'! testInstallModulesStandalone self setComposite: false deltas: false. self toTestInstallFromPath: self pathForTestModules ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/7/2002 09:44'! testInstallModulesStandaloneOutOfOrder self setComposite: false deltas: false. self toTestInstallFromPath: self alphaModulePath ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/7/2002 10:21'! testInstallModulesStandaloneWithDeltas self setComposite: false deltas: true. self toTestInstallFromPath: self ownerModulePath ! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/10/2002 14:58'! toTestInstallFromPath: path self useCache ifFalse: [ self clearOutCacheDirectories]. Preferences setFlag: #accessOnlineModuleRepositories toValue: self useCache not during: [ installerObject _ ModuleInstaller testFullyInstallFromPath: path]. self verifyRepositories. self verifyAllModulesAndContentsLoaded! ! !ModuleStorageTests methodsFor: 'installer tests' stamp: 'hg 2/10/2002 14:58'! verifyAllModulesAndContentsLoaded self includeDeltas ifFalse: [ self verifyAllModuleDefinitionsLoaded. self verifyAllModuleContentsLoaded. self verifyAllModuleContentsExist] ifTrue: [ self verifyAllDeltaModuleDefinitionsLoaded. self verifyAllDeltaModuleContentsLoaded. self verifyDeltaModuleContents] ! ! !ModuleStorageTests methodsFor: 'repository tests' stamp: 'hg 2/3/2002 16:15'! testDefineCompositeFromRepositories self toTestDefineFromRepositories: false! ! !ModuleStorageTests methodsFor: 'repository tests' stamp: 'hg 2/3/2002 16:15'! testDefineStandaloneFromRepositories self toTestDefineFromRepositories: true! ! !ModuleStorageTests methodsFor: 'repository tests' stamp: 'hg 2/8/2002 15:32'! toTestDefineFromRepositories: standalone self setComposite: standalone not deltas: true. self testCreateDeltaModules. Preferences setFlag: #accessOnlineModuleRepositories toValue: self useCache not during: [ self allModules, self allDeltaTestModules do: [:m | (self repositoryToUseFor: m) defineAsStandaloneOrNotFromDirectoryStructure]]. self verifyRepositories ! ! !ModuleStorageTests methodsFor: 'repository tests' stamp: 'hg 2/2/2002 20:04'! xtestRootRepositoryGone "there is still something wrong with the file directory code & primitives so I'm leaving this test inactive" | rootDir rootDirSaved | rootDir _ Module root repository cache directory. rootDirSaved _ Module root repository cache directory containingDirectory directoryNamed: rootDir localName, '1'. [rootDir containingDirectory rename: rootDir localName toBe: rootDirSaved localName. self testCompositeStoreModules] ensure: [rootDirSaved exists ifTrue: [ Module root repository cache deepDeleteRepository]. rootDir containingDirectory rename: rootDirSaved localName toBe: rootDir localName. "stop: user should remove the '1' from the root directory manually if this happens" rootDir exists ifFalse: [self halt].] ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/6/2002 21:38'! allRepositories | allRepositories | allRepositories _ self beComposite ifFalse: [self allModules collect: [:m | m repository]] ifTrue: [{self homeModule repository}]. includeDeltas ifTrue: [ allRepositories _ allRepositories , (self beComposite ifFalse: [self allDeltaTestModules collect: [:m | m repository]] ifTrue: [{self ownerModule repository}])]. self useCache ifTrue: [allRepositories _ allRepositories collect: [:r | r cache]]. ^allRepositories! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/6/2002 21:51'! baseRepository ^self useCache ifFalse: [self homeModule repository] ifTrue: [self homeModule repository cache] ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/6/2002 21:51'! deltaRepository ^self useCache ifFalse: [self ownerModule repository] ifTrue: [self ownerModule repository cache] ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/11/2002 19:03'! setupCompositeRepositories self homeModule repository beStandalone. self homeModule parentModule repository beAbstract. self ownerModule ifNotNilDo: [:module | module repository beStandalone]. self verifyCompositeRepositories! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/7/2002 10:02'! setupModulesAndRepositories self includeDeltas ifTrue: [self testCreateDeltaModuleContents] ifFalse: [self testCreateAllModuleContents]. self beComposite ifFalse: [self setupStandaloneRepositories] ifTrue: [self setupCompositeRepositories]. ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/10/2002 15:21'! setupStandaloneRepositories self setupCompositeRepositories. self allModules do: [:module | module repository beStandalone]. self ownerModule ifNotNil: [ self allDeltaTestModules do: [:module | module repository beStandalone]]. self verifyStandaloneRepositories! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/2/2002 18:08'! useCache ^true! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/8/2002 15:34'! verifyCompositeRepositories self allModules do: [:m | self assert: (m repository isImplicit or: [m == self homeModule])]. self includeDeltas ifTrue: [ self allDeltaTestModules do: [:m | self assert: (m repository isImplicit or: [m == self ownerModule])]].! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/8/2002 15:30'! verifyRepositories self beComposite ifTrue: [self verifyCompositeRepositories] ifFalse: [self verifyStandaloneRepositories]. self verifyRepositoryCompositeModules. ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/11/2002 20:58'! verifyRepository: repository contentsOK: exists self should: [repository directory exists = exists]. "probably our proxy is screwing this up self should: [repository checkRepositoryExists = exists]." "check for validity of contents not implemented yet self should: [repository checkDefinitionFileOK = exists]." "self should: [repository checkContentsFilesOK = exists]." self should: [repository checkCompleteModuleContentsOK = exists]. ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/6/2002 21:55'! verifyRepositoryCompositeModules | repositoryCount deltaRepositoryCount | repositoryCount _ self beComposite ifFalse: [3] ifTrue: [1]. deltaRepositoryCount _ self beComposite ifFalse: [3] ifTrue: [1]. self should: [self beComposite ~= (self baseRepository compositeModules size = 1)]. self should: [self includeDeltas ==> [ self beComposite ~= (self deltaRepository compositeModules size = 1)]]. self should: [self baseRepository compositeModules ~~ repositoryCount]. self should: [ self includeDeltas ==> [self deltaRepository compositeModules ~~ deltaRepositoryCount]]. ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/8/2002 15:21'! verifyRepositoryContents self allRepositories do: [:rep | self verifyRepository: rep contentsOK: true]. ! ! !ModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/8/2002 15:42'! verifyStandaloneRepositories | badOnes all | all _ self allModules. self includeDeltas ifTrue: [all _ all, self allDeltaTestModules]. badOnes _ all reject: [:m | m repository isStandalone]. self should: [badOnes isEmpty]! ! !ModuleStorageTests methodsFor: 'delta tests' stamp: 'hg 2/10/2002 18:48'! testInstallModulesWithDeltasActive "during normal install, all installed deltas are deactivated. Here test installation that depends on delta modules that are active." | betaDeltaRef alphaDeltaRef | self setComposite: false deltas: false. self toTestInstallFromPath: self pathForTestModules. self setComposite: false deltas: true. self setupOwnerModule. "first make beta be loaded and active" betaDeltaRef _ DeltaModuleReference onPath: self betaModulePath parentModule: self ownerModule. self installFromReference: betaDeltaRef. self should: [self deltaForBeta notNil and: [self deltaForBeta isActive]]. self should: [self deltaForAlpha isNil]. "then load alpha" alphaDeltaRef _ DeltaModuleReference onPath: self alphaModulePath parentModule: self ownerModule. self installFromReference: alphaDeltaRef. self verifyDeltaModuleContents ! ! !ModuleStorageTests methodsFor: 'delta tests' stamp: 'hg 2/11/2002 21:09'! testLoadDeltaModules "this is just a test to verify that loading problems are unrelated to the ModuleInstaller. The code here is not how loading is meant to be done." self beComposite: true. self useCache ifFalse: [ self clearOutCacheDirectories]. self setupHomeModule. Preferences setFlag: #accessOnlineModuleRepositories toValue: self useCache not during: [ self homeModule repository beStandalone. (self repositoryToUseFor: self homeModule) defineCompositeModulesFromFile; loadModuleContents. self verifyAllModuleContentsExist. self setupOwnerModule. self ownerModule repository beStandalone. (self repositoryToUseFor: self ownerModule) defineCompositeModulesFromFile. self deltaForAlpha baseModuleRef resolveModule. self deltaForBeta baseModuleRef resolveModule. (self repositoryToUseFor: self ownerModule) loadModuleContents]. self verifyDeltaModuleContents! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/6/2002 21:30'! beComposite ^beComposite == true! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/6/2002 22:29'! beComposite: bool beComposite _ bool! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/3/2002 18:24'! cleanOut self cleanOutRepositories. self cleanOutImage. ! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/3/2002 18:20'! cleanOutImage super cleanOut! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/8/2002 11:11'! cleanOutRepositories self clearOutDirectories.! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/8/2002 11:10'! clearOutCacheDirectories self cleanOutImage. self setupAllModules. self setupDeltaModules. self shield: [self homeModule repository parentRepository cache deepDeleteRepository]. self deny: self homeModule repository cache checkRepositoryExists. self cleanOutImage. ! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/2/2002 17:51'! clearOutDirectories self clearOutCacheDirectories. ! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/6/2002 23:06'! includeDeltas ^includeDeltas! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/6/2002 22:30'! includeDeltas: bool includeDeltas _ bool! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/6/2002 21:30'! pathForTestingArea ^#(Temporary TestingRange) copyWith: (self beComposite ifTrue: [#Composite] ifFalse: [#Standalone])! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/3/2002 14:27'! repositoryToUseFor: module ^Preferences accessOnlineModuleRepositories ifTrue: [module repository] ifFalse: [module repository cache]! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/6/2002 22:28'! setComposite: composite deltas: deltas self beComposite: composite. self includeDeltas: deltas.! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/7/2002 09:35'! setUp "make sure that no cruft was left around that will disturb this test" self cleanOutImage! ! !ModuleStorageTests methodsFor: 'support' stamp: 'hg 2/3/2002 18:25'! tearDown "only clear out image here to improve test speed" self cleanOutImage! ! !ModuleTests class methodsFor: 'as yet unclassified' stamp: 'hg 2/6/2002 22:22'! fillSuite: testSuite fromSelector: testSelector andArguments: argumentRanges initSelector: initSel | variants | variants _ argumentRanges inject: #(()) into: [:allSoFar :range | range inject: #() into: [:all :variant | all, (allSoFar collect: [:each | each copyWith: variant])]]. ^variants inject: testSuite into: [:suite :variant | suite addTest: ((self selector: testSelector) perform: initSel withArguments: variant); yourself]! ! !ModuleTests class methodsFor: 'as yet unclassified' stamp: 'hg 2/3/2002 21:50'! usesStorage ^false! ! !ModuleStorageTests class methodsFor: 'as yet unclassified' stamp: 'hg 2/6/2002 23:37'! allTestSelectors ^(super allTestSelectors select: [:s | s beginsWith: 'testStore']) asOrderedCollection , (super allTestSelectors reject: [:s | s beginsWith: 'testStore']) asOrderedCollection ! ! !ModuleStorageTests class methodsFor: 'as yet unclassified' stamp: 'hg 2/11/2002 20:51'! shouldInheritSelectors ^false! ! !ModuleStorageTests class methodsFor: 'as yet unclassified' stamp: 'hg 2/11/2002 20:51'! testSelectors ^(super testSelectors select: [:s | s beginsWith: 'testStore']) asOrderedCollection , (super testSelectors reject: [:s | s beginsWith: 'testStore']) asOrderedCollection ! ! !ModuleStorageTests class methodsFor: 'as yet unclassified' stamp: 'hg 2/3/2002 21:50'! usesStorage ^true! ! !ReadOnlyVariableBinding methodsFor: 'printing' stamp: 'hg 2/10/2002 13:07'! printOn: aStream super printOn: aStream. aStream nextPutAll: '-x->'. value printOn: aStream! ! !RemoteModuleAccess methodsFor: 'Testing' stamp: 'hg 2/4/2002 16:02'! isAvailable "have an increasingly clever test here. Make sure that it won't return true if there's an error along the way!!" | isAvailable failed dir | isAvailable _ false. failed _ false. [ dir _ self topRepository ensureDirectory. "[dir openNoDataFTP] ensure: [dir quit]." isAvailable _ true] on: Error do: [:ex | failed _ true. ex signal. ^false]. ^isAvailable & failed not! ! !RemoteModuleAccess methodsFor: 'Testing' stamp: 'hg 2/2/2002 14:01'! topRepository ^self class topRepository! ! !RemoteModuleAccess methodsFor: 'Init / Release' stamp: 'hg 2/2/2002 17:10'! checkForLogin (TestUser isNil or: [TestPassword isNil]) ifTrue: [ self error: 'You must specify a server with FTP and HTTP access (with a proper read/write FTP account) to run this test.'].! ! !RemoteModuleAccess methodsFor: 'Init / Release' stamp: 'hg 2/12/2002 10:20'! setUp (self topRepository directory isKindOf: FileDirectory) ifTrue: [^self]. self checkForLogin. TestFtpUrl ifNotNil: [ self topRepository ftp: TestFtpUrl http: TestHttpUrl]. self topRepository user: TestUser password: TestPassword. "self assert: [self isAvailable]"! ! !RemoteModuleAccess class methodsFor: 'repository access' stamp: 'hg 2/8/2002 19:59'! fakeIntoFileDirectoryAtPath: path self topRepository directory: (FileDirectory on: path); beStandalone! ! !RemoteModuleAccess class methodsFor: 'repository access' stamp: 'hg 2/3/2002 17:16'! ftp: ftpUrl http: httpUrl user: user password: password " self ftp: 'ftp://@domain.net/TestArea' http: 'http://www.domain.net/TestArea' user: 'user' password: 'password' " TestFtpUrl _ ftpUrl. TestHttpUrl _ httpUrl. self user: user password: password! ! !RemoteModuleAccess class methodsFor: 'repository access' stamp: 'hg 2/2/2002 14:02'! topRepository | topModule | topModule _ Module fromPath: ModuleTests new pathForTestingArea forceCreate: true. ^topModule ifNotNilDo: [:mod | mod repository]! ! !RemoteModuleAccess class methodsFor: 'repository access' stamp: 'hg 2/3/2002 17:18'! user: user password: password "Use this to supply login/pwd and use standard server. self user: 'user' password: 'password' " TestUser _ user. TestPassword _ password.! ! !RemoteModuleAccess class methodsFor: 'Testing' stamp: 'hg 2/3/2002 21:31'! isAvailable ^self current notNil "and: [self current isAvailable]"! ! !RemoteModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/8/2002 20:50'! testStoreModulesComposite Transcript cr; show: '-- ', 'testStoreModulesComposite skipped to save time' ;cr.! ! !RemoteModuleStorageTests methodsFor: 'storage tests' stamp: 'hg 2/8/2002 20:51'! testStoreModulesStandalone Transcript cr; show: '-- ', 'testStoreModulesStandalone skipped to save time' ;cr.! ! !RemoteModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/2/2002 17:53'! clearOutDirectories self clearOutCacheDirectories. self clearOutRemoteDirectories. ! ! !RemoteModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/11/2002 19:54'! clearOutRemoteDirectories | dir | Transcript cr; show: '-- ', (testSelector ifNil: ['']), ' clean up remote ', Time now printString ;cr. self cleanOutImage. self setupAllModules. self setupDeltaModules. dir _ self homeModule repository topRepository directory. dir wakeUp. [ self shield: [self homeModule repository parentRepository deepDeleteRepository]. self deny: self homeModule repository checkRepositoryExists. ] ensure: [dir sleep]. self cleanOutImage. Transcript cr; show: '-- ', (testSelector ifNil: ['']), ' clean up remote done ', Time now printString ;cr. ! ! !RemoteModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/2/2002 18:27'! useCache ^false! ! !RemoteModuleStorageTests methodsFor: 'sample repositories' stamp: 'hg 2/11/2002 19:57'! verifyRepositoryContents | dir | dir _ self homeModule repository topRepository directory. dir wakeUp. [ self allRepositories do: [:rep | self verifyRepository: rep contentsOK: true]. ] ensure: [dir sleep]. ! ! !RemoteModuleStorageTests methodsFor: 'Running' stamp: 'hg 2/3/2002 21:35'! runCaseAsFailure [[self setUp. self openDebuggerOnFailingTestMethod] sunitEnsure: [self tearDown]] fork! ! !RemoteModuleStorageTests methodsFor: 'Running' stamp: 'hg 2/11/2002 10:48'! setUp super setUp. Transcript cr; show: '-- ', (testSelector ifNil: ['']), ' begin ', Time now printString ;cr. ! ! !RemoteModuleStorageTests class methodsFor: 'Accessing' stamp: 'hg 2/2/2002 14:17'! resources ^{RemoteModuleAccess}! ! !RemoteModuleStorageTests class methodsFor: 'Accessing' stamp: 'hg 2/11/2002 20:50'! testSelectors ^superclass testSelectors! ! !Repository methodsFor: 'accessing' stamp: 'hg 2/11/2002 18:33'! directory "compute directory from my parent if not explicitly stored. Share any open session." ^directory ifNil: [ self parentRepository directory directoryNamed: self localName usingSameSession: true]! ! !Repository methodsFor: 'file names' stamp: 'hg 2/8/2002 14:56'! localName "be semi-sophisticated about shortening" | str max name | str _ self module name asString copyWithoutAll: ' '. max _ FileDirectory maxFileNameLength. name _ str size > max ifFalse: [str] ifTrue: [(str first: 4), '=', (str last: max - 4 - 1)]. ^name! ! !Repository methodsFor: 'file names' stamp: 'hg 2/1/2002 09:14'! moduleFileNameForExtension: extension "be semi-sophisticated about shortening" | str max name | str _ 'Module'. "self module longName asString" max _ FileDirectory maxFileNameLength - self suffixLength. name _ str size > max ifFalse: [str] ifTrue: [(str first: 4), '=', (str last: max - 4 - 1)]. ^name, FileDirectory dot, extension! ! !Repository methodsFor: 'file names' stamp: 'hg 2/3/2002 16:49'! moduleSourcesExtension ^'src'! ! !Repository methodsFor: 'file names' stamp: 'hg 2/5/2002 15:34'! nameOfDefinitionFile ^self moduleFileNameForExtension: self moduleDefinitionExtension! ! !Repository methodsFor: 'file names' stamp: 'hg 2/5/2002 15:34'! nameOfSourcesFile ^self moduleFileNameForExtension: self moduleSourcesExtension! ! !Repository methodsFor: 'file names' stamp: 'hg 2/5/2002 15:36'! namesOfAllNeededFiles ^(Array with: self nameOfDefinitionFile) , self namesOfContentsFiles! ! !Repository methodsFor: 'file names' stamp: 'hg 2/5/2002 15:36'! namesOfContentsFiles ^Array with: self nameOfSourcesFile! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/13/2002 12:56'! compositeContentsOn: aStream "take various measures to ensure that necessary preconditions are met." | n compositeModulesInOrder | self standaloneCheck. compositeModulesInOrder _ ModuleInstaller new orderWithinCompositeFor: self compositeModules. 'Uploading ', self module pathAsMessages displayProgressAt: Sensor cursorPoint from: 0 to: self compositeModules size during: [:bar | n _ 0. aStream timeStamp. compositeModulesInOrder do: [:mod | compositeModulesInOrder size > 1 ifTrue: [ aStream cr; cr; nextChunkPut: '#nextCompositeModule'; space; nextChunkPut: (self prefixForModule: mod); cr; cr]. mod repository contentsOn: aStream. bar value: (n_ n+1). aStream flush]]! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/12/2002 15:08'! compositeDefinitionsOn: aStream "Write a complete definition of all the modules in this repository, with metainformation and a timestamp." | idPrefix | aStream timeStamp; cr. aStream nextChunkPut: self metaPrerequisites; cr; cr. self compositeModules do: [:mod | idPrefix _ self prefixForModule: mod. aStream nextPutAll: idPrefix, mod definition. mod repository isAbstract ifFalse: [mod neighborDefinitionsOn: aStream]. aStream nextPut: $;; crtab; nextChunkPut: 'yourself.'; cr; cr. mod repository repositoryDefinitionMessages isEmpty ifFalse: [ aStream nextPutAll: idPrefix, 'repository'. mod repository repositoryDefinitionsOn: aStream. aStream nextPut: $;; crtab; nextChunkPut: 'yourself.'; cr; cr]. ].! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/12/2002 15:51'! contentsOn: aStream "Write a complete definition of this module, with metainformation and a timestamp." | classes value | classes _ OrderedCollection new. self module privateDefinedNames keysDo: [:key | value _ (self module localAssocFor: key ifAbsent: []) value. value isBehavior ifTrue: [classes add: value] ifFalse: [ (value isKindOf: Module) ifFalse: [ aStream nextChunkPut: 'self ', (self module variableDefinitionFor: key); cr; cr]]]. (ChangeSet superclassOrder: classes) do: [:class | aStream nextChunkPut: (self module classDefinitionFor: class); cr; cr]. self module fileOutMethodsOn: aStream moveSource: false toFile: 0! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/8/2002 21:29'! fileInModuleDefinitionFile: mod | result definedModules | definedModules _ Set new. self fileInChunks: (self oldStreamNamed: self nameOfDefinitionFile) into: mod chunkBlock: [:string :stream :isCategory | result _ Compiler evaluate: string for: mod logged: false. (result isKindOf: Module) ifTrue: [ definedModules add: result. self prepareForCompositeLoading: result]. (result isKindOf: Array) ifTrue: [ self metaPrerequisites: result]]. self cleanupAfterCompositeLoading: definedModules. ! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/11/2002 16:51'! metaPrerequisites: list "Handle a list of the prerequisites for being able to understand (i.e. load) the definition of this module." | missing missingStr | missing _ list reject: [:path | (ModuleReference onPath: path) resolveModule notNil]. missingStr _ ''. missing do: [:path | missingStr _ missingStr, path literalPrintString, String cr]. self notify: 'The following modules or versions are not present but are required to proceed with loading. This suggest you are using an image that is too old for loading from this repository. Continue to attempt upgrading.', String cr, missingStr. missing do: [:path | ModuleInstaller fullyInstallFromPath: path].! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/11/2002 16:36'! repositoryDefinitionMessages | messages | messages _ OrderedCollection new. self isAbstract ifTrue: [messages add: #beAbstract]. self isStandalone ifTrue: [messages add: #beStandalone]. ^messages ! ! !Repository methodsFor: 'fileIn/Out' stamp: 'hg 2/12/2002 15:04'! repositoryDefinitionsOn: aStream aStream crtab; nextPutAll: self repositoryDefinitionMessages first asString. self repositoryDefinitionMessages allButFirst do: [:msg | aStream nextPut: $;; crtab; nextPutAll: msg asString]. ! ! !Repository methodsFor: 'testing' stamp: 'hg 2/8/2002 09:22'! fileExists: name ^self directory fileExists: name! ! !Repository methodsFor: 'testing' stamp: 'hg 2/11/2002 16:22'! isAbstract "An abstract module/repository is one where there are no actual module contents, like abstract classes have no instances. Also its submodules shouldn't be considered as 'part of it', i.e. they aren't automatically loaded with it. Some examples of abstract modules are the root, Squeak, People and so on. " ^isAbstract = true "allow nil here for false"! ! !Repository methodsFor: 'testing' stamp: 'hg 2/3/2002 20:42'! isCache ^false! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 2/3/2002 14:08'! cleanupAfterCompositeLoading "cf. prepareForCompositeLoading: -- need to remove non-composite module objects that were created." | modulesToDestroy ref | "first ensure that I have no 'spurious' composite modules" self compositeRepositories do: [:rep | rep defineAsStandaloneOrNotFromDirectoryStructure]. modulesToDestroy _ self module deepSubAndDeltaModules difference: self compositeModules. modulesToDestroy do: [:mod | ref _ mod parentModule refForNeighborModule: mod. ref refersToDeltaModule ifFalse: [ref resolvedModule: mod path] ifTrue: [ ref resolvedModule: mod baseModuleRef ensuredPath. ref parentModule: mod parentModule]].! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 2/8/2002 21:32'! cleanupAfterCompositeLoading: definedModules "cf. prepareForCompositeLoading: -- need to remove non-composite module objects that were created." | nonDefinedModules ref | nonDefinedModules _ self module deepSubAndDeltaModules difference: definedModules. nonDefinedModules do: [:mod | ref _ mod parentModule refForNeighborModule: mod. ref refersToDeltaModule ifFalse: [ref resolvedModule: mod path] ifTrue: [ ref resolvedModule: mod baseModuleRef ensuredPath. ref parentModule: mod parentModule]].! ! !Repository methodsFor: 'composite repositories' stamp: 'hg 2/8/2002 15:44'! defineAsStandaloneOrNotFromDirectoryStructure "Define the correct status of this repository by looking on disk etc., to find out if I am standalone or not" "if I am already defined as standalone then I am ok" self isStandalone ifTrue: [^self]. "ensure that my parent is ok" "self parentRepository defineAsStandaloneOrNotFromDirectoryStructure. " "perform the actual check and operation" self checkRepositoryExists ifTrue: [self module repository beStandalone]. ! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/14/2002 09:56'! checkCompleteModuleContentsOK "in future, this could be image segment OR source files" ^self isImplicit | self module repository isAbstract or: [ self checkContentsFilesExist and: [self checkContentsFilesOK]]! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/4/2002 12:05'! checkContentsFilesExist ^self directory exists and: [ self namesOfContentsFiles allSatisfy: [:name | self fileExists: name]]! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/4/2002 11:57'! checkContentsFilesOK ^self namesOfContentsFiles allSatisfy: [:name | true "determine verification strategy later"]! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/5/2002 15:34'! checkDefinitionFileExists ^self directory exists and: [self fileExists: self nameOfDefinitionFile]! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/5/2002 15:35'! checkDefinitionFileOK ^true "determine verification strategy later"! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/5/2002 15:44'! checkDirectoryExists ^self directory exists! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/5/2002 15:45'! checkRepositoryExists "does the repository exist that defines my module?" ^self checkDirectoryExists and: [self checkDefinitionFileExists]! ! !Repository methodsFor: 'installer support' stamp: 'hg 2/5/2002 12:16'! sizeOfFiles: fileNames | sizes | self isImplicit ifTrue: [^0]. sizes _ self directory entries select: [:entry | fileNames includes: entry name] thenCollect: [:entry | entry fileSize]. ^(sizes copyWith: 0) sum! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 2/5/2002 15:45'! deepDeleteRepository self checkDirectoryExists ifFalse: [^self]. self subrepositories do: [:sub | sub deepDeleteRepository]. self deleteRepository ! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 1/26/2002 18:48'! defineCompositeModulesFromFile self isImplicit ifTrue: [^self standaloneRepository defineCompositeModulesFromFile]. self ensureDefinitionOK. self fileInModuleDefinitionFile: self module. ^self compositeModules! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 2/11/2002 20:56'! deleteDirectory self isTopRepository ifFalse: [ self directory containingDirectory ifNotNilDo: [:parent | parent deleteDirectory: self directory localName]].! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 2/11/2002 20:56'! deleteRepository self directory fileNames do:[:fn | self directory deleteFileNamed: fn]. self deleteDirectory! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 9/29/2001 14:37'! ensureDirectory ^self directory assureExistence! ! !Repository methodsFor: 'up- and downloading' stamp: 'hg 2/5/2002 15:36'! storeModuleComposite "store the files that define this (composite) module" | stream | [ stream _ self streamNamed: self nameOfDefinitionFile. self compositeDefinitionsOn: stream ] ensure: [stream close]. [ stream _ self streamNamed: self nameOfSourcesFile. self compositeContentsOn: stream ] ensure: [stream close]. ! ! !Repository methodsFor: 'repository variants' stamp: 'hg 2/11/2002 16:24'! beAbstract "first make sure I am stored with module so abstractness is preserved" self ensureBeingPreserved. self beStandalone. isAbstract _ true! ! !Repository methodsFor: 'repository variants' stamp: 'hg 2/12/2002 12:13'! beComposite self canBeComposite ifFalse: [ self error: ' I cannot be made a composite repository'.]. isStandalone _ false. "sanity check" self isComposite ifFalse: [ self error: 'I don''t qualify as the kind of repository I should have been']! ! !Repository methodsFor: 'repository variants' stamp: 'hg 2/11/2002 17:13'! referencesForNeededModules "Answer references to modules needed by this modelu, ie. that must be loaded if not already present." ^self isAbstract ifFalse: [self module neighborModuleRefs] ifTrue: [ self module neighborModuleRefs reject: [:ref | ref refersToSubmodule]]! ! !FileRepository methodsFor: 'testing' stamp: 'hg 2/3/2002 20:43'! isCache "this is not foolproof but should suffice" ^self module repository ~~ self ! ! !FileRepository methodsFor: 'testing' stamp: 'hg 2/5/2002 10:19'! isTopRepository ^self module == Module root! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 2/5/2002 15:10'! registerMyDirectoryInGroup: groupString ServerDirectory addServer: directory named: groupString! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 2/2/2002 12:34'! standaloneOn: aModule at: anUrl "set me up as a proper standalone repository for the given module at the given location. The kind of repository I become dependes on the URL type" self standaloneOn: aModule. self beLocatedAt: anUrl.! ! !RemoteRepository methodsFor: 'initializing' stamp: 'hg 2/3/2002 17:28'! user: userString password: password "see class comments for ServerDirectory and Password for documentation" self topRepository directory user: userString; password: password! ! !RemoteRepository methodsFor: 'fileIn/Out' stamp: 'hg 2/11/2002 19:24'! ensurePreconditionsForUpload super ensurePreconditionsForUpload. self ensureUsingMyDirectory. ! ! !RemoteRepository methodsFor: 'fileIn/Out' stamp: 'hg 2/11/2002 21:28'! ensureUsingMyDirectory self directory ensureCorrectWorkingDirectory! ! !RemoteRepository methodsFor: 'internet location' stamp: 'hg 2/2/2002 12:30'! beLocatedAt: anUrl "set me up as a proper standalone repository for the given module at the given location. The kind of repository I become dependes on the URL type" self beStandalone. self directory: (self directorySpecies new on: anUrl). self user: 'anonymous' password: nil ! ! !RemoteRepository methodsFor: 'internet location' stamp: 'hg 2/5/2002 15:20'! ftp: ftpURL http: httpURL self beLocatedAt: ftpURL. httpURL ifNotNil: [ directory altUrl: httpURL; type: #http]. ! ! !RemoteRepository methodsFor: 'testing' stamp: 'hg 2/8/2002 09:23'! fileExists: name ^[self directory fileExists: name] on: FTPConnectionException do: [:ex | ^false]! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 2/5/2002 19:24'! cacheFileNamed: onlyTheFileName "load the file with the given name from my directory into the local cache" | cacheFileStream | self cache ensureDirectory. (self cache fileExists: onlyTheFileName) ifTrue: [ self cache directory deleteFileNamed: onlyTheFileName]. cacheFileStream _ self cache directory newFileNamed: onlyTheFileName. self directory getFileNamed: onlyTheFileName into: cacheFileStream. cacheFileStream nextPutAll: cacheFileStream originalContents; "what a hack!!!!" close.! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 2/5/2002 15:37'! ensureCompleteModuleInCache "download the files that define this (composite) module" self namesOfAllNeededFiles do: [:name | self cacheFileNamed: name]. ! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 2/3/2002 15:44'! ensureLoggedInForWrite "ensure that my login is non-anonymous" | login | self directory isTypeFile ifFalse: [ self directory user = 'anonymous' ifTrue: [ login _ FillInTheBlank request: 'Login (username) for ', self directory server, ':'. login isEmpty ifTrue: [^false]. self topRepository directory user: login; password: nil; password]. ] ! ! !RemoteRepository methodsFor: 'up- and downloading' stamp: 'hg 2/5/2002 15:37'! uploadFromCache "upload the files that define this (composite) module" | stream | self namesOfAllNeededFiles do: [:name | [ stream _ self cache oldStreamNamed: name. self directory putFile: stream named: name ] ensure: [stream close]]! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 2/5/2002 16:22'! checkDefinitionFileExists ^self fileExists: self nameOfDefinitionFile! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 2/5/2002 15:41'! checkRepositoryExists "does the repository exist that defines my module? A faster version using http" ^self checkDefinitionFileExists ! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 2/11/2002 21:28'! deleteDirectory self isTopRepository ifFalse: [ self directory containingDirectory ifNotNilDo: [:parent | parent ensureCorrectWorkingDirectory; deleteDirectory: self directory localName]].! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 2/8/2002 15:09'! ensureDefinitionInCache self cache checkDefinitionFileExists ifFalse: [ self cacheFileNamed: self nameOfDefinitionFile]. self cache ensureDefinitionOK. ! ! !RemoteRepository methodsFor: 'installer support' stamp: 'hg 2/12/2002 11:59'! ensureDirectory self directory containingDirectory ensureCorrectWorkingDirectory. ^super ensureDirectory! ! !TransitionalSmalltalkModule methodsFor: 'changing defined names' stamp: 'hg 2/9/2002 22:31'! moveName: aName toModule: newModule "This method doesn't remove the definition from Smalltalk, just from the exports of this module. Make sure to preserve the association for the name across the modules, as it is used in method literals." | export assoc | assoc _ self localAssocFor: aName ifAbsent: [self error: 'name not defined']. export _ self exportsName: aName. export ifTrue: [self privateExportedNames removeKey: aName]. newModule addAssoc: assoc export: export. (assoc value respondsTo: #module:) ifTrue: [assoc value module: newModule]. self invalidateCaches ! ! !VirtualRootModule methodsFor: 'initializing' stamp: 'hg 2/1/2002 09:18'! invalidateCaches cachedClassNames _ nil. SystemOrganization invalidateCaches! ! !VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 2/11/2002 12:22'! initialize Module root repository: nil. self on: Module root. self ftp: self class defaultRepositoryURL http: self class defaultRepositoryAltURL. self class defaultRepositoryAltURL ifNil: [ self user: 'anonymous' password: 'anonymousSqueaker']. self directory groupName: self class defaultRepositoryName. self registerMyDirectoryInGroup: self class virtualRepositoryGroup.! ! !VirtualRootRepository class methodsFor: 'class initialization' stamp: 'hg 2/5/2002 15:25'! initialize "set up a repository for the virtual root module" "self initialize" super new initialize! ! !VirtualRootRepository class methodsFor: 'default repository locations' stamp: 'hg 2/5/2002 15:21'! defaultRepositoryURL "URL for FTP access (this allows for password protection, for reading etc." ^'ftp://modules.squeakfoundation.org//'! ! VirtualRootRepository initialize! VirtualRootRepository class removeSelector: #setupDefaultRepositoryServer! VirtualRootRepository removeSelector: #defaultServer! RemoteRepository removeSelector: #checkCompleteModuleContentsOK! RemoteRepository removeSelector: #ensureContentsFilesExist! RemoteRepository removeSelector: #ensureDefinitionFileOK! RemoteRepository removeSelector: #ensureUpload! RemoteRepository removeSelector: #fileInModuleContentsFileInto:! RemoteRepository removeSelector: #isTypeFTP! RemoteRepository removeSelector: #isTypeFile! RemoteRepository removeSelector: #isTypeHTTP! RemoteRepository removeSelector: #localPath! RemoteRepository removeSelector: #oldStreamNamed:! RemoteRepository removeSelector: #repositoryToUse! RemoteRepository removeSelector: #sizeOfContentsFiles! RemoteRepository removeSelector: #standaloneOn:ftp:http:! !RemoteRepository reorganize! ('initializing' cacheSpecies directorySpecies registerMyDirectoryInGroup: standaloneOn:at: user:password:) ('fileIn/Out' ensurePreconditionsForUpload ensureUsingMyDirectory streamNamed:) ('internet location' beLocatedAt: ftp:http:) ('accessing' cache cacheForChild:) ('testing' fileExists:) ('up- and downloading' cacheFileNamed: ensureCompleteModuleInCache ensureLoggedInForWrite uploadFromCache) ('installer support' checkDefinitionFileExists checkRepositoryExists defineCompositeModulesFromFile deleteDirectory ensureDefinitionInCache ensureDirectory namesOfContentsFilesToDownload) ! FileRepository removeSelector: #standaloneOn:at:! Repository removeSelector: #checkDefinitionExists! Repository removeSelector: #deepDeleteDirectory! Repository removeSelector: #definitionOn:! Repository removeSelector: #deleteDirectoryAndFiles! Repository removeSelector: #detectImproperlyDeclaredModules:! Repository removeSelector: #ensureDeepUpload! Repository removeSelector: #ensureModuleDependenciesDeclared:! Repository removeSelector: #ensureUpload! Repository removeSelector: #moduleContentsExtension! RemoteModuleStorageTests removeSelector: #deleteRemoteDirectories! RemoteModuleStorageTests removeSelector: #tearDown! RemoteModuleStorageTests removeSelector: #testCompositeStoreModulesRemotely! RemoteModuleStorageTests removeSelector: #testInstallCompositeModulesOutOfOrderRemotely! RemoteModuleStorageTests removeSelector: #testInstallCompositeModulesRemotely! RemoteModuleStorageTests removeSelector: #testInstallStandaloneModulesOutOfOrderRemotely! RemoteModuleStorageTests removeSelector: #testInstallStandaloneModulesRemotely! RemoteModuleStorageTests removeSelector: #testLoadModulesRemotely! RemoteModuleStorageTests removeSelector: #testStandaloneStoreModulesRemotely! !RemoteModuleAccess class reorganize! ('repository access' fakeIntoFileDirectoryAtPath: ftp:http:user:password: topRepository user:password:) ('Testing' isAvailable) ! ModuleStorageTests removeSelector: #deleteCacheDirectories! ModuleStorageTests removeSelector: #testCompositeStoreDeltaModulesInCache! ModuleStorageTests removeSelector: #testCompositeStoreModulesInCache! ModuleStorageTests removeSelector: #testInstallCompositeDeltaModulesFromCache! ModuleStorageTests removeSelector: #testInstallCompositeModulesFromCache! ModuleStorageTests removeSelector: #testInstallCompositeModulesOutOfOrderFromCache! ModuleStorageTests removeSelector: #testInstallStandaloneDeltaModulesFromCache! ModuleStorageTests removeSelector: #testInstallStandaloneModulesFromCache! ModuleStorageTests removeSelector: #testInstallStandaloneModulesOutOfOrderFromCache! ModuleStorageTests removeSelector: #testLoadDeltaModulesFromCache! ModuleStorageTests removeSelector: #testLoadModulesFromCache! ModuleStorageTests removeSelector: #testStandaloneStoreDeltaModulesInCache! ModuleStorageTests removeSelector: #testStandaloneStoreModulesInCache! ModuleStorageTests removeSelector: #toTestInstallDeltaModulesStandalone:fromCache:forPath:! ModuleStorageTests removeSelector: #toTestInstallModulesStandalone:fromCache:forPath:! ModuleStorageTests removeSelector: #toTestStoreModules:deltas:inCache:! ModuleStorageTests removeSelector: #toTestStoreModules:inCache:! DeltaModuleTests subclass: #ModuleStorageTests instanceVariableNames: 'installerObject beComposite includeDeltas ' classVariableNames: '' module: #(Squeak Language Modules Tests)! DeltaModuleTests removeSelector: #tearDown! DeltaModuleTests removeSelector: #verifyClassMethodsWork! !ModuleTests reorganize! ('module creation tests' testCreateModule testCreateSubmoduleRefs testCreateSubmodules testCreatingModuleFromPath testPassiveModuleFromPath verifyHomeModuleExists verifySubmodulesExist) ('module contents' globalValue globalVarName globalVarName2 testCreateAllModuleContents testCreateClassMethods testCreateClasses testCreateGlobals testCreateMethods toCreateAllModuleContents toCreateClassMethods toCreateClasses toCreateGlobals toCreateMethods verifyAllModuleContentsExist verifyAllModuleContentsSet verifyClassesExist verifyGlobalValues verifyGlobalsExist verifyMetaMethodsWork verifyMethodsWork) ('code analysis' testDeclareExternalRefs testLocalUnresolvedRefs) ('module resolution' testFindSubmoduleRef testResolveSubmoduleRefs) ('sample modules' allModules alphaModule alphaModuleName alphaModulePath alphaRef betaModule betaModuleName betaModulePath betaRef homeModule pathForTestModules pathForTestingArea setupAllModules setupAllModulesAndContents setupHomeModule setupSubmoduleRefs setupSubmodules unloadModules) ('sample classes' accessDaughterClass accessGrandDaughterClass accessParentClass daughterClassName grandDaughterClassName parentClassName setupDaughterClass setupGrandDaughterClass setupParentClass) ('support' cleanOut setUp shield: tearDown) ('sample methods' daughterString grandDaughterString methodToDelete parentString) ('Undeclared tests' circularClassA circularClassAName circularClassB circularClassBName circularGlobalAName circularGlobalBName circularModuleA circularModuleAName circularModuleAPath circularModuleB circularModuleBName circularModuleBPath circularModules circularTestSelector sampleCircularMethodASource sampleCircularMethodBSource setupCircularClassA setupCircularClassB setupCircularContentsA setupCircularContentsB setupCircularSubmodules testUnresolvedHandlesCircularDefinitions) ! ModuleInstaller removeSelector: #activate:classesIn:! ModuleInstaller removeSelector: #do:forModuleRef:! ModuleInstaller removeSelector: #ensureAllModulesInRepository! ModuleInstaller removeSelector: #ensureContentsLoadedForModule:! !ModuleInstaller reorganize! ('initialize-reset' clearActivatedModules clearDefinedModules clearDownloadedModules clearLoadedModules do:forModuleRef:withRecovery: initialize) ('accessing' definedModules loadedModules operation startModule) ('graph computation' allModulesNeededBy:exceptForNeedsOf: checkForCircularDependencies: compositeLoadingDependenciesFor:except: directlyNeededModulesFor: directlyReachableModulesFor: ensureModuleDependenciesDeclared loadingOrderFor: module:dependsOn:says: modules:inDependencyOrderFrom: orderWithinCompositeFor: pureDependencyOrderFor:) ('defining modules' addReferencesToResolve:to: ensureAllModulesDefined ensureAllReachableModulesResolved: ensureModuleResolved: refsToScanFrom: removeModule: removeModules: reverseDefinedModules) ('resolving conflicts' identifyConflicts) ('up/downloading modules' checkStandaloneBeforeUpload downloadModuleIntoCache: ensureAllModulesDownloadedInCache repositoryToUseFor: storeStandaloneRepositoriesInCache uploadStandaloneRepositories workOffline) ('(un)loading' ensureAllModulesLoaded initializeLoadedModules loadContentsForModule: modulesToLoad modulesToLoadFor: reverseLoadedModules safeLoadingOrder: unloadModule unloadModule: unloadModules:) ('public' fullyInstallModule fullyUninstallModule uploadModule) ('(de)activating' activationOrderFor: deactivateModule deactivateModules: ensureAllModulesActive modulesToDeactivate: reverseActivatedModules sendActivationMessages:toClassesIn: switchModulesConservatively:beActive: switchModulesWithBecome:beActive:) ('utilities' atomicallySwitch:to: cleanup deepSubmodules done ensureNoUsersOf: gracefullyExecute: preserveUninstallInformation revertGracefullyToStableState) ('user interface' note: noteDone phase:progressTotal: progressAdd: showProgressDuring:) ! DeltaModule removeSelector: #baseModuleRef:! DeltaModule removeSelector: #effectClassChangesConservatively:! DeltaModule removeSelector: #neighborDefinitionsOn:! Module removeSelector: #badBindingsWithScheme:! Module removeSelector: #localDeclareExternalRefsWithScheme:! !Module reorganize! ('accessing' annotationAt: annotationAt:ifAbsent: annotationAt:put: annotations classNames definedNames exportedNames parentModule repository repository: species verbatimRepository) ('testing' < <= conflictsWith: exportsName: hasNeighborModule: hasNeighborOrImportedModule: importCreatesCircularity: isActive isDeltaModule shouldExport:) ('initializing' initialize version: version:parentModule:) ('module name and path' longName name path pathAndVersion pathAsMessages pathTo: simulatedCategory) ('name lookup schemes' defaultBindingScheme definesName:ifTrue: definesName:usingScheme:ifTrue: definesName:usingScheme:withCache:ifTrue: lenientDefinesName:ifTrue: strongDefinesName:ifTrue: weakDefinesName:ifTrue: weakOrStrongBindingScheme) ('strong name lookup' allClassesDo: associationFor:ifAbsent: associationFor:ifPresent: definitionFor:ifAbsent: doesNotUnderstand: exportedAssocFor:ifPresent: importedAssocFor:ifPresent: localAssocFor:ifAbsent: localExportedAssocFor:ifAbsent: qualifiedPrefixForName:andValue:) ('changing defined names' addAssoc:export: adoptIfUndeclared: changeName:to:forValue: defineName:as:export: exportName: moveName:toModule: redefineName:as:export: removeName: simplyRemoveName: validateName:forValue:) ('defining module dependencies' deltaModuleOn:alias:version:importNames: externalModule:alias:version:importNames: parameterModuleWithDefault:version:alias:importNames: submodule:name:version:importNames: uses:) ('module composition' deepClassesDo: deepImportedModulesDo: deepSubAndDeltaModules deepSubmodules deepSubmodulesBottomUpDo: deepSubmodulesDo: deltaModuleFor: deltaModules importedModules importedModulesDo: neighborModuleRefs neighborModules refForNeighborModule: submodules submodulesDo:) ('changing module composition' addNeighborModule:export: cleanOutModule deltaModuleForBase:forceCreate:asActive: ensureExternalModule: moveModule:toAfter: moveModule:toBefore: removeNeighborModule:) ('version handling' incrementVersion minimalVersionIncrease verbatimVersion version) ('change sets' changes) ('fileIn/Out' classDefinitionFor: definition fileOutMethodsOn:moveSource:toFile: neighborDefinitionsOn: printOn: storeOn: variableDefinitionFor:) ('un/loading' markAsActive: objectsBeforeAndAfter:) ('user interface' explore moduleExplorerContents) ('code analysis' deepIncomingRefsFromOutside: deepUniqueMessagesToOutside: deepUnresolvedRefs deepUnresolvedRefsWithScheme: doesLookupOf:withScheme:giveTheAssoc:useCache: localUnresolvedRefs localUnresolvedRefsWithScheme: resetOutOfScopeCache setUnresolvedCount: viewDeepUnresolvedRefs zeroOutOfScopeCache) ('system conversion' declareDefaultExternalModules declareExternalRefsForSelector:inClass: deepDeclareExternalRefs defineClassExtensionsOutside: importIntoParent localDeclareExternalRefsFor: rewriteIndirectRefs rewriteSourceForSelector:inClass:) ('compatibility' at: organization removeClassFromSystem:logged:) ('private' checkImportForCircularity: clearDeclaredModules invalidateCaches privateAddNeighborModuleRef: privateDefinedNames privateExportedNames privateNeighborModuleRefs privateRemoveNeighborModuleRef: privateSimplifiedPath refForModuleDefining:) ('copying' veryDeepFixupWith: veryDeepInner:) ! "Postscript: This was a significant change to the module and repository system." Module module version: 0.1. Preferences setPreference: #accessOnlineModuleRepositories toValue: true.!