'Path' implementation

[Pavel Holejsovsky]

Hi Brian,

Brian T. Rice wrote:
> Thanks for taking the time to work on these. All of the changes (and 
> tests!) look good, and I'll apply them now.

Thanks for applying it.  Today I was torturing it a bit more and came 
with following 'fug bixes' + some indentation and comment typo fixes. 
Can you apply this too, please?

Pavel

-------------- next part --------------
Index: src/lib/path.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/lib/path.slate,v
retrieving revision 1.2
diff -u -r1.2 path.slate
--- src/lib/path.slate	8 Sep 2004 17:18:46 -0000	1.2
+++ src/lib/path.slate	9 Sep 2004 15:58:42 -0000
@@ -17,19 +17,22 @@
 [p1 names = p2 names].
 
 path@(Path traits) hash
-[names hash].
+[path names hash bitXor: path traits identityHash].
 
 path@(Path traits) from: root into: names isFound: isFound 
 		   canTraverseInto: canTraverseInto
 "Core of the path-searching functionality, contains the algorithm for
-breadth-first search of path between objects through slots.  'root' is the
-object where the search begins, 'names' is WriteStream into which are symbols
-specifying found path added.  'isFound' os predicate block, taking 2 arguments
-:name and :value of object to be tested - should return True when specified
-object terminates the search.  'canTraverseInto' is a predicate block which
-allows filtering out slots into which the search should not go.  Method answers
-the target object where the found path leads to, or Nil if requested path does
-not exist."
+breadth-first search of path between objects through slots. 
+
+'root' is the object where the search begins.
+'names' is WriteStream into which are symbols specifying found path added.
+'isFound' - predicate block, taking 2 arguments :name and :value of object to
+be tested - should return True when specified object terminates the search.
+'canTraverseInto' - predicate block which allows filtering out slots into which
+the search should not go.
+
+Answers the target object where the found path leads to, or Nil if requested
+path does not exist."
 [| pathLookupQueue seen |
   (isFound applyTo: {Nil. root}) ifTrue: [^ root].
   seen: (IdentitySet newWith: root).
@@ -91,11 +94,19 @@
    on: SlotNotFound do: [| :c | ^ Nil]
 ].
 
-path@(Path traits) printOn: s
+path@(Path traits) printOn: s withRoot: root
 [
-  path names
-    do: [| :slotName | s ; slotName name]
+  s ; '("' ; path printName ; '" '.
+  path names 
+    do: [| :slotName | s ; slotName name] 
     separatedBy: [s nextPut: $\s].
+  root ifNotNil: [s ; ' root: '. root printOn: s].
+  s ; ')'
+].
+
+path@(Path traits) printOn: s
+[
+  path printOn: s withRoot: Nil
 ].
 
 prototypes addPrototype: #RootedPath derivedFrom: {Path}.
@@ -121,7 +132,7 @@
 path@(RootedPath traits) from: root as: s
 [| newP |
   newP: path clone.
-  newP names: s.
+  newP names: (s as: path names).
   newP root: root.
   newP
 ].
@@ -156,13 +167,20 @@
   names: path names newEmpty writer.
   this: path root.
   path names do: 
-    [| :each |
-     (path from: this into: names
-            isFound: [| :name :value | name == each]
-            canTraverseInto: [| :obj :name | obj hasDelegateNamed: name])
-        ifNil: [this slotNotFoundNamed: each]
+    [| :each target |
+     (target: (path from: this into: names
+                   isFound: [| :name :value | name == each]
+                   canTraverseInto: 
+		     [| :obj :name | obj hasDelegateNamed: name]))
+       ifNil: [this slotNotFoundNamed: each].
+     this: target
     ].
   names contents as: path
+].
+
+path@(RootedPath traits) printOn: s
+[
+  path printOn: s withRoot: path root
 ].
 
 x@(Root traits) knows: obj

Index: tests/path.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/tests/path.slate,v
retrieving revision 1.1
diff -u -r1.1 path.slate
--- tests/path.slate	8 Sep 2004 17:18:46 -0000	1.1
+++ tests/path.slate	9 Sep 2004 16:00:43 -0000
@@ -25,17 +25,24 @@
   newLobby
 ].
 
-t@(UnitTests Path traits) testAsMethod
+t@(UnitTests Path traits) testPathBase
 [
   { {}. {#a}. {#a. #b} } do:
     [| :s p |
       p: (s as: Path).
-      t assert: (s as: p names) = p names
-	description: s print ; ' as: Path produced ' ; p print
+      t assert: (p isSameAs: Path)
+	description: '(x as: Path) did not produce Path'.
+      t assert: (s as: p) names = p names
+	description: s print ; ' as: Path produced ' ; p print.
+
+      t assert: (s as: Path) = p
+	description: p print ; ' does not equal to self'.
+      t assert: (s as: Path) hash = p hash
+	description: p print ; ' hash varies for the same object'.
     ].
 ].
 
-t@(UnitTests Path traits) testComparisonMethod
+t@(UnitTests Path traits) testPathComparisonMethod
 [
   { 
     { {}. {}. True }.
@@ -150,7 +157,8 @@
     { testLobby. {}. {} }.
     { testLobby. {#prototypes}. {#prototypes} }.
     { testLobby. {#c2}. {#prototypes. #collections. #c2} }.
-    { testLobby. {#collections}. {#prototypes. #collections} }
+    { testLobby. {#collections}. {#prototypes. #collections} }.
+    { testLobby. {#VM. #ByteCode}. {#VM. #ByteCode} }
   } do:
     [| :case p |
       p: (RootedPath from: case first as: case second) expanded.
@@ -167,8 +175,8 @@
   suite tests
     addAll:
       {
-        t newForSelector: #testAsMethod.
-	t newForSelector: #testComparisonMethod.
+        t newForSelector: #testPathBase.
+	t newForSelector: #testPathComparisonMethod.
         t newForSelector: #testPathFromToMethod.
 	t newForSelector: #testTargetFromMethod.
 	t newForSelector: #testRootedPathBase.