| 1 | ;;+----------------------------------------------------------------------------- |
|---|
| 2 | ;;+ Isidorus |
|---|
| 3 | ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff |
|---|
| 4 | ;;+ |
|---|
| 5 | ;;+ Isidorus is freely distributable under the LLGPL license. |
|---|
| 6 | ;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and |
|---|
| 7 | ;;+ trunk/docs/LGPL-LICENSE.txt. |
|---|
| 8 | ;;+----------------------------------------------------------------------------- |
|---|
| 9 | |
|---|
| 10 | (defpackage :trivial-queries-test |
|---|
| 11 | (:use :cl |
|---|
| 12 | :it.bese.FiveAM |
|---|
| 13 | :datamodel |
|---|
| 14 | :unittests-constants |
|---|
| 15 | :fixtures |
|---|
| 16 | :constants) |
|---|
| 17 | (:export :run-trivial-queries-tests |
|---|
| 18 | :trivial-queries-tests |
|---|
| 19 | :test-aka |
|---|
| 20 | :test-isa |
|---|
| 21 | :test-x-by-value |
|---|
| 22 | :test-x-by-type |
|---|
| 23 | :test-invoke-on |
|---|
| 24 | :test-instance-of |
|---|
| 25 | :test-supertypes |
|---|
| 26 | :test-direct-instance-of |
|---|
| 27 | :test-direct-supertypes |
|---|
| 28 | :test-supertype-associations |
|---|
| 29 | :test-instance-of-associations |
|---|
| 30 | :test-associations-of |
|---|
| 31 | :test-roles-by-type |
|---|
| 32 | :test-roles-by-player |
|---|
| 33 | :test-filter-associations-by-type |
|---|
| 34 | :test-filter-associations-by-role)) |
|---|
| 35 | |
|---|
| 36 | |
|---|
| 37 | (in-package :trivial-queries-test) |
|---|
| 38 | |
|---|
| 39 | |
|---|
| 40 | (def-suite trivial-queries-tests |
|---|
| 41 | :description "tests various key functions of the trivial-query-test of |
|---|
| 42 | the datamodel module") |
|---|
| 43 | |
|---|
| 44 | (in-suite trivial-queries-tests) |
|---|
| 45 | |
|---|
| 46 | (test test-aka |
|---|
| 47 | "Tests the function aka." |
|---|
| 48 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 49 | (with-revision 0 |
|---|
| 50 | (let ((region (get-item-by-id "region")) |
|---|
| 51 | (city (get-item-by-id "city")) |
|---|
| 52 | (poem (get-item-by-id "poem")) |
|---|
| 53 | (supertype (get-item-by-psi *supertype-psi*)) |
|---|
| 54 | (subtype (get-item-by-psi *subtype-psi*)) |
|---|
| 55 | (supertype-subtype (get-item-by-psi *supertype-subtype-psi*)) |
|---|
| 56 | (rev (get-revision))) |
|---|
| 57 | (is-true region) |
|---|
| 58 | (is-true city) |
|---|
| 59 | (is-true poem) |
|---|
| 60 | (is-true supertype) |
|---|
| 61 | (is-true subtype) |
|---|
| 62 | (is-true supertype-subtype) |
|---|
| 63 | (is-true (aka city region)) |
|---|
| 64 | (is-false (aka city city)) |
|---|
| 65 | (make-construct 'AssociationC |
|---|
| 66 | :start-revision rev |
|---|
| 67 | :instance-of supertype-subtype |
|---|
| 68 | :roles (list (list :start-revision rev |
|---|
| 69 | :player region |
|---|
| 70 | :instance-of subtype) |
|---|
| 71 | (list :start-revision rev |
|---|
| 72 | :player poem |
|---|
| 73 | :instance-of supertype))) |
|---|
| 74 | (is-true (aka city region)) |
|---|
| 75 | (is-true (aka city poem)) |
|---|
| 76 | (is-true (aka region poem)))))) |
|---|
| 77 | |
|---|
| 78 | |
|---|
| 79 | (test test-isa |
|---|
| 80 | "Tests the function isa." |
|---|
| 81 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 82 | (with-revision 0 |
|---|
| 83 | (let ((region (get-item-by-id "region")) |
|---|
| 84 | (metropolis (get-item-by-id "metropolis")) |
|---|
| 85 | (poem (get-item-by-id "poem")) |
|---|
| 86 | (frankfurt (get-item-by-id "frankfurt_am_main"))) |
|---|
| 87 | (is-true region) |
|---|
| 88 | (is-true frankfurt) |
|---|
| 89 | (is-true metropolis) |
|---|
| 90 | (is-true poem) |
|---|
| 91 | (is-true (isa frankfurt metropolis)) |
|---|
| 92 | (is-true (isa frankfurt region)))))) |
|---|
| 93 | |
|---|
| 94 | |
|---|
| 95 | (test test-x-by-value |
|---|
| 96 | "Tests the functions names-by-value, occurrences-by-value |
|---|
| 97 | and characteristics-by-value." |
|---|
| 98 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 99 | (with-revision 0 |
|---|
| 100 | (let ((goethe (get-item-by-id "goethe")) |
|---|
| 101 | (poem (get-item-by-id "poem")) |
|---|
| 102 | (fn "Johann Wolfgang") |
|---|
| 103 | (ln "von Goethe") |
|---|
| 104 | (ai "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe") |
|---|
| 105 | (as "any string")) |
|---|
| 106 | (let ((fun-fn (lambda(value) |
|---|
| 107 | (string= value fn))) |
|---|
| 108 | (fun-ln (lambda(value) |
|---|
| 109 | (string= value ln))) |
|---|
| 110 | (fun-ai (lambda(value) |
|---|
| 111 | (string= value ai))) |
|---|
| 112 | (fun-as (lambda(value) |
|---|
| 113 | (string= value as)))) |
|---|
| 114 | (is-true goethe) |
|---|
| 115 | (is-true poem) |
|---|
| 116 | (is-false (names-by-value goethe fun-as)) |
|---|
| 117 | (is-false (occurrences-by-value goethe fun-as)) |
|---|
| 118 | (is-false (characteristics-by-value goethe fun-as)) |
|---|
| 119 | (is (= (length (names-by-value goethe fun-fn)) 1)) |
|---|
| 120 | (is (= (length (names-by-value goethe fun-ln)) 1)) |
|---|
| 121 | (is (= (length (occurrences-by-value goethe fun-ai)) 1)) |
|---|
| 122 | (is (string= (charvalue (first (names-by-value goethe fun-fn))) |
|---|
| 123 | fn)) |
|---|
| 124 | (is (string= (charvalue (first (names-by-value goethe fun-ln))) |
|---|
| 125 | ln)) |
|---|
| 126 | (is (string= (charvalue (first (occurrences-by-value goethe fun-ai))) |
|---|
| 127 | ai)) |
|---|
| 128 | (is (= (length (characteristics-by-value goethe fun-fn)) 1)) |
|---|
| 129 | (is (string= |
|---|
| 130 | (charvalue (first (characteristics-by-value goethe fun-fn))) |
|---|
| 131 | fn))))))) |
|---|
| 132 | |
|---|
| 133 | |
|---|
| 134 | (test test-x-by-type |
|---|
| 135 | "Tests the functions names-by-type, occurrences-by-type |
|---|
| 136 | and characteristics-by-type." |
|---|
| 137 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 138 | (with-revision 0 |
|---|
| 139 | (let ((goethe (get-item-by-id "goethe")) |
|---|
| 140 | (first-name (get-item-by-id "first-name")) |
|---|
| 141 | (last-name (get-item-by-id "last-name")) |
|---|
| 142 | (author-info (get-item-by-id "author-info")) |
|---|
| 143 | (poem (get-item-by-id "poem"))) |
|---|
| 144 | (is-true goethe) |
|---|
| 145 | (is-true first-name) |
|---|
| 146 | (is-true last-name) |
|---|
| 147 | (is-true author-info) |
|---|
| 148 | (is-true poem) |
|---|
| 149 | (is-false (names-by-type goethe poem)) |
|---|
| 150 | (is-false (occurrences-by-type goethe poem)) |
|---|
| 151 | (is-false (characteristics-by-type goethe poem)) |
|---|
| 152 | (is (= (length (names-by-type goethe first-name)) 1)) |
|---|
| 153 | (is (= (length (names-by-type goethe last-name)) 1)) |
|---|
| 154 | (is (= (length (occurrences-by-type goethe author-info)) 1)) |
|---|
| 155 | (is (string= (charvalue (first (names-by-type goethe first-name))) |
|---|
| 156 | "Johann Wolfgang")) |
|---|
| 157 | (is (string= (charvalue (first (names-by-type goethe last-name))) |
|---|
| 158 | "von Goethe")) |
|---|
| 159 | (is (string= |
|---|
| 160 | (charvalue (first (occurrences-by-type goethe author-info))) |
|---|
| 161 | "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe")) |
|---|
| 162 | (is (= (length (characteristics-by-type goethe first-name)) 1)) |
|---|
| 163 | (is (string= |
|---|
| 164 | (charvalue (first (characteristics-by-type goethe first-name))) |
|---|
| 165 | "Johann Wolfgang")))))) |
|---|
| 166 | |
|---|
| 167 | |
|---|
| 168 | (test test-invoke-on |
|---|
| 169 | "Tests the function invoke-on." |
|---|
| 170 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 171 | (with-revision 0 |
|---|
| 172 | (let ((frankfurt (get-item-by-id "frankfurt_am_main"))) |
|---|
| 173 | (is-true frankfurt) |
|---|
| 174 | (is (= (length (occurrences frankfurt)) 1)) |
|---|
| 175 | (is (= (invoke-on (first (occurrences frankfurt)) |
|---|
| 176 | #'(lambda(value) |
|---|
| 177 | (+ 1 (parse-integer value)))) |
|---|
| 178 | (+ 1 659021))))))) |
|---|
| 179 | |
|---|
| 180 | |
|---|
| 181 | |
|---|
| 182 | (test test-instance-of |
|---|
| 183 | "Tests the function instance-of." |
|---|
| 184 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 185 | (with-revision 0 |
|---|
| 186 | (let ((region (get-item-by-id "region")) |
|---|
| 187 | (metropolis (get-item-by-id "metropolis")) |
|---|
| 188 | (poem (get-item-by-id "poem")) |
|---|
| 189 | (frankfurt (get-item-by-id "frankfurt_am_main"))) |
|---|
| 190 | (is-true region) |
|---|
| 191 | (is-true frankfurt) |
|---|
| 192 | (is-true metropolis) |
|---|
| 193 | (is-true poem) |
|---|
| 194 | (is (= (length (instance-of frankfurt)) 2)) |
|---|
| 195 | (is-false (set-exclusive-or (instance-of frankfurt) |
|---|
| 196 | (list metropolis region))))))) |
|---|
| 197 | |
|---|
| 198 | |
|---|
| 199 | (test test-supertypes |
|---|
| 200 | "Tests the function supertypes." |
|---|
| 201 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 202 | (with-revision 0 |
|---|
| 203 | (let ((region (get-item-by-id "region")) |
|---|
| 204 | (city (get-item-by-id "city")) |
|---|
| 205 | (poem (get-item-by-id "poem")) |
|---|
| 206 | (supertype (get-item-by-psi *supertype-psi*)) |
|---|
| 207 | (subtype (get-item-by-psi *subtype-psi*)) |
|---|
| 208 | (supertype-subtype (get-item-by-psi *supertype-subtype-psi*)) |
|---|
| 209 | (rev (get-revision))) |
|---|
| 210 | (is-true region) |
|---|
| 211 | (is-true city) |
|---|
| 212 | (is-true poem) |
|---|
| 213 | (is-true supertype) |
|---|
| 214 | (is-true subtype) |
|---|
| 215 | (is-true supertype-subtype) |
|---|
| 216 | (is (= (length (supertypes city)) 1)) |
|---|
| 217 | (is (eql (first (supertypes city)) region)) |
|---|
| 218 | (is-false (supertypes region)) |
|---|
| 219 | (make-construct 'AssociationC |
|---|
| 220 | :start-revision rev |
|---|
| 221 | :instance-of supertype-subtype |
|---|
| 222 | :roles (list (list :start-revision rev |
|---|
| 223 | :player region |
|---|
| 224 | :instance-of subtype) |
|---|
| 225 | (list :start-revision rev |
|---|
| 226 | :player poem |
|---|
| 227 | :instance-of supertype))) |
|---|
| 228 | (is (= (length (supertypes city)) 2)))))) |
|---|
| 229 | |
|---|
| 230 | |
|---|
| 231 | (test test-direct-instance-of |
|---|
| 232 | "Tests the function direct-instance-of." |
|---|
| 233 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 234 | (with-revision 0 |
|---|
| 235 | (let ((region (get-item-by-id "region")) |
|---|
| 236 | (frankfurt (get-item-by-id "frankfurt_am_main")) |
|---|
| 237 | (metropolis (get-item-by-id "metropolis"))) |
|---|
| 238 | (is-true region) |
|---|
| 239 | (is-true metropolis) |
|---|
| 240 | (is-true frankfurt) |
|---|
| 241 | (is (= (length (direct-instance-of frankfurt)) 1)) |
|---|
| 242 | (is (eql (first (direct-instance-of frankfurt)) metropolis)) |
|---|
| 243 | (is-false (direct-instance-of metropolis)))))) |
|---|
| 244 | |
|---|
| 245 | |
|---|
| 246 | (test test-direct-supertypes |
|---|
| 247 | "Tests the function direct-supertypes." |
|---|
| 248 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 249 | (with-revision 0 |
|---|
| 250 | (let ((region (get-item-by-id "region")) |
|---|
| 251 | (city (get-item-by-id "city")) |
|---|
| 252 | (poem (get-item-by-id "poem")) |
|---|
| 253 | (supertype (get-item-by-psi *supertype-psi*)) |
|---|
| 254 | (subtype (get-item-by-psi *subtype-psi*)) |
|---|
| 255 | (supertype-subtype (get-item-by-psi *supertype-subtype-psi*)) |
|---|
| 256 | (rev (get-revision))) |
|---|
| 257 | (is-true region) |
|---|
| 258 | (is-true city) |
|---|
| 259 | (is-true poem) |
|---|
| 260 | (is-true supertype) |
|---|
| 261 | (is-true subtype) |
|---|
| 262 | (is-true supertype-subtype) |
|---|
| 263 | (is (= (length (direct-supertypes city)) 1)) |
|---|
| 264 | (is (eql (first (direct-supertypes city)) region)) |
|---|
| 265 | (is-false (direct-supertypes region)) |
|---|
| 266 | (make-construct 'AssociationC |
|---|
| 267 | :start-revision rev |
|---|
| 268 | :instance-of supertype-subtype |
|---|
| 269 | :roles (list (list :start-revision rev |
|---|
| 270 | :player region |
|---|
| 271 | :instance-of subtype) |
|---|
| 272 | (list :start-revision rev |
|---|
| 273 | :player poem |
|---|
| 274 | :instance-of supertype))) |
|---|
| 275 | (is (= (length (direct-supertypes city)) 1)))))) |
|---|
| 276 | |
|---|
| 277 | |
|---|
| 278 | (test test-supertype-associations |
|---|
| 279 | "Tests the function supertype-associations." |
|---|
| 280 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 281 | (with-revision 0 |
|---|
| 282 | (let ((region (get-item-by-id "region")) |
|---|
| 283 | (city (get-item-by-id "city")) |
|---|
| 284 | (metropolis (get-item-by-id "metropolis")) |
|---|
| 285 | (assocs (get-all-associations)) |
|---|
| 286 | (supertype (get-item-by-psi *supertype-psi*)) |
|---|
| 287 | (subtype (get-item-by-psi *subtype-psi*)) |
|---|
| 288 | (supertype-subtype (get-item-by-psi *supertype-subtype-psi*))) |
|---|
| 289 | (is-true region) |
|---|
| 290 | (is-true city) |
|---|
| 291 | (is-true metropolis) |
|---|
| 292 | (is-true supertype) |
|---|
| 293 | (is-true subtype) |
|---|
| 294 | (is-true supertype-subtype) |
|---|
| 295 | (let ((assoc-city |
|---|
| 296 | (find-if |
|---|
| 297 | #'(lambda(assoc) |
|---|
| 298 | (and (eql (instance-of assoc) supertype-subtype) |
|---|
| 299 | (find-if #'(lambda(role) |
|---|
| 300 | (and (eql (player role) city) |
|---|
| 301 | (eql (instance-of role) subtype))) |
|---|
| 302 | (roles assoc)) |
|---|
| 303 | (find-if #'(lambda(role) |
|---|
| 304 | (and (eql (player role) region) |
|---|
| 305 | (eql (instance-of role) supertype))) |
|---|
| 306 | (roles assoc)))) |
|---|
| 307 | assocs)) |
|---|
| 308 | (assoc-metropolis |
|---|
| 309 | (find-if |
|---|
| 310 | #'(lambda(assoc) |
|---|
| 311 | (and (eql (instance-of assoc) supertype-subtype) |
|---|
| 312 | (find-if #'(lambda(role) |
|---|
| 313 | (and (eql (player role) metropolis) |
|---|
| 314 | (eql (instance-of role) subtype))) |
|---|
| 315 | (roles assoc)) |
|---|
| 316 | (find-if #'(lambda(role) |
|---|
| 317 | (and (eql (player role) region) |
|---|
| 318 | (eql (instance-of role) supertype))) |
|---|
| 319 | (roles assoc)))) |
|---|
| 320 | assocs))) |
|---|
| 321 | (is-true assoc-city) |
|---|
| 322 | (is-true assoc-metropolis) |
|---|
| 323 | (is (= (length (supertype-associations city)) 1)) |
|---|
| 324 | (is (= (length (supertype-associations metropolis)) 1)) |
|---|
| 325 | (is (eql (first (supertype-associations city)) assoc-city)) |
|---|
| 326 | (is (eql (first (supertype-associations metropolis)) assoc-metropolis)) |
|---|
| 327 | (is-false (supertype-associations region))))))) |
|---|
| 328 | |
|---|
| 329 | |
|---|
| 330 | (test test-instance-of-associations |
|---|
| 331 | "Tests the function instance-of-associations." |
|---|
| 332 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 333 | (with-revision 0 |
|---|
| 334 | (let ((goethe (get-item-by-id "goethe")) |
|---|
| 335 | (instance (get-item-by-psi *instance-psi*)) |
|---|
| 336 | (type (get-item-by-psi *type-psi*)) |
|---|
| 337 | (type-instance (get-item-by-psi *type-instance-psi*)) |
|---|
| 338 | (author (get-item-by-id "author"))) |
|---|
| 339 | (is-true goethe) |
|---|
| 340 | (is-true instance) |
|---|
| 341 | (is-true type) |
|---|
| 342 | (is-true type-instance) |
|---|
| 343 | (is-true author) |
|---|
| 344 | (is (= (length (instance-of-associations goethe)) 1)) |
|---|
| 345 | (is (eql type-instance |
|---|
| 346 | (instance-of (first (instance-of-associations goethe))))) |
|---|
| 347 | (is-true (filter-associations-by-role (instance-of-associations goethe) |
|---|
| 348 | instance goethe)) |
|---|
| 349 | (is-true (filter-associations-by-role (instance-of-associations goethe) |
|---|
| 350 | type author)) |
|---|
| 351 | (is-true (filter-associations-by-type (instance-of-associations goethe) |
|---|
| 352 | type-instance)))))) |
|---|
| 353 | |
|---|
| 354 | |
|---|
| 355 | (test test-associations-of |
|---|
| 356 | "Tests the function associations-of." |
|---|
| 357 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 358 | (with-revision 0 |
|---|
| 359 | (let ((goethe (get-item-by-id "goethe")) |
|---|
| 360 | (writer (get-item-by-id "writer")) |
|---|
| 361 | (written-by (get-item-by-id "written-by")) |
|---|
| 362 | (written (get-item-by-id "written")) |
|---|
| 363 | (erlkoenig (get-item-by-id "erlkoenig")) |
|---|
| 364 | (instance (get-item-by-psi *instance-psi*)) |
|---|
| 365 | (poem (get-item-by-id "poem"))) |
|---|
| 366 | (is-true goethe) |
|---|
| 367 | (is-true writer) |
|---|
| 368 | (is-true written-by) |
|---|
| 369 | (is-true written) |
|---|
| 370 | (is-true erlkoenig) |
|---|
| 371 | (is-true instance) |
|---|
| 372 | (is-true poem) |
|---|
| 373 | (is (= (length (associations-of goethe nil nil nil nil)) 4)) |
|---|
| 374 | (is (= (length (associations-of goethe writer nil nil nil)) 3)) |
|---|
| 375 | (is (= (length (associations-of goethe writer written-by nil nil)) 2)) |
|---|
| 376 | (is (= (length (associations-of goethe writer written-by written nil)) 2)) |
|---|
| 377 | (is (= (length (associations-of goethe writer written-by written erlkoenig)) 1)) |
|---|
| 378 | (is-false (associations-of goethe writer written-by written instance)) |
|---|
| 379 | (is-false (associations-of goethe writer written-by instance erlkoenig)) |
|---|
| 380 | (is (= (length (associations-of goethe instance nil nil nil)) 1)) |
|---|
| 381 | (is-false (associations-of goethe writer written-by written erlkoenig |
|---|
| 382 | :other-role-player-is-type t)) |
|---|
| 383 | (is (= (length (associations-of goethe writer written-by written poem |
|---|
| 384 | :other-role-player-is-type t)) 2)))))) |
|---|
| 385 | |
|---|
| 386 | |
|---|
| 387 | (test test-roles-by-type |
|---|
| 388 | "Tests the function roles-by-type bound to TopicC and AssociationC." |
|---|
| 389 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 390 | (with-revision 0 |
|---|
| 391 | (let ((goethe (get-item-by-id "goethe")) |
|---|
| 392 | (writer (get-item-by-id "writer")) |
|---|
| 393 | (written (get-item-by-id "written")) |
|---|
| 394 | (instance (get-item-by-psi *instance-psi*)) |
|---|
| 395 | (assoc (get-item-by-item-identifier "written-by-erlkoenig-goethe"))) |
|---|
| 396 | (is-true goethe) |
|---|
| 397 | (is-true writer) |
|---|
| 398 | (is-true written) |
|---|
| 399 | (is-true instance) |
|---|
| 400 | (is-true assoc) |
|---|
| 401 | (is (= (length (roles-by-type goethe writer)) 3)) |
|---|
| 402 | (is (= (length (roles-by-type goethe nil)) 4)) |
|---|
| 403 | (is (= (length (roles-by-type goethe instance)) 1)) |
|---|
| 404 | (is-false (roles-by-type goethe written)) |
|---|
| 405 | (is (= (length (roles-by-type assoc writer)) 1)) |
|---|
| 406 | (is (eql writer (instance-of (first (roles-by-type assoc writer))))) |
|---|
| 407 | (is (= (length (roles-by-type assoc nil)) 2)))))) |
|---|
| 408 | |
|---|
| 409 | |
|---|
| 410 | (test test-roles-by-player |
|---|
| 411 | "Tests the function roles-by-player." |
|---|
| 412 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 413 | (with-revision 0 |
|---|
| 414 | (let ((goethe (get-item-by-id "goethe")) |
|---|
| 415 | (writer (get-item-by-id "writer")) |
|---|
| 416 | (written (get-item-by-id "written")) |
|---|
| 417 | (instance (get-item-by-psi *instance-psi*)) |
|---|
| 418 | (assoc (get-item-by-item-identifier "written-by-erlkoenig-goethe")) |
|---|
| 419 | (author (get-item-by-id "author"))) |
|---|
| 420 | (is-true goethe) |
|---|
| 421 | (is-true author) |
|---|
| 422 | (is-true writer) |
|---|
| 423 | (is-true written) |
|---|
| 424 | (is-true instance) |
|---|
| 425 | (is-true assoc) |
|---|
| 426 | (is (= (length (roles-by-player assoc goethe)) 1)) |
|---|
| 427 | (is (eql goethe (player (first (roles-by-player assoc goethe))))) |
|---|
| 428 | (is (= (length (roles-by-player assoc written)) 0)) |
|---|
| 429 | (is (= (length (roles-by-player assoc nil)) 2)) |
|---|
| 430 | (is (= (length (roles-by-player assoc author :role-player-is-type t)) |
|---|
| 431 | 1)) |
|---|
| 432 | (is-false (roles-by-player assoc goethe :role-player-is-type t)) |
|---|
| 433 | (is (eql goethe (player (first (roles-by-player |
|---|
| 434 | assoc author |
|---|
| 435 | :role-player-is-type t))))))))) |
|---|
| 436 | |
|---|
| 437 | |
|---|
| 438 | (test test-filter-associations-by-type |
|---|
| 439 | "Tests the function roles-by-player." |
|---|
| 440 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 441 | (with-revision 0 |
|---|
| 442 | (let ((written-by (get-item-by-id "written-by")) |
|---|
| 443 | (born-in (get-item-by-id "born-in")) |
|---|
| 444 | (assocs (get-all-associations))) |
|---|
| 445 | (is-true written-by) |
|---|
| 446 | (is-true assocs) |
|---|
| 447 | (is-true born-in) |
|---|
| 448 | (is (= (length (filter-associations-by-type assocs written-by)) 4)) |
|---|
| 449 | (is (> (length (filter-associations-by-type assocs nil)) (+ 4 2))) |
|---|
| 450 | (is (= (length (filter-associations-by-type assocs born-in)) 2)))))) |
|---|
| 451 | |
|---|
| 452 | |
|---|
| 453 | (test test-filter-associations-by-role |
|---|
| 454 | "Tests the function roles-by-player." |
|---|
| 455 | (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) |
|---|
| 456 | (with-revision 0 |
|---|
| 457 | (let ((written-by (get-item-by-id "written-by")) |
|---|
| 458 | (born-in (get-item-by-id "born-in")) |
|---|
| 459 | (written (get-item-by-id "written")) |
|---|
| 460 | (writer (get-item-by-id "writer")) |
|---|
| 461 | (place (get-item-by-id "place")) |
|---|
| 462 | (goethe (get-item-by-id "goethe")) |
|---|
| 463 | (frankfurt (get-item-by-id "frankfurt_am_main")) |
|---|
| 464 | (assocs (get-all-associations)) |
|---|
| 465 | (author (get-item-by-id "author"))) |
|---|
| 466 | (is-true written-by) |
|---|
| 467 | (is-true assocs) |
|---|
| 468 | (is-true born-in) |
|---|
| 469 | (is-true author) |
|---|
| 470 | (is-true written) |
|---|
| 471 | (is-true writer) |
|---|
| 472 | (is-true place) |
|---|
| 473 | (is-true frankfurt) |
|---|
| 474 | (is (= (length (filter-associations-by-role assocs place frankfurt)) 1)) |
|---|
| 475 | (is (= (length (filter-associations-by-role assocs written nil)) 4)) |
|---|
| 476 | (is (= (length (filter-associations-by-role assocs written goethe)) 2)) |
|---|
| 477 | (is (= (length (filter-associations-by-role assocs writer nil)) 6)) |
|---|
| 478 | (is (= (length (filter-associations-by-role assocs nil goethe)) 4)) |
|---|
| 479 | (is (> (length (filter-associations-by-role assocs nil nil)) (+ 4 3))) |
|---|
| 480 | (is-false (filter-associations-by-role assocs writer goethe |
|---|
| 481 | :role-player-is-type t)) |
|---|
| 482 | (is (= (length (filter-associations-by-role assocs writer author |
|---|
| 483 | :role-player-is-type t)) |
|---|
| 484 | 6)))))) |
|---|
| 485 | |
|---|
| 486 | |
|---|
| 487 | |
|---|
| 488 | |
|---|
| 489 | |
|---|
| 490 | (defun run-trivial-queries-tests () |
|---|
| 491 | (it.bese.fiveam:run! 'trivial-queries-test:trivial-queries-tests)) |
|---|
