Merge branch 'issue_92' into gemstone2.4

dalehenrich · Jul 19, 2013 · 24c63a7 · 24c63a7
2 parents 5cd4753 + 3881005
commit 24c63a7
Show file tree

Hide file tree

Showing 37 changed files with 313 additions and 61 deletions.
diff --git a/...nticelloFileTree-Core.package/MCFileTreeStCypressWriter.class/instance/fileNameMapFor..st b/...nticelloFileTree-Core.package/MCFileTreeStCypressWriter.class/instance/fileNameMapFor..st
@@ -0,0 +1,50 @@
+private
+fileNameMapFor: aMethodDefinitionCollection
+  "https://github.com/dalehenrich/filetree/issues/92"
+
+  "answer a dictionary that maps each definition selector to a filename that is guaranteed unique on case insensitive file systems.
+  Segregate instance and class side methods. Key is true for class method map, false for instance method map"
+
+  | map filenameMetaMap |
+  map := Dictionary new.
+  aMethodDefinitionCollection
+    do: [ :mDef | 
+      | sel col metaKey methMap |
+      "sort into bins by lowercase selector. "
+      metaKey := mDef classIsMeta.
+      methMap := map
+        at: metaKey
+        ifAbsent: [ map at: metaKey put: Dictionary new ].
+      sel := mDef selector asLowercase.
+      col := methMap
+        at: sel
+        ifAbsent: [ methMap at: sel put: OrderedCollection new ].
+      col add: mDef ].
+  filenameMetaMap := Dictionary new.
+  map
+    keysAndValuesDo: [ :metaKey :methMap | 
+      | filenameMap |
+      filenameMap := filenameMetaMap
+        at: metaKey
+        ifAbsent: [ filenameMetaMap at: metaKey put: Dictionary new ].
+      methMap values
+        do: [ :col | 
+          | selector filename sortedCol |
+          col size = 1
+            ifTrue: [ 
+              | def |
+              "no need to distinguish filename"
+              def := col at: 1.
+              filenameMap
+                at: def selector
+                put: (self fileNameForSelector: def selector) ]
+            ifFalse: [ 
+              "tack on postfix to guarantee  file names are uniique on case insensitive file systems"
+              sortedCol := col sorted: [ :a :b | a name <= b name ].
+              1 to: sortedCol size do: [ :index | 
+                | def filename |
+                def := sortedCol at: index.
+                filename := self fileNameForSelector: def selector.
+                filename := filename , '..' , index printString.
+                filenameMap at: def selector put: filename ] ] ] ].
+  ^ filenameMetaMap
diff --git a/...icelloFileTree-Core.package/MCFileTreeStCypressWriter.class/instance/writeDefinitions..st b/...icelloFileTree-Core.package/MCFileTreeStCypressWriter.class/instance/writeDefinitions..st
@@ -1,53 +1,86 @@
 initialize-release
 writeDefinitions: aCollection
