Merge pull request #536 from GemTalk/candidateV1.2

v1.2.9 release

platforms/gemstone/bin/packing_oscar

@@ -37,6 +37,7 @@ set -e
 # 1.2.5 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.5 v1.2.5 Oscar-3.0.50
 # 1.2.6 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.6 v1.2.6 Oscar-3.0.65
 # 1.2.7 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.7 v1.2.7 Oscar-3.0.85
+# 1.2.8 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.8 v1.2.8 Oscar-3.0.87
 #
 ANSI_RED="\033[91;1m"
 ANSI_GREEN="\033[92;1m"

rowan/src/Rowan-GemStone-Core/RwGsLoadedSymbolDictMethod.class.st

@@ -40,6 +40,17 @@ RwGsLoadedSymbolDictMethod >> key [
 	^ name	"This is inadequate because the same selector can be defined in both class and metaclass?"
 ]
 
+{ #category : 'printing' }
+RwGsLoadedSymbolDictMethod >> printOn: aStream [
+
+	super printOn: aStream.
+	name
+		ifNotNil: 
+			[aStream
+				space;
+				nextPutAll: handle inClass printString, ' ( ', handle inClass asOop asString, ' )' ]
+]
+
 { #category : 'accessing' }
 RwGsLoadedSymbolDictMethod >> source [
 

rowan/src/Rowan-Services-Core/RowanAnsweringService.class.st

@@ -324,6 +324,27 @@ RowanAnsweringService >> printStringOf: oop toMaxSize: integer [
 	^answer
 ]
 
+{ #category : 'client commands' }
+RowanAnsweringService >> profile: block [
+  "not used yet. Utility method needs testing.
+	Make sure block execution time is long enough - say 1 second. 
+	Results may not be consistent
+
+	Usage example: 
+| block answeringService | 
+block := [| browserService profMonitor |
+		browserService := (RowanBrowserService new) .
+		10 timesRepeat:[browserService packagesWithTests]]. 
+answeringService := RowanAnsweringService new profile: block.
+answeringService answer. "
+
+  | time ns |
+  time := System millisecondsToRun: block.
+  ns := ProfMonitor computeInterval: time / 1000.
+  answer := ProfMonitor monitorBlock: block intervalNs: ns.
+  RowanCommandResult addResult: self
+]
+
 { #category : 'client commands' }
 RowanAnsweringService >> runMethodTests: methodServices [
 

rowan/src/Rowan-Services-Core/RowanBrowserService.class.st

@@ -201,28 +201,36 @@ RowanBrowserService >> openWindows [
 
 { #category : 'client commands' }
 RowanBrowserService >> packagesWithTests [
+  organizer := ClassOrganizer new.	"when we call this method, our world has changed from a reload, etc."
   testPackages := Set new.
   testCount := 0.
-  TestCase allSubclasses
-    do: [ :testSubclass | 
-      | suite |
-      suite := testSubclass buildSuite.
-      suite tests
-        do: [ :testCase | 
-          | packageName compiledMethod |
-          (testCase isKindOf: TestSuite)
+  testPackages := Set new.
+  testCount := 0.
+  (organizer allSubclassesOf: TestCase)
+    do: [ :sub | 
+      | packageName testMethodCount |
+      testMethodCount := (sub sunitSelectors
+        select: [ :each | each beginsWith: 'test' ]) size.	"sending #testSelectors was slower"
+      testCount := testCount + testMethodCount.
+      testMethodCount > 0
+        ifTrue: [ 
+          packageName := sub rowanPackageName.
+          packageName = Rowan unpackagedName
             ifFalse: [ 
-              compiledMethod := testCase class
-                compiledMethodAt: testCase selector
-                otherwise: nil.
-              packageName := compiledMethod
-                ifNil: [ testCase class rowanPackageName ]
-                ifNotNil: [ compiledMethod rowanPackageName ].
-              packageName = Rowan unpackagedName
-                ifFalse: [ 
-                  testCount := testCount + 1.
-                  testPackages
-                    add: (RowanPackageService forPackageNamed: packageName) ] ] ] ].
+              testPackages
+                add:
+                  (RowanPackageService new
+                    name: packageName;
+                    updateProjectName;
+                    yourself) ].
+          (Rowan image loadedClassExtensionsForClass: sub)
+            do: [ :loadedThing | 
+              testPackages
+                add:
+                  (RowanPackageService new
+                    name: loadedThing loadedPackage name;
+                    updateProjectName;
+                    yourself)	"don't update the entire package for performance improvement" ] ] ].
   updateType := #'testPackages:'.
   testPackages := testPackages asArray.
   RowanCommandResult addResult: self
@@ -270,6 +278,7 @@ RowanBrowserService >> releaseWindowHandle: integer [
 RowanBrowserService >> reloadProjects: projectServices andUpdateServices: services [
   | projectNames answeringService |
   services do: [ :service | service organizer: organizer ].
+  projectServices do: [ :service | service organizer: organizer ].
   projectServices do: [ :projectService | projectService reloadProject ].
   projectNames := projectServices
     collect: [ :projectService | projectService name ].

rowan/src/Rowan-Services-Core/RowanClassService.class.st

@@ -109,6 +109,17 @@ RowanClassService >> addSubclassWarningString [
 	^'Superclass is not packaged. Enter the desired package name'
 ]
 
+{ #category : 'client commands' }
+RowanClassService >> allSubclassServices [
+  | subclassServices |
+  subclassServices := self theClass subclasses asArray
+    collect: [ :aClass | RowanClassService minimalForClassNamed: aClass name ].
+  hierarchyServices := Dictionary new.
+  hierarchyServices at: #'expand' put: subclassServices.
+  (hierarchyServices at: #'expand')
+    do: [ :classService | classService allSubclassServices ]
+]
+
 { #category : 'Accessing' }
 RowanClassService >> allTests [
 	| allSelectors theClass |
@@ -413,6 +424,23 @@ RowanClassService >> forClassNamed: className [
 	self refreshFrom: theClass.
 ]
 
+{ #category : 'client commands' }
+RowanClassService >> fullHierarchy [
+  | behavior sortedSubclasses |
+  behavior := self theClass.
+  hierarchyServices := Dictionary new.
+  hierarchyServices at: #'expand' put: Array new.
+  sortedSubclasses := behavior subclasses
+    asSortedCollection: [ :x :y | x name < y name ].
+  RowanCommandResult addResult: self.
+  sortedSubclasses
+    do: [ :subclass | 
+      | classService |
+      classService := (self classServiceFromOop: subclass asOop) meta: meta.
+      (hierarchyServices at: #'expand') add: classService.
+      classService allSubclassServices ]
+]
+
 { #category : 'comparing' }
 RowanClassService >> hash [
 	^self name hash bitXor: meta hash
@@ -620,17 +648,20 @@ RowanClassService >> objectInBaseNamed: aString [
 
 { #category : 'client commands' }
 RowanClassService >> oneLevelClassHierarchy [
-	"good for expanding an existing hierarchy quickly"
-	| behavior sortedSubclasses |
-	behavior := self theClass. 
-	hierarchyServices := Dictionary new. 
-	hierarchyServices at: #expand put: Array new. 
-	sortedSubclasses := behavior subclasses asSortedCollection:[:x :y | x name < y name].
-	sortedSubclasses do: [:subclass |
-		| classService |
-		classService := (self classServiceFromOop: subclass asOop) meta: meta.
-		(hierarchyServices at: #expand) add: classService. 
-	].
+  "good for expanding an existing hierarchy quickly"
+
+  | behavior sortedSubclasses |
+  behavior := self theClass.
+  hierarchyServices := Dictionary new.
+  hierarchyServices at: #'expand' put: Array new.
+  sortedSubclasses := behavior subclasses
+    asSortedCollection: [ :x :y | x name < y name ].
+  sortedSubclasses
+    do: [ :subclass | 
+      | classService |
+      classService := (self classServiceFromOop: subclass asOop) meta: meta.
+      (hierarchyServices at: #'expand') add: classService ].
+  RowanCommandResult addResult: self
 ]
 
 { #category : 'Accessing' }
@@ -1156,8 +1187,10 @@ RowanClassService >> updateTests [
   "update the test browsers on certain operations"
 
   RowanBrowserService new packagesWithTests.
-  (RowanPackageService new name: packageName) testClasses.
-  RowanCommandResult addResult: self update.
+  (RowanPackageService new
+    name: packageName;
+    yourself) testClasses.
+  RowanCommandResult addResult: self update
 ]
 
 { #category : 'Accessing' }

rowan/src/Rowan-Services-Core/RowanPackageService.class.st

@@ -242,12 +242,12 @@ RowanPackageService >> projectName: newValue [
 
 { #category : 'client commands' }
 RowanPackageService >> removeClass: classService [
-	self removeClassNamed: classService name. 
-	self setDefaultTemplate.
-	classService updateType: #removedClass:.
-	classService wasRemoved: true. 
-	RowanCommandResult addResult: classService.
-	RowanBrowserService new packagesWithTests. "sunit browser might need updated"
+  self removeClassNamed: classService name.
+  self setDefaultTemplate.
+  classService updateType: #'removedClass:'.
+  classService wasRemoved: true.
+  RowanCommandResult addResult: classService.
+  RowanBrowserService new packagesWithTests	"sunit browser might need updated"
 ]
 
 { #category : 'commands support' }
@@ -313,29 +313,28 @@ RowanPackageService >> setDefaultTemplate [
 RowanPackageService >> testClasses [
   organizer := ClassOrganizer new.
   testClasses := Set new.
-  TestCase allSubclasses
-    do: [ :testSubclass | 
-      testSubclass isAbstract
-        ifFalse: [ 
-          testSubclass suite tests
-            do: [ :testClassInstance | 
-              | implementingClass compiledMethod |
-              compiledMethod := testSubclass
-                compiledMethodAt: testClassInstance selector
-                otherwise: nil.
-              compiledMethod
-                ifNil: [ 
-                  implementingClass := testClassInstance class
-                    whichClassIncludesSelector: testClassInstance selector.
-                  compiledMethod := implementingClass
-                    compiledMethodAt: testClassInstance selector ].
-              (compiledMethod rowanPackageName = name
-                or: [ testSubclass rowanPackageName = name ])
-                ifTrue: [ 
-                  | classService |
-                  classService := RowanClassService
-                    basicForClassNamed: testSubclass name.
-                  testClasses add: classService ] ] ] ].
+  self loadedClasses
+    valuesDo: [ :loadedClass | 
+      | cls |
+      cls := loadedClass handle.
+      (cls inheritsFrom: TestCase)
+        ifTrue: [ 
+          cls isAbstract
+            ifFalse: [ 
+              | classService |
+              classService := RowanClassService basicForClassNamed: cls name.
+              testClasses add: classService ] ] ].
+  self loadedClassExtensions
+    valuesDo: [ :loadedClass | 
+      | cls |
+      cls := loadedClass handle.
+      (cls inheritsFrom: TestCase)
+        ifTrue: [ 
+          cls isAbstract
+            ifFalse: [ 
+              | classService |
+              classService := RowanClassService basicForClassNamed: cls name.
+              testClasses add: classService ] ] ].
   updateType := #'testClasses:'.
   testClasses := testClasses asArray.
   RowanCommandResult addResult: self

rowan/src/Rowan-Services-Core/RowanProjectService.class.st

@@ -246,7 +246,7 @@ RowanProjectService >> newGitProject: url root: rootPath useSsh: useSsh [
 		cloneSpecUrl: url
 		gitRootPath: rootPath
 		useSsh: useSsh.
-	RowanBrowserService new updateProjects.
+	(RowanBrowserService new organizer: organizer) updateProjects.
 ]
 
 { #category : 'rowan' }

rowan/src/Rowan-Services-Core/RowanService.class.st

@@ -83,7 +83,7 @@ RowanService class >> version [
   "change this method carefully and only at Jadeite release boundaries.
 	Failure to do so will prevent logins"
 
-  ^ 3087
+  ^ 3088
 ]
 
 { #category : 'other' }

rowan/src/Rowan-Services-Tests/RowanServicesTest.class.st

@@ -10,6 +10,11 @@ Class {
 	#category : 'Rowan-Services-Tests'
 }
 
+{ #category : 'testing' }
+RowanServicesTest class >> isAbstract [
+  ^ self sunitName = #'RowanServicesTest'
+]
+
 { #category : 'unicode method' }
 RowanServicesTest >> addUnicodeSymbolKeyToUserGlobals [
   "RowanServicesTest new addUnicodeSymbolKeyToUserGlobals"
@@ -151,6 +156,15 @@ RowanServicesTest >> defaultSymbolDictionaryName [
 	^'ServicesTestDictionary'
 ]
 
+{ #category : 'unicode method' }
+RowanServicesTest >> iAmAUnicodeMethod [
+
+		| abc |
+		abc := 'Ϛ'.
+		self halt. 
+		^abc
+]
+
 { #category : 'support' }
 RowanServicesTest >> jadeiteIssueTested: aSymbol withTitle: anObject [
 	"send this to help identify which tests test which issues