tests/path.slate

   1 UnitTests define: #Path &parents: {TestCase}.
   2 "Unit test for Path functionality."
   3
   4 _@(UnitTests Path traits) testLobby
   5 "Create object tree for testing of Path finding.  Answered tree resembles
   6 slate's lobby-rooted tree organization.  We must take care to avoid the
   7 possibility to find path from real lobby to this test-one, otherwise test
   8 results would be very screwed up.  That's why this testLobby graph is created
   9 on-demand and answered instead of pre-creating it in named slot of UnitTests
  10 Path."
  11 [
  12   Namespace clone `>>
  13    [| :newLobby |
  14     ensureNamespace: #prototypes &delegate: True.
  15     prototypes define: #p1 &parents: {Cloneable}.
  16     prototypes define: #p2 &parents: {newLobby p1}.
  17     prototypes ensureNamespace: #collections &delegate: True.
  18     collections define: #c1 &parents: {Cloneable}.
  19     collections define: #c2 &parents: {newLobby c1}.
  20     ensureNamespace: #VM.
  21     VM ensureNamespace: #ByteCode.
  22     VM ByteCode addImmutableSlot: #sendMessage valued: 0.
  23     ensureNamespace: #Types.
  24     Types define: #rules &parents: {Cloneable}.
  25     ]
  26 ].
  27
  28 t@(UnitTests Path traits) testPathBase
  29 [
  30   { {}. {#a}. {#a. #b} } do:
  31     [| :s p |
  32       p: (s as: Path).
  33       t assert: (p isSameAs: Path)
  34         description: '(x as: Path) did not produce Path'.
  35       t assert: (s as: p) names = p names
  36         description: s printString ; ' as: Path produced ' ; p printString.
  37
  38       t assert: (s as: Path) = p
  39         description: p printString ; ' does not equal to self'.
  40       t assert: (s as: Path) hash = p hash
  41         description: p printString ; ' hash varies for the same object'.
  42     ].
  43 ].
  44
  45 t@(UnitTests Path traits) testPathComparisonMethod
  46 [
  47   {
  48     { {}. {}. True }.
  49     { {}. {#a}. False }.
  50     { {#a}. {#b}. False }.
  51     { {#a. #b}. {#a. #b}. True }.
  52     { {#a. #b}. {#a. #b. #c}. False}.
  53   } do:
  54     [| :case p1 p2 |
  55       p1: (case first as: Path).
  56       p2: (case second as: Path).
  57       t assert: (p1 = p2) == case third
  58         description:
  59           p1 printString ; ' = ' ; p2 printString ; ' generated incorrect result'
  60     ]
  61 ].
  62
  63 t@(UnitTests Path traits) testPathFromToMethod
  64 "Tests functionality of the heart of Path library, Path from:to: method."
  65 [| testLobby |
  66   testLobby: t testLobby.
  67   {
  68     { testLobby. testLobby. Nil }.
  69     { testLobby. testLobby prototypes. {#prototypes} }.
  70     { testLobby. testLobby c2. {#prototypes. #collections. #c2} }.
  71     { testLobby. testLobby VM ByteCode sendMessage.
  72       {#VM. #ByteCode. #sendMessage} }.
  73     { testLobby c1. testLobby VM. Nil }.
  74     { testLobby c2. testLobby c1 traits. {#traitsWindow. #traits1} }
  75   } do:
  76       [| :tripple root target names path |
  77         root: tripple first.
  78         target: tripple second.
  79         names: tripple third.
  80         path: (Path from: root to: target).
  81         names isNil ifTrue: [t assert: path isNil]
  82           ifFalse:
  83             [t assert: (path isSameAs: Path) /\
  84                   [path names = (names as: path names)]
  85           description:
  86             'Got path "' ; path names printString ; '" while expected "'
  87               ; names printString ; '".'
  88             ]
  89       ]
  90 ].
  91
  92 t@(UnitTests Path traits) testTargetFromMethod
  93 [| testLobby |
  94   testLobby: t testLobby.
  95   {
  96     { testLobby. {}.  testLobby }.
  97     { testLobby. {#prototypes}. testLobby prototypes }.
  98     { testLobby. {#prototypes. #collections. #c2}. testLobby c2 }.
  99     { testLobby. {#a. #b}. Nil }.
 100     { testLobby c2. {#traitsWindow. #traits1}. testLobby c2 traits1 }
 101   } do:
 102       [| :case target |
 103         target: ((case second as: Path) targetFrom: case first).
 104         t assert: target == case third
 105         description: 'Path "' ; case second printString ; '" from "' ;
 106         case first printString ; '" does not lead where expected ("' ;
 107         target printString ; '" instead)'
 108       ]
 109 ].
 110
 111 t@(UnitTests Path traits) testRootedPathBase
 112 [| testLobby p |
 113   testLobby: t testLobby.
 114   p: (RootedPath from: testLobby to: testLobby c2).
 115   t assert: ((p as: Path) isSameAs: Path)
 116     description: 'RootedPath as: Path is broken.'.
 117   t assert: (p unrooted isSameAs: Path)
 118     description: 'RootedPath unrooted is broken.'.
 119   t assert: (RootedPath from: testLobby to: #a) isNil
 120     description: 'RootedPath from:to: is broken.'.
 121   t assert: ({#collections} as: RootedPath &root: testLobby) =
 122             ({#collections} as: RootedPath &root: testLobby)
 123     description: 'RootedPath comparison is broken.'.
 124   t assert: ({#collections} as: RootedPath &root: testLobby) ~=
 125             ({#collections} as: RootedPath &root: lobby)
 126     description: 'RootedPath comparison is broken (root not considered).'.
 127   t assert: ({#collections} as: RootedPath &root: testLobby) ~=
 128             ({#prototypes} as: RootedPath &root: testLobby)
 129     description: 'RootedPath comparison is broken (path not considered).'
 130 ].
 131
 132 t@(UnitTests Path traits) testRootedPathReduction
 133 [| testLobby p |
 134   testLobby: t testLobby.
 135   {
 136     { testLobby. testLobby c2. {#c2} }.
 137     { testLobby. testLobby VM ByteCode sendMessage.
 138       {#VM. #ByteCode. #sendMessage} }.
 139     { testLobby. testLobby prototypes. {#prototypes} }.
 140     { testLobby. testLobby. {} }
 141   } do:
 142     [| :case p |
 143       p: (RootedPath from: case first to: case second) reduced.
 144       t assert: (p isSameAs: RootedPath)
 145         description: 'RootedPath reduced returns wrong type'.
 146       t assert: p = (case third as: Path)
 147         description: 'RootedPath reduced failed; from "' ; case first printString ;
 148                 '" to "' ; case second printString ; '" got "' ; p printString ;
 149                 '" but expected "' ; case third printString ; '".'
 150     ]
 151 ].
 152
 153 t@(UnitTests Path traits) testRootedPathExpansion
 154 [| testLobby p |
 155   testLobby: t testLobby.
 156   {
 157     { testLobby. {}. {} }.
 158     { testLobby. {#prototypes}. {#prototypes} }.
 159     { testLobby. {#c2}. {#prototypes. #collections. #c2} }.
 160     { testLobby. {#collections}. {#prototypes. #collections} }.
 161     { testLobby. {#VM. #ByteCode}. {#VM. #ByteCode} }
 162   } do:
 163     [| :case p |
 164       p: (case second as: RootedPath &root: case first) expanded.
 165       t assert: (p names = case third) /\ [p root = case first]
 166         description: 'RootedPath expanded failed; from "' ; case second printString ;
 167                 '" expanded to "' ; p names printString ; '" but expected "' ;
 168                 case third printString ; '".'
 169     ].
 170 ].
 171
 172 t@(UnitTests Path traits) suite
 173 [t suiteForSelectors: {
 174   #testPathBase.
 175   #testPathComparisonMethod.
 176   #testPathFromToMethod.
 177   #testTargetFromMethod.
 178   #testRootedPathBase.
 179   #testRootedPathReduction.
 180   #testRootedPathExpansion.
 181 }].