-    | classDirExtension extensionClasses extensionMethodDefinitions extensionMethodMap |
-    self writeBasicDefinitions: aCollection.
-    extensionClasses := OrderedCollection new.
-    extensionMethodDefinitions := OrderedCollection new.
-    self methodDefinitions
-        keysAndValuesDo: [ :className :extensionMethods | 
-            self classDefinitions
-                at: className
-                ifAbsent: [ 
-                    extensionClasses add: className.
-                    extensionMethodDefinitions addAll: extensionMethods ] ].
-    extensionClasses do: [ :className | self methodDefinitions removeKey: className ].
-    classDirExtension := '.class'.
-    self classDefinitions
-        keysAndValuesDo: [ :className :definition | 
-            | classPath instanceMethodPath classMethodPath |
-            classPath := definition className , classDirExtension , self fileUtils pathNameDelimiter asString.
-            self writeClassDefinition: definition to: classPath.
-            instanceMethodPath := classPath , 'instance' , self fileUtils pathNameDelimiter asString.
-            classMethodPath := classPath , 'class' , self fileUtils pathNameDelimiter asString.
-            (self methodDefinitions at: className ifAbsent: [ #() ])
-                do: [ :methodDefinition | 
-                    methodDefinition classIsMeta
-                        ifTrue: [ self writeMethodDefinition: methodDefinition to: classMethodPath ]
-                        ifFalse: [ self writeMethodDefinition: methodDefinition to: instanceMethodPath ] ] ].
-    classDirExtension := '.extension'.
-    extensionMethodMap := Dictionary new.
-    extensionMethodDefinitions
+  | classDirExtension extensionClasses extensionMethodDefinitions extensionMethodMap |
+  self writeBasicDefinitions: aCollection.
+  extensionClasses := OrderedCollection new.
+  extensionMethodDefinitions := OrderedCollection new.
+  self methodDefinitions
+    keysAndValuesDo: [ :className :extensionMethods | 
+      self classDefinitions
+        at: className
+        ifAbsent: [ 
+          extensionClasses add: className.
+          extensionMethodDefinitions addAll: extensionMethods ] ].
+  extensionClasses
+    do: [ :className | self methodDefinitions removeKey: className ].
+  classDirExtension := '.class'.
+  self classDefinitions
+    keysAndValuesDo: [ :className :definition | 
+      | classPath instanceMethodPath classMethodPath filenameMetaMap theMethodDefinitions |
+      classPath := definition className , classDirExtension
+        , self fileUtils pathNameDelimiter asString.
+      self writeClassDefinition: definition to: classPath.
+      instanceMethodPath := classPath , 'instance'
+        , self fileUtils pathNameDelimiter asString.
+      classMethodPath := classPath , 'class'
+        , self fileUtils pathNameDelimiter asString.
+      theMethodDefinitions := self methodDefinitions
+        at: className
+        ifAbsent: [ #() ].
+      filenameMetaMap := self fileNameMapFor: theMethodDefinitions.
+      theMethodDefinitions
         do: [ :methodDefinition | 
-            | classPath methodPath |
-            (extensionMethodMap
-                at: methodDefinition className
-                ifAbsent: [ extensionMethodMap at: methodDefinition className put: OrderedCollection new ])
-                add: methodDefinition.
-            classPath := methodDefinition className , classDirExtension , self fileUtils pathNameDelimiter asString.
-            self writeExtensionClassDefinition: methodDefinition to: classPath.
-            methodPath := classPath
-                ,
-                    (methodDefinition classIsMeta
-                        ifTrue: [ 'class' ]
-                        ifFalse: [ 'instance' ]) , self fileUtils pathNameDelimiter asString.
-            self writeMethodDefinition: methodDefinition to: methodPath ].
-    extensionMethodMap
-        keysAndValuesDo: [ :className :classMethodDefinitions | 
-            | classPath |
-            classPath := className , classDirExtension , self fileUtils pathNameDelimiter asString.
-            self
-                writeInDirectoryName: classPath
-                fileName: 'methodProperties'
-                extension: self propertyFileExtension
-                visit: [ self writeMethodProperties: classMethodDefinitions ] ]
+          | filename |
+          filename := (filenameMetaMap at: methodDefinition classIsMeta)
+            at: methodDefinition selector.
+          methodDefinition classIsMeta
+            ifTrue: [ 
+              self
+                writeMethodDefinition: methodDefinition
+                to: classMethodPath
+                filename: filename ]
+            ifFalse: [ 
+              self
+                writeMethodDefinition: methodDefinition
+                to: instanceMethodPath
+                filename: filename ] ] ].
+  classDirExtension := '.extension'.
+  extensionMethodMap := Dictionary new.
+  extensionMethodDefinitions
+    do: [ :methodDefinition | 
+      | classPath methodPath |
+      (extensionMethodMap
+        at: methodDefinition className
+        ifAbsent: [ extensionMethodMap at: methodDefinition className put: OrderedCollection new ])
+        add: methodDefinition.
+      classPath := methodDefinition className , classDirExtension
+        , self fileUtils pathNameDelimiter asString.
+      self writeExtensionClassDefinition: methodDefinition to: classPath ].
+  extensionMethodMap
+    keysAndValuesDo: [ :className :classMethodDefinitions | 
+      | classPath filenameMetaMap |
+      filenameMetaMap := self fileNameMapFor: classMethodDefinitions.
+      classMethodDefinitions
+        do: [ :methodDefinition | 
+          | filename methodPath |
+          filename := (filenameMetaMap at: methodDefinition classIsMeta)
+            at: methodDefinition selector.
+          classPath := methodDefinition className , classDirExtension
+            , self fileUtils pathNameDelimiter asString.
+          methodPath := classPath
+            ,
+              (methodDefinition classIsMeta
+                ifTrue: [ 'class' ]
+                ifFalse: [ 'instance' ])
+            , self fileUtils pathNameDelimiter asString.
+          self
+            writeMethodDefinition: methodDefinition
+            to: methodPath
+            filename: filename ].
+      classPath := className , classDirExtension
+        , self fileUtils pathNameDelimiter asString.
+      self
+        writeInDirectoryName: classPath
+        fileName: 'methodProperties'
+        extension: self propertyFileExtension
+        visit: [ self writeMethodProperties: classMethodDefinitions ] ]
diff --git a/...leTree-Core.package/MCFileTreeStCypressWriter.class/instance/writeMethodDefinition.to..st b/...leTree-Core.package/MCFileTreeStCypressWriter.class/instance/writeMethodDefinition.to..st
@@ -1,9 +1,3 @@
 writing
 writeMethodDefinition: methodDefinition to: methodPath
-    | filename |
-    filename := self fileNameForSelector: methodDefinition selector.
-    self
-        writeInDirectoryName: methodPath
-        fileName: filename
-        extension: '.st'
-        visit: [ self writeMethodDefinition: methodDefinition ]
+  self shouldNotImplement
diff --git a/...re.package/MCFileTreeStCypressWriter.class/instance/writeMethodDefinition.to.filename..st b/...re.package/MCFileTreeStCypressWriter.class/instance/writeMethodDefinition.to.filename..st
@@ -0,0 +1,7 @@
+writing
+writeMethodDefinition: methodDefinition to: methodPath filename: filename
+  self
+    writeInDirectoryName: methodPath
+    fileName: filename
+    extension: '.st'
+    visit: [ self writeMethodDefinition: methodDefinition ]
diff --git a/...ory/MonticelloFileTree-Core.package/MCFileTreeStCypressWriter.class/methodProperties.json b/...ory/MonticelloFileTree-Core.package/MCFileTreeStCypressWriter.class/methodProperties.json
@@ -5,15 +5,17 @@
 		"specials" : "dkh 4/4/2012 11:27" },
 	"instance" : {
 		"fileNameForSelector:" : "dkh 02/13/2013 17:04",
+		"fileNameMapFor:" : "dkh 07/18/2013 17:11",
 		"propertyFileExtension" : "dkh 07/07/2013 22:15",
 		"setFileStream:" : "dkh 4/4/2012 14:01",
 		"writeClassComment:" : "dkh 03/22/2013 11:30",
 		"writeClassDefinition:" : "dkh 03/22/2013 13:51",
 		"writeClassDefinition:to:" : "dkh 07/07/2013 22:13",
-		"writeDefinitions:" : "dkh 07/07/2013 22:14",
+		"writeDefinitions:" : "dkh 07/18/2013 17:12",
 		"writeExtensionClassDefinition:" : "dkh 4/4/2012 17:52",
 		"writeExtensionClassDefinition:to:" : "dkh 07/07/2013 22:14",
 		"writeMethodDefinition:" : "dkh 03/22/2013 11:30",
-		"writeMethodDefinition:to:" : "dkh 4/4/2012 11:37",
+		"writeMethodDefinition:to:" : "dkh 07/18/2013 17:01",
+		"writeMethodDefinition:to:filename:" : "dkh 07/18/2013 16:34",
 		"writeMethodProperties:" : "dkh 6/12/2012 17:33:23",
 		"writePropertiesFile" : "dkh 07/07/2013 22:14" } }
