Merge branch 'master' into pharo3.0_dev :: Issue #136 bugfix

dalehenrich · Feb 1, 2015 · 9ec268a · 9ec268a
2 parents ac4c95f + bc48700
commit 9ec268a
Show file tree

Hide file tree

Showing 50 changed files with 481 additions and 71 deletions.
diff --git a/repository/.gitattributes b/repository/.gitattributes
@@ -0,0 +1,3 @@
+*.package/monticello.meta/version        merge=mcVersion
+*.package/*.class/methodProperties.json      merge=mcMethodProperties
+
diff --git a/...-Core.package/MCFileTreeStCypressReader.class/instance/addClassDefinitionFrom.comment..st b/...-Core.package/MCFileTreeStCypressReader.class/instance/addClassDefinitionFrom.comment..st
@@ -1,17 +1,25 @@
 utilities
 addClassDefinitionFrom: classPropertiesDict comment: classComment
-    definitions
-        add:
-            (MCClassDefinition
-                name: (classPropertiesDict at: 'name')
-                superclassName: (classPropertiesDict at: 'super')
-                traitComposition: (classPropertiesDict at: 'traitcomposition' ifAbsent: [ '{}' ])
-                classTraitComposition: (classPropertiesDict at: 'classtraitcomposition' ifAbsent: [ '{}' ])
-                category: (classPropertiesDict at: 'category' ifAbsent: [ self packageNameFromPackageDirectory ])
-                instVarNames: (classPropertiesDict at: 'instvars' ifAbsent: [ #() ])
-                classVarNames: (classPropertiesDict at: 'classvars' ifAbsent: [ #() ])
-                poolDictionaryNames: (classPropertiesDict at: 'pools' ifAbsent: [ #() ])
-                classInstVarNames: (classPropertiesDict at: 'classinstvars' ifAbsent: [ #() ])
-                type: (classPropertiesDict at: 'type' ifAbsent: [ 'normal' ]) asSymbol
-                comment: classComment
-                commentStamp: (classPropertiesDict at: 'commentStamp' ifAbsent: [ '' ]))
+  | categoryName className |
+  className := classPropertiesDict at: 'name'.
+  categoryName := classPropertiesDict
+    at: 'category'
+    ifAbsent: [ self packageNameFromPackageDirectory ].
+  self validateClassCategory: categoryName for: className.
+  definitions
+    add:
+      (MCClassDefinition
+        name: className
+        superclassName: (classPropertiesDict at: 'super')
+        traitComposition: (classPropertiesDict at: 'traitcomposition' ifAbsent: [ '{}' ])
+        classTraitComposition: (classPropertiesDict at: 'classtraitcomposition' ifAbsent: [ '{}' ])
+        category: categoryName
+        instVarNames: (classPropertiesDict at: 'instvars' ifAbsent: [ #() ])
+        classVarNames: (classPropertiesDict at: 'classvars' ifAbsent: [ #() ])
+        poolDictionaryNames: (classPropertiesDict at: 'pools' ifAbsent: [ #() ])
+        classInstVarNames:
+          (classPropertiesDict at: 'classinstvars' ifAbsent: [ #() ])
+        type: (classPropertiesDict at: 'type' ifAbsent: [ 'normal' ]) asSymbol
+        comment: classComment
+        commentStamp: (classPropertiesDict at: 'commentStamp' ifAbsent: [ '' ]))
+
diff --git a/...FileTreeStCypressReader.class/instance/addExtensionClassAndMethodDefinitionsFromEntry..st b/...FileTreeStCypressReader.class/instance/addExtensionClassAndMethodDefinitionsFromEntry..st
@@ -1,17 +1,24 @@
 utilities
 addExtensionClassAndMethodDefinitionsFromEntry: classEntry
-    | classDirectory classPropertiesDict methodPropertiesDict entries |
-    classDirectory := self fileUtils directoryFromEntry: classEntry.
-    ((entries := classDirectory entries) detect: [ :entry | self isPropertyFile: entry] ifNone: [  ])
-        ifNotNil: [ :propertyEntry | propertyEntry readStreamDo: [ :fileStream | classPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
-    methodPropertiesDict := Dictionary new.
-    (entries detect: [ :entry | self isMethodPropertyFile: entry] ifNone: [  ])
-        ifNotNil: [ :propertyEntry | 
-            propertyEntry
-                readStreamDo: [ :fileStream | 
-                    "Issue 33: https://github.com/dalehenrich/filetree/issues/33"
-                    methodPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
-    self
-        addMethodDefinitionsForClass: (classPropertiesDict at: 'name')
-        methodProperties: methodPropertiesDict
-        in: entries
+  | classDirectory classPropertiesDict methodPropertiesDict entries |
+  classDirectory := self fileUtils directoryFromEntry: classEntry.
+  ((entries := classDirectory entries)
+    detect: [ :entry | self isPropertyFile: entry ]
+    ifNone: [  ])
+    ifNotNil: [ :propertyEntry | 
+      propertyEntry
+        readStreamDo: [ :fileStream | 
+          classPropertiesDict := MCFileTreeJsonParser
+            parseStream: fileStream ] ].
+  methodPropertiesDict := Dictionary new.
+  (entries detect: [ :entry | self isMethodPropertyFile: entry ] ifNone: [  ])
+    ifNotNil: [ :propertyEntry | 
+      propertyEntry
+        readStreamDo: [ :fileStream | 
+          "Issue 33: https://github.com/dalehenrich/filetree/issues/33"
+          methodPropertiesDict := MCFileTreeJsonParser parseStream: fileStream ] ].
+  self
+    addMethodDefinitionsForClass: (classPropertiesDict at: 'name')
+    methodProperties: methodPropertiesDict
+    in: entries
+    extensionMethod: true
diff --git a/...leTreeStCypressReader.class/instance/addMethodDefinitionsForClass.methodProperties.in..st b/...leTreeStCypressReader.class/instance/addMethodDefinitionsForClass.methodProperties.in..st
@@ -1,35 +1,7 @@
 utilities
 addMethodDefinitionsForClass: className methodProperties: methodProperties in: entries
-    entries
-        do: [ :entry | 
-            | classIsMeta |
-            classIsMeta := false.
-            entry name = 'class'
-                ifTrue: [ classIsMeta := true ].
-            (entry name = 'instance' or: [ entry name = 'class' ])
-                ifTrue: [ 
-                    ((self fileUtils directoryFromEntry: entry) entries select: [ :each | each name endsWith: '.st' ])
-                        do: [ :methodEntry | 
-                            methodEntry
-                                readStreamDo: [ :fileStream | 
-                                    | category source timestamp selector |
-                                    category := fileStream nextLine.
-                                    source := fileStream upToEnd.
-                                    selector := self methodSelectorFor: source.
-                                    timestamp := methodProperties
-                                        at:
-                                            (classIsMeta
-                                                ifTrue: [ 'class' ]
-                                                ifFalse: [ 'instance' ])
-                                        ifPresent: [ :map | map at: selector asString ifAbsent: [  ] ].	"Issue 33: https://github.com/dalehenrich/filetree/issues/33"
-                                    timestamp
-                                        ifNil: [ timestamp := self info author , ' ' , self info date mmddyyyy , ' ' , self info time print24 ].
-                                    definitions
-                                        add:
-                                            (MCMethodDefinition
-                                                className: className
-                                                classIsMeta: classIsMeta
-                                                selector: selector
-                                                category: category
-                                                timeStamp: timestamp
-                                                source: source) ] ] ] ]
+  ^ self
+    addMethodDefinitionsForClass: className
+    methodProperties: methodProperties
+    in: entries
+    extensionMethod: false
diff --git a/...eader.class/instance/addMethodDefinitionsForClass.methodProperties.in.extensionMethod..st b/...eader.class/instance/addMethodDefinitionsForClass.methodProperties.in.extensionMethod..st
@@ -0,0 +1,37 @@
+utilities
+addMethodDefinitionsForClass: className methodProperties: methodProperties in: entries extensionMethod: extensionMethod
+    entries
+        do: [ :entry | 
+            | classIsMeta |
+            classIsMeta := false.
+            entry name = 'class'
+                ifTrue: [ classIsMeta := true ].
+            (entry name = 'instance' or: [ entry name = 'class' ])
+                ifTrue: [ 
+                    ((self fileUtils directoryFromEntry: entry) entries select: [ :each | each name endsWith: '.st' ])
+                        do: [ :methodEntry | 
+                            methodEntry
+                                readStreamDo: [ :fileStream | 
+                                    | category source timestamp selector |
+                                    category := fileStream nextLine.
+                                    source := fileStream upToEnd.
+                                    selector := self methodSelectorFor: source.
+                                    timestamp := methodProperties
+                                        at:
+                                            (classIsMeta
+                                                ifTrue: [ 'class' ]
+                                                ifFalse: [ 'instance' ])
+                                        ifPresent: [ :map | map at: selector asString ifAbsent: [  ] ].	"Issue 33: https://github.com/dalehenrich/filetree/issues/33"
+                                    timestamp
+                                        ifNil: [ timestamp := self info author , ' ' , self info date mmddyyyy , ' ' , self info time print24 ].
+                                    extensionMethod
+                                      ifTrue: [ self validateExtensionMethodCategory: category for: className selector: selector ].
+                                    definitions
+                                        add:
+                                            (MCMethodDefinition
+                                                className: className
+                                                classIsMeta: classIsMeta
+                                                selector: selector
+                                                category: category
+                                                timeStamp: timestamp
+                                                source: source) ] ] ] ]
diff --git a/...eTree-Core.package/MCFileTreeStCypressReader.class/instance/validateClassCategory.for..st b/...eTree-Core.package/MCFileTreeStCypressReader.class/instance/validateClassCategory.for..st
@@ -0,0 +1,15 @@
+validation
+validateClassCategory: categoryName for: className
+  "https://github.com/dalehenrich/filetree/issues/136"
+
+  "class category must match the package name ... guard against manual editing mistakes"
+
+  | prefix |
+  prefix := self packageNameFromPackageDirectory.
+  (self verifyCategory: categoryName matches: prefix)
+    ifTrue: [ ^ self ].
+  self
+    error:
+      'Class category name ' , categoryName printString , ' for the class '
+        , className printString , ' is inconsistent with the package name '
+        , prefix printString
diff --git a/...MCFileTreeStCypressReader.class/instance/validateExtensionMethodCategory.for.selector..st b/...MCFileTreeStCypressReader.class/instance/validateExtensionMethodCategory.for.selector..st
@@ -0,0 +1,24 @@
+validation
+validateExtensionMethodCategory: categoryName for: className selector: selector
+  "https://github.com/dalehenrich/filetree/issues/136"
+
+  "method category must match the package name for extension methods... guard against manual editing mistakes"
+
+  "extracted from PackageInfo>>isForeignClassExtension:"
+
+  | prefix prefixSize catSize |
+  prefix := '*' , self packageNameFromPackageDirectory asLowercase.
+  categoryName
+    ifNotNil: [ 
+      (categoryName isEmpty not
+        and: [ 
+          categoryName first = $*
+            and: [ 
+              "asLowercase needed in GemStone 3.1.0.6?"
+              self verifyCategory: categoryName asLowercase matches: prefix ] ])
+        ifTrue: [ ^ self ] ].
+  self
+    error:
+      'Method protocol ' , categoryName printString , ' for the method '
+        , selector asString printString , ' in class ' , className printString
+        , ' is inconsistent with the package name ' , prefix printString
diff --git a/...FileTree-Core.package/MCFileTreeStCypressReader.class/instance/verifyCategory.matches..st b/...FileTree-Core.package/MCFileTreeStCypressReader.class/instance/verifyCategory.matches..st
@@ -0,0 +1,21 @@
+validation
+verifyCategory: categoryName matches: basicPackageName
+  "https://github.com/dalehenrich/filetree/issues/136"
+
+  "copied from PackageInfo>>category:matches: and GoferVersionReference>>parseName:"
+
+  | prefixSize catSize packagePrefix |
+  categoryName ifNil: [ ^ false ].
+  packagePrefix := basicPackageName.
+  (packagePrefix includes: $.)
+    ifTrue: [ 
+      "exclude branch name"
+      packagePrefix := packagePrefix copyUpTo: $. ].
+  catSize := categoryName size.
+  prefixSize := packagePrefix size.
+  catSize < prefixSize
+    ifTrue: [ ^ false ].
+  (categoryName findString: packagePrefix startingAt: 1 caseSensitive: false)
+    = 1
+    ifFalse: [ ^ false ].
+  ^ (categoryName at: packagePrefix size + 1 ifAbsent: [ ^ true ]) = $-
diff --git a/...ory/MonticelloFileTree-Core.package/MCFileTreeStCypressReader.class/methodProperties.json b/...ory/MonticelloFileTree-Core.package/MCFileTreeStCypressReader.class/methodProperties.json
@@ -5,9 +5,10 @@
 	"instance" : {
 		"addClassAndMethodDefinitionsFromDirectory:" : "topa 7/22/2013 01:41",
 		"addClassAndMethodDefinitionsFromEntry:" : "dkh 8/10/2012 13:48",
-		"addClassDefinitionFrom:comment:" : "dkh 6/27/2012 14:18",
-		"addExtensionClassAndMethodDefinitionsFromEntry:" : "dkh 8/10/2012 14:00",
-		"addMethodDefinitionsForClass:methodProperties:in:" : "dkh 8/10/2012 14:01",
+		"addClassDefinitionFrom:comment:" : "dkh 01/31/2015 06:51",
+		"addExtensionClassAndMethodDefinitionsFromEntry:" : "dkh 01/31/2015 06:56",
+		"addMethodDefinitionsForClass:methodProperties:in:" : "dkh 01/31/2015 06:55",
+		"addMethodDefinitionsForClass:methodProperties:in:extensionMethod:" : "dkh 01/31/2015 06:56",
 		"addTraitAndMethodDefinitionsFromEntry:" : "topa 7/22/2013 14:41",
 		"addTraitDefinitionFrom:comment:" : "topa 7/22/2013 15:15",
 		"basicVersion" : "dkh 6/27/2012 20:19",
@@ -17,4 +18,7 @@
 		"loadPackage" : "dkh 6/27/2012 20:21",
 		"loadVersionInfo" : "08/08/2013 15:01",
 		"methodSelectorFor:" : "ChristopheDemarey 5/31/2013 23:28",
-		"packageNameFromPackageDirectory" : "dkh 8/10/2012 14:55" } }
+		"packageNameFromPackageDirectory" : "dkh 8/10/2012 14:55",
+		"validateClassCategory:for:" : "dkh 01/31/2015 12:20",
+		"validateExtensionMethodCategory:for:selector:" : "dkh 01/31/2015 13:41",
+		"verifyCategory:matches:" : "dkh 01/31/2015 15:14" } }