The Trunk: Monticello-nice.342.mcz

Nicolas Cellier uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-nice.342.mcz

==================== Summary ====================

Name: Monticello-nice.342
Author: nice
Time: 27 December 2009, 9:03:54 am
UUID: ead29222-29d3-421a-8d89-08d667014c1c
Ancestors: Monticello-bf.341

change #findSnapshotWithVersionInfo: to silently ignore a missing ancestor rather than sending #snapshot to nil.
This happens for example when merging Pharo/CollectionTests.
Don't know if this is the good strategy though (maybe a notification could be signalled)

+ Cosmetic: move or remove a few temps inside closures


=============== Diff against Monticello-bf.341 ===============

Item was changed:
  ----- Method: MCFtpRepository>>readStreamForFileNamed:do: (in category 'required') -----
  readStreamForFileNamed: aString do: aBlock
+
- | stream |
  ^ self clientDo:
+ [:client | | stream |
- [:client |
  client binary.
  stream := RWBinaryOrTextStream on: String new.
  stream nextPutAll: (client getFileNamed: aString).
  aBlock value: stream reset]!

Item was changed:
  ----- Method: MCVersion>>allDependenciesNotIn:do:ifUnresolved: (in category 'enumerating') -----
  allDependenciesNotIn: aDictionary do: aBlock ifUnresolved: failBlock
+
- | version |
  self dependencies do:
+ [:ea | | version |
- [:ea |
  version := aDictionary at: ea ifAbsent: [ea resolve].
  version
  ifNil: [failBlock value: ea]
  ifNotNil: [(aDictionary includes: version) ifFalse:
  [aDictionary at: ea put: version.
  version
  allDependenciesNotIn: aDictionary
  do: aBlock
  ifUnresolved: failBlock.
  aBlock value: version]]]!

Item was changed:
  ----- Method: MCSnapshotBrowserTest>>assertAListMatches: (in category 'asserting') -----
  assertAListMatches: strings
+ | listMorphs |
- | listMorphs list |
  listMorphs := self listMorphs.
  listMorphs
+ detect: [:m | | list |
+ list := m getList. (list size = strings size) and: [list includesAllOf: strings]]
- detect: [:m | list := m getList. (list size = strings size) and: [list includesAllOf: strings]]
  ifNone: [self assert: false].!

Item was changed:
  ----- Method: MCVersion>>allAvailableDependenciesDo: (in category 'enumerating') -----
  allAvailableDependenciesDo: aBlock
+
- | version |
  self dependencies do:
  [:ea |
+ [ | version |
+ version := ea resolve.
- [version := ea resolve.
  version allAvailableDependenciesDo: aBlock.
  aBlock value: version]
  on: Error do: []]!

Item was changed:
  ----- Method: MCFileBasedRepository>>versionWithInfo:ifAbsent: (in category 'as yet unclassified') -----
  versionWithInfo: aVersionInfo ifAbsent: errorBlock
+
- | version |
  (self allFileNamesForVersionNamed: aVersionInfo name) do:
+ [:fileName | | version |
- [:fileName |
  version := self versionFromFileNamed: fileName.
  version info = aVersionInfo ifTrue: [^ version]].
  ^ errorBlock value!

Item was changed:
  ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'as yet unclassified') -----
  testKindOfSubclass
+ | classes |
- | classes d |
  classes := {self mockClassA. String. MethodContext. WeakArray. Float}.
+ classes do: [:c | | d |
- classes do: [:c |
  d :=  c asClassDefinition.
  self assert: d kindOfSubclass = c kindOfSubclass.
  ].!

Item was changed:
  ----- Method: MCToolWindowBuilder>>buttonRow: (in category 'as yet unclassified') -----
  buttonRow: specArray
+ | panel |
- | panel button |
  panel := builder pluggablePanelSpec new.
  panel children: OrderedCollection new.
  specArray do:
+ [:spec | | button |
- [:spec |
 
  button := builder pluggableButtonSpec new.
  button model: tool.
  button label: spec first asString.
  button action: spec second.
  button help: spec third.
  button enabled: (spec at: 4 ifAbsent: [#buttonEnabled]).
  button state: (spec at: 5 ifAbsent: [#buttonSelected]).
  panel children add: button].
  panel layout: #horizontal.
  panel frame: currentFrame.
  window children add: panel!

Item was changed:
  ----- Method: MCWorkingCopyTest>>testSelectiveBackport (in category 'tests') -----
  testSelectiveBackport
+ | inst base intermediate final |
- | inst base intermediate final patch selected |
  inst := self mockInstanceA.
  base :=  self snapshot.
  self assert: inst one = 1.
  self change: #one toReturn: 2.
  intermediate := self snapshot.
  self change: #two toReturn: 3.
  final := self snapshot.
  [workingCopy backportChangesTo: base info]
  on: MCChangeSelectionRequest
+ do: [:e | | selected patch |
- do: [:e |
  patch := e patch.
  selected := patch operations select: [:ea | ea definition selector = #two].
  e resume: (MCPatch operations: selected)].
  self assert: inst one = 1.
  self assert: inst two = 3.
  self assert: workingCopy ancestry ancestors size = 1.
  self assert: workingCopy ancestry ancestors first = base info.
  self assert: workingCopy ancestry stepChildren size = 1.
  self assert: workingCopy ancestry stepChildren first = final info!

Item was changed:
  ----- Method: MCMethodDefinition>>scanForPreviousVersion (in category 'installing') -----
  scanForPreviousVersion
+ | sourceFilesCopy method position |
- | position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp method file methodCategory |
  method := self actualClass compiledMethodAt: selector ifAbsent: [^ nil].
  position := method filePosition.
  sourceFilesCopy := SourceFiles collect:
  [:x | x isNil ifTrue: [ nil ]
  ifFalse: [x readOnlyCopy]].
+ [ | file prevPos tokens preamble methodCategory stamp prevFileIndex |
+ method fileIndex == 0 ifTrue: [^ nil].
- [method fileIndex == 0 ifTrue: [^ nil].
  file := sourceFilesCopy at: method fileIndex.
  [position notNil & file notNil]
  whileTrue:
  [file position: (0 max: position-150).  "Skip back to before the preamble"
  [file position < (position-1)]  "then pick it up from the front"
  whileTrue: [preamble := file nextChunk].
 
  "Preamble is likely a linked method preamble, if we're in
  a changes file (not the sources file).  Try to parse it
  for prior source position and file index"
  prevPos := nil.
  stamp := ''.
  (preamble findString: 'methodsFor:' startingAt: 1) > 0
  ifTrue: [tokens := Scanner new scanTokens: preamble]
  ifFalse: [tokens := Array new  "ie cant be back ref"].
  ((tokens size between: 7 and: 8)
  and: [(tokens at: tokens size-5) = #methodsFor:])
  ifTrue:
  [(tokens at: tokens size-3) = #stamp:
  ifTrue: ["New format gives change stamp and unified prior pointer"
  stamp := tokens at: tokens size-2.
  prevPos := tokens last.
  prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos.
  prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos]
  ifFalse: ["Old format gives no stamp; prior pointer in two parts"
  prevPos := tokens at: tokens size-2.
  prevFileIndex := tokens last].
  (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]].
  ((tokens size between: 5 and: 6)
  and: [(tokens at: tokens size-3) = #methodsFor:])
  ifTrue:
  [(tokens at: tokens size-1) = #stamp:
  ifTrue: ["New format gives change stamp and unified prior pointer"
  stamp := tokens at: tokens size]].
  methodCategory := tokens after: #methodsFor: ifAbsent: ['as yet unclassifed'].
  methodCategory = category ifFalse:
  [methodCategory = (Smalltalk
  at: #Categorizer
  ifAbsent: [Smalltalk at: #ClassOrganizer])
  default ifTrue: [methodCategory := methodCategory, ' '].
  ^ ChangeRecord new file: file position: position type: #method
  class: className category: methodCategory meta: classIsMeta stamp: stamp].
  position := prevPos.
  prevPos notNil ifTrue:
  [file := sourceFilesCopy at: prevFileIndex]].
  ^ nil]
  ensure: [sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]]
  !

Item was changed:
  ----- Method: MCFileRepositoryInspector>>refresh (in category 'as yet unclassified') -----
  refresh
+ | packageNames |
- | packageNames name latest av |
  packageNames := Set new.
  packageList := nil.
+ versions := repository readableFileNames collect: [ :each | | name |
- versions := repository readableFileNames collect: [ :each |
  name := (each copyUpToLast: $.) copyUpTo: $(.
  name last isDigit ifFalse: [Array with: name with: '' with: '' with: each]
  ifTrue:
  [Array
  with: (packageNames add: (name copyUpToLast:  $-)) "pkg name"
  with: ((name copyAfterLast: $-) copyUpTo: $.) "user"
  with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version"
  with: each]].
  versions := versions select: [:each | (each at: 3) isNumber].
  newer := Set new.
  inherited := Set new.
  loaded := Set new.
  (MCWorkingCopy allManagers
  " select: [ :each | packageNames includes: each packageName]")
+ do: [:each | | latest |
- do: [:each |
  each ancestors do: [ :ancestor |
  loaded add: ancestor name.
  ancestor ancestorsDoWhileTrue: [:heir |
  (inherited includes: heir name)
  ifTrue: [false]
  ifFalse: [inherited add: heir name. true]]].
  latest := (versions select: [:v | v first = each package name])
  detectMax: [:v | v third].
  (latest notNil and: [
+ each ancestors allSatisfy: [:ancestor | | av |
- each ancestors allSatisfy: [:ancestor |
  av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger.
  av < latest third or: [
  av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]])
  ifTrue: [newer add: each package name ]].
 
  self changed: #packageList; changed: #versionList!

Item was changed:
+ ----- Method: MCClassTraitDefinition class>>baseTraitName:classTraitComposition: (in category 'instance creation') -----
- ----- Method: MCClassTraitDefinition class>>baseTraitName:classTraitComposition: (in category 'as yet unclassified') -----
  baseTraitName: aString classTraitComposition: classTraitCompositionString
  ^self instanceLike: (
  self new
  initializeWithBaseTraitName: aString
  classTraitComposition: classTraitCompositionString).!

Item was changed:
  ----- Method: MCSubDirectoryRepository>>findFullNameForWriting: (in category 'as yet unclassified') -----
  findFullNameForWriting: aBaseName
+ | possible split prefix fpattern now |
- | possible split dirScore fileScore prefix fpattern parts now |
  split := directory splitNameVersionExtensionFor: aBaseName.
  fpattern := split first, '*'.
  possible := SortedCollection sortBlock: [ :a :b |
  a first = b first
  ifTrue: [ a second = b second
  ifFalse: [ a second < b second ]
  ifTrue: [ a third fullName size < b third fullName size ]]
  ifFalse: [ a first > b first ] ].
  now := Time totalSeconds.
  prefix := directory pathParts size.
+ self allDirectories do: [:dir | | parts dirScore fileScore |
- self allDirectories do: [:dir |
  parts := dir pathParts allButFirst: prefix.
  dirScore := (parts select: [ :part | fpattern match: part ]) size.
  fileScore := (dir entries collect: [ :ent |
  (ent isDirectory not and: [ fpattern match: ent name ])
  ifFalse: [ SmallInteger maxVal ]
  ifTrue: [ now - ent modificationTime ]]). "minimum age"
  fileScore := fileScore isEmpty ifTrue: [ SmallInteger maxVal  ]
  ifFalse: [ fileScore min ].
  possible add: { dirScore. fileScore. dir } ].
  ^ (possible first third) fullNameFor: aBaseName!

Item was changed:
  ----- Method: MCWorkingCopy>>findSnapshotWithVersionInfo: (in category 'private') -----
  findSnapshotWithVersionInfo: aVersionInfo
  ^ aVersionInfo
  ifNil: [MCSnapshot empty]
+ ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo)
+ ifNil: [MCSnapshot empty]
+ ifNotNil: [:aVersion | aVersion snapshot]]!
- ifNotNil: [(self repositoryGroup versionWithInfo: aVersionInfo) snapshot]!

Item was changed:
  ----- Method: MCVersionMerger>>addVersion: (in category 'as yet unclassified') -----
  addVersion: aVersion
+
- | dep |
  records add: (MCMergeRecord version: aVersion).
  aVersion dependencies do:
+ [:ea | | dep |
- [:ea |
  dep := ea resolve.
  (records anySatisfy: [:r | r version = dep]) ifFalse: [self addVersion: dep]]!

Item was changed:
  ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'as yet unclassified') -----
  userAndPasswordFromSettingsDo: aBlock
  "The mcSettings file in ExternalSettings preferenceDirectory should contain entries for each account:
 
  account1: *myhost.mydomain* user:password
  account2: *otherhost.mydomain/somerep* dXNlcjpwYXNzd29yZA==
 
  That is it must start with 'account', followed by anything to distinguish accounts, and a colon. Then comes a match expression for the repository url, and after a space the user:password string.
 
  To not have the clear text password on your disc, you can base64 encode it:
  (Base64MimeConverter mimeEncode: 'user:password' readStream) contents
  "
 
+
- | entry userAndPassword |
  Settings ifNotNil: [
+ Settings keysAndValuesDo: [:key :value | | userAndPassword entry |
- Settings keysAndValuesDo: [:key :value |
  (key asLowercase beginsWith: 'account') ifTrue: [
  entry := value findTokens: ' '.
  (entry first match: location) ifTrue: [
  userAndPassword := entry second.
  (userAndPassword includes: $:) ifFalse: [
  userAndPassword := (Base64MimeConverter mimeDecodeToChars: userAndPassword readStream) contents].
  userAndPassword := userAndPassword findTokens: $:.
  ^aBlock value: userAndPassword first
  value: userAndPassword second
  ]
  ]
  ]
  ].
  ^nil!

Item was changed:
  ----- Method: MCAncestry>>topologicalAncestors (in category 'ancestry') -----
  topologicalAncestors
+
- | frontier f |
  ^ Array streamContents:
+ [:s | | frontier f |
- [:s |
  frontier := MCFrontier frontierOn: self.
  [f := frontier frontier.
  s nextPutAll: f.
  frontier removeAll: f.
  f isEmpty] whileFalse] !

Item was changed:
  ----- Method: MCTool>>buttonRow: (in category 'morphic ui') -----
  buttonRow: specArray
+ | aRow |
- | aRow aButton state |
  aRow := AlignmentMorph newRow.
  aRow
  color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]);
  borderWidth: 0.
 
  aRow hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true.
  aRow clipSubmorphs: true.
  aRow layoutInset:2@2; cellInset: 1; color: Color white.
  aRow wrapCentering: #center; cellPositioning: #leftCenter.
  specArray do:
+ [:triplet | | aButton state |
- [:triplet |
  state := triplet at: 4 ifAbsent: [#buttonState].
  aButton := PluggableButtonMorph
  on: self
  getState: state
  action: #performButtonAction:enabled:.
  aButton
  hResizing: #spaceFill;
  vResizing: #spaceFill;
  label: triplet first asString;
  arguments: (Array with: triplet second with: state);
  onColor: Color white offColor: Color white.
  aRow addMorphBack: aButton.
  aButton setBalloonText: triplet third].
 
  ^ aRow!