diff --git a/repository/MonticelloFileTree-Core.package/monticello.meta/version b/repository/MonticelloFileTree-Core.package/monticello.meta/version
diff --git a/repository/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/README.md b/repository/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/README.md
diff --git a/...icelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/tearDownPackagesList.st b/...icelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/tearDownPackagesList.st
@@ -0,0 +1,3 @@
+running
+tearDownPackagesList
+  ^ #('Issue92')
diff --git a/repository/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/testLoad.st b/repository/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/testLoad.st
@@ -0,0 +1,11 @@
+tests
+testLoad
+  | packageName |
+  packageName := 'Issue92'.
+  {packageName} do: [ :pn | self deny: (self hasPackage: pn) ].
+  Gofer new
+    disablePackageCache;
+    repository: (self getTestRepository: 'issue69');
+    package: packageName;
+    load.
+  self validateSelectors
diff --git a/...y/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/testWriteNRead.st b/...y/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/testWriteNRead.st
@@ -0,0 +1,32 @@
+tests
+testWriteNRead
+  | packageName versionInfo version |
+  packageName := 'Issue92'.
+  {packageName} do: [ :pn | self deny: (self hasPackage: pn) ].
+  Gofer new
+    disablePackageCache;
+    repository: (self getTestRepository: 'issue69');
+    package: packageName;
+    load.
+  self validateSelectors.
+  {packageName}
+    do: [ :pn | 
+      versionInfo := (MCWorkingCopy allManagers detect: [ :wc | wc packageName = pn ])
+        ancestors first.
+      version := (self getTestRepository: 'issue69')
+        versionWithInfo: versionInfo.
+      (self getTestRepository: 'empty') storeVersion: version ].
+  Gofer new
+    package: packageName;
+    unload.
+  {packageName} do: [ :pn | self deny: (self hasPackage: pn) ].
+  self
+    shouldnt: [ 
+      Gofer new
+        disablePackageCache;
+        repository: (self getTestRepository: 'empty');
+        package: packageName;
+        load ]
+    raise: Error.
+  {packageName} do: [ :pn | self assert: (self hasPackage: pn) ].
+  self validateSelectors
diff --git a/...onticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/validateSelectors.st b/...onticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/instance/validateSelectors.st
@@ -0,0 +1,19 @@
+tests
+validateSelectors
+  | cls selectors expectedSelectors objectClassSelectors objectSelectors |
+  #('Issue92') do: [ :pn | self assert: (self hasPackage: pn) ].
+  expectedSelectors := #(#'IssueNumber92:AndArg2:' #'issueNumber92:andArg2:' #'issuenumber92:andarg2:').
+  cls := Smalltalk classNamed: #'CCC'.
+  2
+    timesRepeat: [ 
+      selectors := cls selectors.
+      self assert: selectors size == expectedSelectors size.
+      expectedSelectors
+        do: [ :selector | self assert: (selectors includes: selector) ].
+      cls := cls class ].
+  objectSelectors := Object selectors.
+  objectClassSelectors := Object class selectors.
+  expectedSelectors
+    do: [ :selector | 
+      self assert: (objectSelectors includes: selector).
+      self assert: (objectClassSelectors includes: selector) ]
diff --git a/...sitory/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/methodProperties.json b/...sitory/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/methodProperties.json
@@ -0,0 +1,8 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"tearDownPackagesList" : "dkh 07/18/2013 20:45",
+		"testLoad" : "dkh 07/18/2013 20:46",
+		"testWriteNRead" : "dkh 07/18/2013 20:47",
+		"validateSelectors" : "dkh 07/18/2013 21:05" } }
diff --git a/repository/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/properties.json b/repository/MonticelloFileTree-Tests.package/MCFileTreeIssue92Test.class/properties.json
@@ -0,0 +1,14 @@
+{
+	"category" : "MonticelloFileTree-Tests",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		 ],
+	"name" : "MCFileTreeIssue92Test",
+	"pools" : [
+		 ],
+	"super" : "MCFileTreeGenericLoaderTest",
+	"type" : "normal" }