| 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 :rdf-importer-test |
|---|
| 11 | (:use |
|---|
| 12 | :common-lisp |
|---|
| 13 | :xtm-importer |
|---|
| 14 | :datamodel |
|---|
| 15 | :base-tools |
|---|
| 16 | :it.bese.FiveAM |
|---|
| 17 | :fixtures) |
|---|
| 18 | (:import-from :constants |
|---|
| 19 | *rdf-ns* |
|---|
| 20 | *rdfs-ns* |
|---|
| 21 | *rdf2tm-ns* |
|---|
| 22 | *tm2rdf-ns* |
|---|
| 23 | *xml-ns* |
|---|
| 24 | *xml-string* |
|---|
| 25 | *instance-psi* |
|---|
| 26 | *type-psi* |
|---|
| 27 | *type-instance-psi* |
|---|
| 28 | *subtype-psi* |
|---|
| 29 | *supertype-psi* |
|---|
| 30 | *supertype-subtype-psi* |
|---|
| 31 | *xml-string* |
|---|
| 32 | *rdf2tm-object* |
|---|
| 33 | *rdf2tm-subject* |
|---|
| 34 | *rdf-subject* |
|---|
| 35 | *rdf-object* |
|---|
| 36 | *rdf-predicate* |
|---|
| 37 | *rdf-statement* |
|---|
| 38 | *tm2rdf-topic-type-uri* |
|---|
| 39 | *tm2rdf-name-type-uri* |
|---|
| 40 | *tm2rdf-variant-type-uri* |
|---|
| 41 | *tm2rdf-occurrence-type-uri* |
|---|
| 42 | *tm2rdf-role-type-uri* |
|---|
| 43 | *tm2rdf-association-type-uri*) |
|---|
| 44 | (:import-from :xml-tools |
|---|
| 45 | xpath-child-elems-by-qname |
|---|
| 46 | xpath-single-child-elem-by-qname |
|---|
| 47 | xpath-select-location-path |
|---|
| 48 | get-ns-attribute |
|---|
| 49 | absolute-uri-p) |
|---|
| 50 | (:export :rdf-importer-test |
|---|
| 51 | :test-get-literals-of-node |
|---|
| 52 | :test-parse-node |
|---|
| 53 | :run-rdf-importer-tests |
|---|
| 54 | :test-get-literals-of-property |
|---|
| 55 | :test-parse-property |
|---|
| 56 | :test-get-types |
|---|
| 57 | :test-get-literals-of-content |
|---|
| 58 | :test-get-super-classes-of-node-content |
|---|
| 59 | :test-get-associations-of-node-content |
|---|
| 60 | :test-parse-properties-of-node |
|---|
| 61 | :test-import-node-1 |
|---|
| 62 | :test-import-dom |
|---|
| 63 | :test-poems-rdf-occurrences |
|---|
| 64 | :test-poems-rdf-associations |
|---|
| 65 | :test-poems-rdf-typing |
|---|
| 66 | :test-poems-rdf-topics |
|---|
| 67 | :test-empty-collection |
|---|
| 68 | :test-collection |
|---|
| 69 | :test-xml-base |
|---|
| 70 | :test-full-mapping-marge |
|---|
| 71 | :test-full-mapping-homer |
|---|
| 72 | :test-full-mapping-association)) |
|---|
| 73 | |
|---|
| 74 | (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) |
|---|
| 75 | |
|---|
| 76 | (in-package :rdf-importer-test) |
|---|
| 77 | |
|---|
| 78 | |
|---|
| 79 | (def-suite rdf-importer-test |
|---|
| 80 | :description "tests various key functions of the importer") |
|---|
| 81 | |
|---|
| 82 | (in-suite rdf-importer-test) |
|---|
| 83 | |
|---|
| 84 | |
|---|
| 85 | (defun empty-p (top) |
|---|
| 86 | (declare (TopicC top)) |
|---|
| 87 | (and (not (d:item-identifiers top)) |
|---|
| 88 | (not (d:locators top)) |
|---|
| 89 | (not (d:names top)) |
|---|
| 90 | (not (d:occurrences top)))) |
|---|
| 91 | |
|---|
| 92 | |
|---|
| 93 | (test test-get-literals-of-node |
|---|
| 94 | "Tests the helper function get-literals-of-node." |
|---|
| 95 | (let ((doc-1 |
|---|
| 96 | (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 97 | "xmlns:isi=\"http://isidorus/test#\" " |
|---|
| 98 | "rdf:type=\"rdfType\" rdf:ID=\"rdfID\" rdf:nodeID=\"" |
|---|
| 99 | "rdfNodeID\" rdf:unknown=\"rdfUnknown\" " |
|---|
| 100 | "isi:ID=\"isiID\" isi:arc=\"isiArc\" " |
|---|
| 101 | "isi:empty=\"\"/>"))) |
|---|
| 102 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 103 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 104 | (let ((literals (rdf-importer::get-literals-of-node |
|---|
| 105 | (elt (dom:child-nodes dom-1) 0) nil))) |
|---|
| 106 | (is-true literals) |
|---|
| 107 | (is (= (length literals) 4)) |
|---|
| 108 | (is-true (find-if #'(lambda(x) |
|---|
| 109 | (and |
|---|
| 110 | (string= (getf x :value) "rdfUnknown") |
|---|
| 111 | (string= (getf x :type) |
|---|
| 112 | (concat *rdf-ns* "unknown")) |
|---|
| 113 | (not (getf x :ID)))) |
|---|
| 114 | literals)) |
|---|
| 115 | (is-true (find-if #'(lambda(x) |
|---|
| 116 | (and |
|---|
| 117 | (string= (getf x :value) "isiID") |
|---|
| 118 | (string= (getf x :type) |
|---|
| 119 | "http://isidorus/test#ID") |
|---|
| 120 | (not (getf x :ID)))) |
|---|
| 121 | literals)) |
|---|
| 122 | (is-true (find-if #'(lambda(x) |
|---|
| 123 | (and |
|---|
| 124 | (string= (getf x :value) "isiArc") |
|---|
| 125 | (string= (getf x :type) |
|---|
| 126 | "http://isidorus/test#arc") |
|---|
| 127 | (not (getf x :ID)))) |
|---|
| 128 | literals)) |
|---|
| 129 | (is-true (find-if #'(lambda(x) |
|---|
| 130 | (and |
|---|
| 131 | (string= (getf x :value) "") |
|---|
| 132 | (string= (getf x :type) |
|---|
| 133 | "http://isidorus/test#empty") |
|---|
| 134 | (not (getf x :ID)))) |
|---|
| 135 | literals)) |
|---|
| 136 | (map 'list #'(lambda(x) (is-false (getf x :lang))) |
|---|
| 137 | literals))) |
|---|
| 138 | |
|---|
| 139 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 140 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 141 | (dom:set-attribute-ns (elt (dom:child-nodes dom-1) 0) |
|---|
| 142 | *xml-ns* "lang" "de") |
|---|
| 143 | (let ((literals (rdf-importer::get-literals-of-node |
|---|
| 144 | (elt (dom:child-nodes dom-1) 0) "en"))) |
|---|
| 145 | (is-true literals) |
|---|
| 146 | (is (= (length literals) 4)) |
|---|
| 147 | (is-true (find-if #'(lambda(x) |
|---|
| 148 | (and |
|---|
| 149 | (string= (getf x :value) "rdfUnknown") |
|---|
| 150 | (string= (getf x :type) |
|---|
| 151 | (concat *rdf-ns* "unknown")) |
|---|
| 152 | (not (getf x :ID)))) |
|---|
| 153 | literals)) |
|---|
| 154 | (is-true (find-if #'(lambda(x) |
|---|
| 155 | (and |
|---|
| 156 | (string= (getf x :value) "isiID") |
|---|
| 157 | (string= (getf x :type) |
|---|
| 158 | "http://isidorus/test#ID") |
|---|
| 159 | (not (getf x :ID)))) |
|---|
| 160 | literals)) |
|---|
| 161 | (is-true (find-if #'(lambda(x) |
|---|
| 162 | (and |
|---|
| 163 | (string= (getf x :value) "isiArc") |
|---|
| 164 | (string= (getf x :type) |
|---|
| 165 | "http://isidorus/test#arc") |
|---|
| 166 | (not (getf x :ID)))) |
|---|
| 167 | literals)) |
|---|
| 168 | (is-true (find-if #'(lambda(x) |
|---|
| 169 | (and |
|---|
| 170 | (string= (getf x :value) "") |
|---|
| 171 | (string= (getf x :type) |
|---|
| 172 | "http://isidorus/test#empty") |
|---|
| 173 | (not (getf x :ID)))) |
|---|
| 174 | literals)) |
|---|
| 175 | (map 'list #'(lambda(x) (is-true (string= (getf x :lang) "de"))) |
|---|
| 176 | literals))))) |
|---|
| 177 | |
|---|
| 178 | |
|---|
| 179 | (test test-parse-node |
|---|
| 180 | "Tests the parse-node function." |
|---|
| 181 | (let ((doc-1 |
|---|
| 182 | (concat "<rdf:UnknownType xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 183 | "xmlns:isi=\"" *rdf2tm-ns* "\" " |
|---|
| 184 | "xmlns:arcs=\"http://test/arcs/\" " |
|---|
| 185 | "rdf:ID=\"rdfID\" xml:base=\"xmlBase\" " |
|---|
| 186 | "arcs:arc=\"arcsArc\">" |
|---|
| 187 | "<arcs:rel>" |
|---|
| 188 | "<rdf:Description rdf:about=\"element\"/>" |
|---|
| 189 | "</arcs:rel>" |
|---|
| 190 | "</rdf:UnknownType>"))) |
|---|
| 191 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 192 | (is (length (dom:child-nodes dom-1)) 1) |
|---|
| 193 | (let ((node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 194 | (is-true (rdf-importer::parse-node node)) |
|---|
| 195 | (is-false (get-ns-attribute node "UUID" :ns-uri *rdf2tm-ns*)) |
|---|
| 196 | (dom:set-attribute-ns node *rdf-ns* "about" "rdfAbout") |
|---|
| 197 | (signals error (rdf-importer::parse-node node)) |
|---|
| 198 | (dom:set-attribute-ns node *rdf-ns* "nodeID" "rdfNodeID") |
|---|
| 199 | (signals error (rdf-importer::parse-node node)) |
|---|
| 200 | (dom:remove-attribute-ns node *rdf-ns* "about") |
|---|
| 201 | (signals error (rdf-importer::parse-node node)) |
|---|
| 202 | (dom:remove-attribute-ns node *rdf-ns* "ID") |
|---|
| 203 | (is-true (rdf-importer::parse-node node)) |
|---|
| 204 | (dom:set-attribute-ns node *rdf-ns* "about" "rdfAbout") |
|---|
| 205 | (signals error (rdf-importer::parse-node node)) |
|---|
| 206 | (is-false (get-ns-attribute node "UUID" :ns-uri *rdf2tm-ns*)) |
|---|
| 207 | (dom:remove-attribute-ns node *rdf-ns* "about") |
|---|
| 208 | (dom:remove-attribute-ns node *rdf-ns* "nodeID") |
|---|
| 209 | (is-true (rdf-importer::parse-node node)) |
|---|
| 210 | (is-true (get-ns-attribute node "UUID" :ns-uri *rdf2tm-ns*)) |
|---|
| 211 | (dom:set-attribute-ns node *rdf-ns* "resource" "rdfResource") |
|---|
| 212 | (signals error (rdf-importer::parse-node node)) |
|---|
| 213 | (dom:set-attribute-ns node *rdf-ns* "resource" "") |
|---|
| 214 | (is-true (rdf-importer::parse-node node)) |
|---|
| 215 | (dom:replace-child node (dom:create-text-node dom-1 "anyText") |
|---|
| 216 | (xpath-single-child-elem-by-qname |
|---|
| 217 | node "http://test/arcs/" "rel")) |
|---|
| 218 | (signals error (rdf-importer::parse-node node)))))) |
|---|
| 219 | |
|---|
| 220 | |
|---|
| 221 | (test test-get-literals-of-property |
|---|
| 222 | "Tests the function get-literals-or-property." |
|---|
| 223 | (let ((doc-1 |
|---|
| 224 | (concat "<prop:property xmlns:prop=\"http://props/\" " |
|---|
| 225 | "xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 226 | "xmlns:rdfs=\"" *rdfs-ns* "\" " |
|---|
| 227 | "rdf:type=\"rdfType\" rdf:resource=\"rdfResource\" " |
|---|
| 228 | "rdf:nodeID=\"rdfNodeID\" " |
|---|
| 229 | "prop:prop1=\"http://should/be/a/literal\" " |
|---|
| 230 | "prop:prop2=\"prop-2\" " |
|---|
| 231 | "prop:prop3=\"\">content-text</prop:property>"))) |
|---|
| 232 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 233 | (is-true dom-1) |
|---|
| 234 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 235 | (let ((property (elt (dom:child-nodes dom-1) 0))) |
|---|
| 236 | (let ((literals (rdf-importer::get-literals-of-property property nil))) |
|---|
| 237 | (is (= (length literals) 3)) |
|---|
| 238 | (is-true (find-if #'(lambda(x) |
|---|
| 239 | (and |
|---|
| 240 | (string= (getf x :value) |
|---|
| 241 | "http://should/be/a/literal") |
|---|
| 242 | (string= (getf x :type) "http://props/prop1") |
|---|
| 243 | (not (getf x :ID)))) |
|---|
| 244 | literals)) |
|---|
| 245 | (is-true (find-if #'(lambda(x) |
|---|
| 246 | (and |
|---|
| 247 | (string= (getf x :value) "prop-2") |
|---|
| 248 | (string= (getf x :type) "http://props/prop2") |
|---|
| 249 | (not (getf x :ID)))) |
|---|
| 250 | literals)) |
|---|
| 251 | (is-true (find-if #'(lambda(x) |
|---|
| 252 | (and |
|---|
| 253 | (string= (getf x :value) "") |
|---|
| 254 | (string= (getf x :type) "http://props/prop3") |
|---|
| 255 | (not (getf x :ID)))) |
|---|
| 256 | literals))))))) |
|---|
| 257 | |
|---|
| 258 | |
|---|
| 259 | (test test-parse-property |
|---|
| 260 | "Tests the function parse-property." |
|---|
| 261 | (let ((doc-1 |
|---|
| 262 | (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 263 | "xmlns:rdfs=\"" *rdfs-ns* "\" " |
|---|
| 264 | "xmlns:prop=\"http://isidorus/props/\">" |
|---|
| 265 | "<prop:prop0 rdf:parseType=\"Resource\" />" |
|---|
| 266 | "<prop:prop1 rdf:parseType=\"Resource\">" |
|---|
| 267 | "<prop:prop1_0 rdf:resource=\"prop21\" />" |
|---|
| 268 | "</prop:prop1>" |
|---|
| 269 | "<prop:prop2 rdf:parseType=\"Literal\">" |
|---|
| 270 | "<content_root>content-text</content_root>" |
|---|
| 271 | "</prop:prop2>" |
|---|
| 272 | "<prop:prop3 rdf:parseType=\"Collection\" />" |
|---|
| 273 | "<prop:prop4 rdf:parseType=\"Collection\">" |
|---|
| 274 | "<prop:prop4_0 rdf:resource=\"prop5_1\" />" |
|---|
| 275 | "<prop:prop4_1 rdf:nodeID=\"prop5_2\" />" |
|---|
| 276 | "<prop:prop4_2/>" |
|---|
| 277 | "</prop:prop4>" |
|---|
| 278 | "<prop:prop5 />" |
|---|
| 279 | "<prop:prop6>prop6</prop:prop6>" |
|---|
| 280 | "<prop:prop7 rdf:nodeID=\"prop7\"/>" |
|---|
| 281 | "<prop:prop8 rdf:resource=\"prop8\" />" |
|---|
| 282 | "<prop:prop9 rdf:type=\"typeProp9\"> </prop:prop9>" |
|---|
| 283 | "<prop:prop10 rdf:datatype=\"datatypeProp10\" />" |
|---|
| 284 | "<prop:prop11 rdf:ID=\"IDProp11\"> </prop:prop11>" |
|---|
| 285 | "<prop:prop12 rdf:ID=\"IDprop12\" rdf:nodeID=\"prop12\">" |
|---|
| 286 | " </prop:prop12>" |
|---|
| 287 | "<prop:prop13 />" |
|---|
| 288 | "<prop:prop14>prop14</prop:prop14>" |
|---|
| 289 | "<prop:prop15 rdf:nodeID=\"prop15\"/>" |
|---|
| 290 | "<prop:prop16 rdf:resource=\"prop16\" />" |
|---|
| 291 | "<prop:prop17 rdf:type=\"typeProp17\"> </prop:prop17>" |
|---|
| 292 | "<prop:prop18 rdf:ID=\"IDprop18\" rdf:nodeID=\"prop18\">" |
|---|
| 293 | " </prop:prop18>" |
|---|
| 294 | "</rdf:Description>"))) |
|---|
| 295 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 296 | (is-true dom-1) |
|---|
| 297 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 298 | (let ((child (elt (dom:child-nodes dom-1) 0))) |
|---|
| 299 | (let ((children (rdf-importer::child-nodes-or-text child)) |
|---|
| 300 | (text-node (dom:create-text-node dom-1 "new text node"))) |
|---|
| 301 | (is (= (length children) 19)) |
|---|
| 302 | (loop for property across children |
|---|
| 303 | do (is-true (rdf-importer::parse-property property 0))) |
|---|
| 304 | (dotimes (i (length children)) |
|---|
| 305 | (if (or (= i 0) (= i 1) (= i 3) (= i 4) (= i 9) (= i 17)) |
|---|
| 306 | (is-true (get-ns-attribute (elt children i) "UUID" |
|---|
| 307 | :ns-uri *rdf2tm-ns*)) |
|---|
| 308 | (is-false (get-ns-attribute (elt children i) "UUID" |
|---|
| 309 | :ns-uri *rdf2tm-ns*)))) |
|---|
| 310 | (let ((prop (elt children 0))) |
|---|
| 311 | (dom:set-attribute-ns prop *rdf-ns* "parseType" "Unknown") |
|---|
| 312 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 313 | (dom:set-attribute-ns prop *rdf-ns* "parseType" "Resource") |
|---|
| 314 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 315 | (dom:set-attribute-ns prop *rdf-ns* "ID" "newID") |
|---|
| 316 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 317 | (dom:set-attribute-ns prop *rdf-ns* "bad" "bad") |
|---|
| 318 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 319 | (dom:remove-attribute-ns prop *rdf-ns* "bad") |
|---|
| 320 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 321 | (dom:append-child prop text-node) |
|---|
| 322 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 323 | (dom:remove-child prop text-node) |
|---|
| 324 | (is-true (rdf-importer::parse-property prop 0))) |
|---|
| 325 | (let ((prop (elt children 1))) |
|---|
| 326 | (dom:set-attribute-ns prop *rdf-ns* "nodeID" "bad") |
|---|
| 327 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 328 | (dom:remove-attribute-ns prop *rdf-ns* "nodeID") |
|---|
| 329 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 330 | (dom:set-attribute-ns prop *rdf-ns* "ID" "newID") |
|---|
| 331 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 332 | (dom:append-child prop text-node) |
|---|
| 333 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 334 | (dom:remove-child prop text-node) |
|---|
| 335 | (is-true (rdf-importer::parse-property prop 0))) |
|---|
| 336 | (let ((prop (elt children 3))) |
|---|
| 337 | (dom:append-child prop text-node) |
|---|
| 338 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 339 | (dom:remove-child prop text-node) |
|---|
| 340 | (is-true (rdf-importer::parse-property prop 0))) |
|---|
| 341 | (let ((prop (elt children 4))) |
|---|
| 342 | (dom:append-child prop text-node) |
|---|
| 343 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 344 | (dom:remove-child prop text-node) |
|---|
| 345 | (is-true (rdf-importer::parse-property prop 0))) |
|---|
| 346 | (let ((prop (elt children 5))) |
|---|
| 347 | (dom:set-attribute-ns prop *rdf-ns* "type" "newType") |
|---|
| 348 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 349 | (dom:set-attribute-ns prop *rdf-ns* "unknown" "unknown") |
|---|
| 350 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 351 | (dom:append-child prop text-node) |
|---|
| 352 | (dom:remove-child prop text-node) |
|---|
| 353 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 354 | (dom:remove-attribute-ns prop *rdf-ns* "unknown") |
|---|
| 355 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 356 | (dom:append-child prop text-node) |
|---|
| 357 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 358 | (dom:remove-child prop text-node) |
|---|
| 359 | (is-true (rdf-importer::parse-property prop 0))) |
|---|
| 360 | (let ((prop (elt children 10))) |
|---|
| 361 | (dom:set-attribute-ns prop *rdf-ns* "type" "newType") |
|---|
| 362 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 363 | (dom:remove-attribute-ns prop *rdf-ns* "type") |
|---|
| 364 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 365 | (dom:set-attribute-ns prop *rdf-ns* "nodeID" "newNodeID") |
|---|
| 366 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 367 | (dom:remove-attribute-ns prop *rdf-ns* "nodeID") |
|---|
| 368 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 369 | (dom:set-attribute-ns prop *rdf-ns* "resource" "newResource") |
|---|
| 370 | (signals error (rdf-importer::parse-property prop 0)) |
|---|
| 371 | (dom:remove-attribute-ns prop *rdf-ns* "resource") |
|---|
| 372 | (is-true (rdf-importer::parse-property prop 0)) |
|---|
| 373 | (dom:set-attribute-ns prop *rdf-ns* "ID" "newID") |
|---|
| 374 | (is-true (rdf-importer::parse-property prop 0)))))))) |
|---|
| 375 | |
|---|
| 376 | |
|---|
| 377 | (test test-get-types |
|---|
| 378 | "Tests the functions get-type-of-node-name, get-types-of-content, |
|---|
| 379 | get-node-rerfs, absolute-uri-p, absolutize-value and absolutize-id." |
|---|
| 380 | (let ((tm-id "http://test-tm") |
|---|
| 381 | (doc-1 |
|---|
| 382 | (concat "<rdf:anyType xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 383 | "xmlns:isi=\"" *rdf2tm-ns* "\" " |
|---|
| 384 | "xmlns:arcs=\"http://test/arcs/\" " |
|---|
| 385 | "xml:base=\"xml-base/first\" " |
|---|
| 386 | "rdf:about=\"resource\" rdf:type=\"attr-type\">" |
|---|
| 387 | "<rdf:type rdf:ID=\"rdfID\" " |
|---|
| 388 | "rdf:resource=\"content-type-1\"/>" |
|---|
| 389 | "<rdf:type /><!-- blank_node -->" |
|---|
| 390 | "<rdf:type arcs:arc=\"literalArc\"/>" |
|---|
| 391 | "<rdf:type rdf:parseType=\"Collection\" " |
|---|
| 392 | " xml:base=\"http://xml-base/absolute/\">" |
|---|
| 393 | "<!-- blank_node that is a list -->" |
|---|
| 394 | "<rdf:Description rdf:about=\"c-about-type\"/>" |
|---|
| 395 | "<rdf:Description rdf:ID=\"c-id-type\"/>" |
|---|
| 396 | "<rdf:Description rdf:nodeID=\"c-nodeID-type\"/>" |
|---|
| 397 | "<rdf:Description/><!-- blank_node -->" |
|---|
| 398 | "</rdf:type>" |
|---|
| 399 | "<rdf:type rdf:ID=\"rdfID2\">" |
|---|
| 400 | "<rdf:Description rdf:about=\"c-about-type-2\"/>" |
|---|
| 401 | "</rdf:type>" |
|---|
| 402 | "<rdf:type>" |
|---|
| 403 | "<rdf:Description rdf:nodeID=\"c-nodeID-type-2\"/>" |
|---|
| 404 | "</rdf:type>" |
|---|
| 405 | "<rdf:type xml:base=\"http://new-base/\">" |
|---|
| 406 | "<rdf:Description rdf:ID=\"c-ID-type-2\"/>" |
|---|
| 407 | "</rdf:type>" |
|---|
| 408 | "<rdf:type rdf:ID=\"rdfID3\">" |
|---|
| 409 | "<rdf:Description/>" |
|---|
| 410 | "</rdf:type>" |
|---|
| 411 | "<arcs:arc rdf:resource=\"anyArc\"/>" |
|---|
| 412 | "<rdf:arc>" |
|---|
| 413 | "<rdf:Description rdf:about=\"anyResource\"/>" |
|---|
| 414 | "</rdf:arc>" |
|---|
| 415 | "</rdf:anyType>"))) |
|---|
| 416 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 417 | (is-true dom-1) |
|---|
| 418 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 419 | (is-true (absolute-uri-p tm-id)) |
|---|
| 420 | (is-false (absolute-uri-p "http//bad")) |
|---|
| 421 | (is-false (absolute-uri-p "")) |
|---|
| 422 | (is-false (absolute-uri-p " ")) |
|---|
| 423 | (is-false (absolute-uri-p nil)) |
|---|
| 424 | (let ((node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 425 | (loop for property across (rdf-importer::child-nodes-or-text node) |
|---|
| 426 | do (rdf-importer::parse-property property 0)) |
|---|
| 427 | (let ((types |
|---|
| 428 | (append |
|---|
| 429 | (list (list |
|---|
| 430 | :topicid (rdf-importer::get-type-of-node-name node) |
|---|
| 431 | :psi (rdf-importer::get-type-of-node-name node) |
|---|
| 432 | :ID nil)) |
|---|
| 433 | (rdf-importer::get-types-of-node-content node tm-id nil))) |
|---|
| 434 | (node-uuid (get-ns-attribute |
|---|
| 435 | (elt (rdf-importer::child-nodes-or-text |
|---|
| 436 | (elt (rdf-importer::child-nodes-or-text node) 7)) |
|---|
| 437 | 0) |
|---|
| 438 | "UUID" :ns-uri *rdf2tm-ns*))) |
|---|
| 439 | (is (= (length types) 10)) |
|---|
| 440 | (is-true (find-if |
|---|
| 441 | #'(lambda(x) |
|---|
| 442 | (and (string= (getf x :topicid) |
|---|
| 443 | (concat *rdf-ns* "anyType")) |
|---|
| 444 | (string= (getf x :topicid) |
|---|
| 445 | (concat *rdf-ns* "anyType")) |
|---|
| 446 | (not (getf x :ID)))) |
|---|
| 447 | types)) |
|---|
| 448 | (is-true (find-if |
|---|
| 449 | #'(lambda(x) |
|---|
| 450 | (and (string= (getf x :topicid) |
|---|
| 451 | (concat tm-id |
|---|
| 452 | "/xml-base/first/attr-type")) |
|---|
| 453 | (string= (getf x :psi) |
|---|
| 454 | (concat tm-id |
|---|
| 455 | "/xml-base/first/attr-type")) |
|---|
| 456 | (not (getf x :ID)))) |
|---|
| 457 | types)) |
|---|
| 458 | (is-true (find-if |
|---|
| 459 | #'(lambda(x) |
|---|
| 460 | (and (string= (getf x :topicid) |
|---|
| 461 | "http://test-tm/xml-base/first/content-type-1") |
|---|
| 462 | (string= (getf x :psi) |
|---|
| 463 | "http://test-tm/xml-base/first/content-type-1") |
|---|
| 464 | (string= (getf x :ID) |
|---|
| 465 | "http://test-tm/xml-base/first#rdfID"))) |
|---|
| 466 | types)) |
|---|
| 467 | (is-true (find-if |
|---|
| 468 | #'(lambda(x) |
|---|
| 469 | (and (string= (getf x :topicid) |
|---|
| 470 | (concat tm-id |
|---|
| 471 | "/xml-base/first/c-about-type-2")) |
|---|
| 472 | (string= (getf x :psi) |
|---|
| 473 | (concat tm-id |
|---|
| 474 | "/xml-base/first/c-about-type-2")) |
|---|
| 475 | (string= (getf x :ID) |
|---|
| 476 | "http://test-tm/xml-base/first#rdfID2"))) |
|---|
| 477 | types)) |
|---|
| 478 | (is-true (find-if |
|---|
| 479 | #'(lambda(x) |
|---|
| 480 | (and (string= (getf x :topicid) "c-nodeID-type-2") |
|---|
| 481 | (not (getf x :psi)) |
|---|
| 482 | (not (getf x :ID)))) |
|---|
| 483 | types)) |
|---|
| 484 | (is-true (find-if |
|---|
| 485 | #'(lambda(x) |
|---|
| 486 | (and (string= (getf x :topicid) |
|---|
| 487 | "http://new-base#c-ID-type-2") |
|---|
| 488 | (string= (getf x :psi) |
|---|
| 489 | "http://new-base#c-ID-type-2") |
|---|
| 490 | (not (getf x :ID)))) |
|---|
| 491 | types)) |
|---|
| 492 | (is-true (find-if |
|---|
| 493 | #'(lambda(x) |
|---|
| 494 | (and (string= (getf x :topicid) node-uuid) |
|---|
| 495 | (not (getf x :psi)) |
|---|
| 496 | (string= (getf x :ID) |
|---|
| 497 | "http://test-tm/xml-base/first#rdfID3"))) |
|---|
| 498 | types)) |
|---|
| 499 | (is-true (= 10 (count-if #'(lambda(x) |
|---|
| 500 | (> (length (getf x :topicid)) 0)) |
|---|
| 501 | types)))))))) |
|---|
| 502 | |
|---|
| 503 | |
|---|
| 504 | (test test-get-literals-of-content |
|---|
| 505 | (let ((doc-1 |
|---|
| 506 | (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 507 | "xmlns:rdfs=\"" *rdfs-ns* "\" " |
|---|
| 508 | "xmlns:prop=\"http://isidorus/props/\" " |
|---|
| 509 | "xml:base=\"base/first\" xml:lang=\"de\" >" |
|---|
| 510 | "<prop:lit0>text0</prop:lit0>" |
|---|
| 511 | "<prop:lit1 rdf:parseType=\"Literal\">text1</prop:lit1>" |
|---|
| 512 | "<prop:lit2 xml:base=\"http://base/absolute\" " |
|---|
| 513 | "rdf:datatype=\"dType1\">text2</prop:lit2>" |
|---|
| 514 | "<prop:arc rdf:parseType=\"Collection\"/>" |
|---|
| 515 | "<prop:lit3 xml:lang=\"en\" rdf:datatype=\"dType2\">" |
|---|
| 516 | "<![CDATA[text3]]></prop:lit3>" |
|---|
| 517 | "<prop:lit4 rdf:datatype=\"dType2\"><root><child/></root>" |
|---|
| 518 | " </prop:lit4>" |
|---|
| 519 | "<prop:lit5 rdf:ID=\"rdfID\" " |
|---|
| 520 | "rdf:parseType=\"Literal\"><root><child>" |
|---|
| 521 | "childText5</child> </root></prop:lit5>" |
|---|
| 522 | "<prop:lit6 xml:lang=\"\" rdf:parseType=\"Literal\">" |
|---|
| 523 | " <![CDATA[text6]]> abc " |
|---|
| 524 | "</prop:lit6>" |
|---|
| 525 | "</rdf:Description>"))) |
|---|
| 526 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))) |
|---|
| 527 | (tm-id "http://test-tm")) |
|---|
| 528 | (is-true dom-1) |
|---|
| 529 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 530 | (let ((node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 531 | (dotimes (iter (length (dom:child-nodes node))) |
|---|
| 532 | (is-true (rdf-importer::parse-property |
|---|
| 533 | (elt (dom:child-nodes node) iter) 0))) |
|---|
| 534 | (let ((literals (rdf-importer::get-literals-of-node-content |
|---|
| 535 | node tm-id nil nil))) |
|---|
| 536 | (is (= (length literals) 7)) |
|---|
| 537 | (is-true (find-if |
|---|
| 538 | #'(lambda(x) |
|---|
| 539 | (and (string= (getf x :value) "text0") |
|---|
| 540 | (string= (getf x :type) |
|---|
| 541 | "http://isidorus/props/lit0") |
|---|
| 542 | (not (getf x :ID)) |
|---|
| 543 | (string= (getf x :lang) "de") |
|---|
| 544 | (string= (getf x :datatype) *xml-string*))) |
|---|
| 545 | literals)) |
|---|
| 546 | (is-true (find-if |
|---|
| 547 | #'(lambda(x) |
|---|
| 548 | (and (string= (getf x :value) "text1") |
|---|
| 549 | (string= (getf x :type) |
|---|
| 550 | "http://isidorus/props/lit1") |
|---|
| 551 | (not (getf x :ID)) |
|---|
| 552 | (string= (getf x :lang) "de") |
|---|
| 553 | (string= (getf x :datatype) *xml-string*))) |
|---|
| 554 | literals)) |
|---|
| 555 | (is-true (find-if |
|---|
| 556 | #'(lambda(x) |
|---|
| 557 | (and (string= (getf x :value) "text2") |
|---|
| 558 | (string= (getf x :type) |
|---|
| 559 | "http://isidorus/props/lit2") |
|---|
| 560 | (not (getf x :ID)) |
|---|
| 561 | (string= (getf x :lang) "de") |
|---|
| 562 | (string= (getf x :datatype) |
|---|
| 563 | "http://base/absolute/dType1"))) |
|---|
| 564 | literals)) |
|---|
| 565 | (is-true (find-if |
|---|
| 566 | #'(lambda(x) |
|---|
| 567 | (and (string= (getf x :value) "text3") |
|---|
| 568 | (string= (getf x :type) |
|---|
| 569 | "http://isidorus/props/lit3") |
|---|
| 570 | (not (getf x :ID)) |
|---|
| 571 | (string= (getf x :lang) "en") |
|---|
| 572 | (string= (getf x :datatype) |
|---|
| 573 | "http://test-tm/base/first/dType2"))) |
|---|
| 574 | literals)) |
|---|
| 575 | (is-true (find-if |
|---|
| 576 | #'(lambda(x) |
|---|
| 577 | (and (string= (getf x :value) |
|---|
| 578 | "<root><child></child></root> ") |
|---|
| 579 | (string= (getf x :type) |
|---|
| 580 | "http://isidorus/props/lit4") |
|---|
| 581 | (not (getf x :ID)) |
|---|
| 582 | (string= (getf x :lang) "de") |
|---|
| 583 | (string= (getf x :datatype) |
|---|
| 584 | "http://test-tm/base/first/dType2"))) |
|---|
| 585 | literals)) |
|---|
| 586 | (is-true (find-if |
|---|
| 587 | #'(lambda(x) |
|---|
| 588 | (and (string= (getf x :value) |
|---|
| 589 | "<root><child>childText5</child> </root>") |
|---|
| 590 | (string= (getf x :type) |
|---|
| 591 | "http://isidorus/props/lit5") |
|---|
| 592 | (string= (getf x :ID) |
|---|
| 593 | "http://test-tm/base/first#rdfID") |
|---|
| 594 | (string= (getf x :lang) "de") |
|---|
| 595 | (string= (getf x :datatype) *xml-string*))) |
|---|
| 596 | literals)) |
|---|
| 597 | (is-true (find-if |
|---|
| 598 | #'(lambda(x) |
|---|
| 599 | (and (string= (getf x :value) " text6 abc ") |
|---|
| 600 | (string= (getf x :type) |
|---|
| 601 | "http://isidorus/props/lit6") |
|---|
| 602 | (not (getf x :ID)) |
|---|
| 603 | (not (getf x :lang)) |
|---|
| 604 | (string= (getf x :datatype) *xml-string*))) |
|---|
| 605 | literals))))))) |
|---|
| 606 | |
|---|
| 607 | |
|---|
| 608 | (test test-get-super-classes-of-node-content |
|---|
| 609 | (let ((doc-1 |
|---|
| 610 | (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 611 | "xmlns:isi=\"" *rdf2tm-ns* "\" " |
|---|
| 612 | "xmlns:rdfs=\"" *rdfs-ns* "\" " |
|---|
| 613 | "xmlns:arcs=\"http://test/arcs/\" " |
|---|
| 614 | "xml:base=\"xml-base/first\" " |
|---|
| 615 | "rdf:about=\"resource\" rdf:type=\"attr-type\">" |
|---|
| 616 | "<rdfs:subClassOf rdf:ID=\"rdfID\" " |
|---|
| 617 | "rdf:resource=\"content-type-1\"/>" |
|---|
| 618 | "<rdfs:subClassOf /><!-- blank_node -->" |
|---|
| 619 | "<rdfs:subClassOf arcs:arc=\"literalArc\"/>" |
|---|
| 620 | "<rdfs:subClassOf rdf:parseType=\"Collection\" " |
|---|
| 621 | " xml:base=\"http://xml-base/absolute/\">" |
|---|
| 622 | "<!-- blank_node that is a list -->" |
|---|
| 623 | "<rdf:Description rdf:about=\"c-about-type\"/>" |
|---|
| 624 | "<rdf:Description rdf:ID=\"c-id-type\"/>" |
|---|
| 625 | "<rdf:Description rdf:nodeID=\"c-nodeID-type\"/>" |
|---|
| 626 | "<rdf:Description/><!-- blank_node -->" |
|---|
| 627 | "</rdfs:subClassOf>" |
|---|
| 628 | "<rdfs:subClassOf rdf:ID=\"rdfID2\">" |
|---|
| 629 | "<rdf:Description rdf:about=\"c-about-type-2\"/>" |
|---|
| 630 | "</rdfs:subClassOf>" |
|---|
| 631 | "<rdfs:subClassOf>" |
|---|
| 632 | "<rdf:Description rdf:nodeID=\"c-nodeID-type-2\"/>" |
|---|
| 633 | "</rdfs:subClassOf>" |
|---|
| 634 | "<rdfs:subClassOf xml:base=\"http://new-base/\">" |
|---|
| 635 | "<rdf:Description rdf:ID=\"c-ID-type-2\"/>" |
|---|
| 636 | "</rdfs:subClassOf>" |
|---|
| 637 | "<rdfs:subClassOf rdf:ID=\"rdfID3\">" |
|---|
| 638 | "<rdf:Description/>" |
|---|
| 639 | "</rdfs:subClassOf>" |
|---|
| 640 | "<arcs:arc rdf:resource=\"anyArc\"/>" |
|---|
| 641 | "<rdfs:arc>" |
|---|
| 642 | "<rdf:Description rdf:about=\"anyResource\"/>" |
|---|
| 643 | "</rdfs:arc>" |
|---|
| 644 | "</rdf:Description>"))) |
|---|
| 645 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 646 | (is-true dom-1) |
|---|
| 647 | (is (= (length (dom:child-nodes dom-1)))) |
|---|
| 648 | (let ((node (elt (dom:child-nodes dom-1) 0)) |
|---|
| 649 | (tm-id "http://test-tm") |
|---|
| 650 | (xml-base "/base/initial")) |
|---|
| 651 | (is-true node) |
|---|
| 652 | (is-true (rdf-importer::parse-node node)) |
|---|
| 653 | (loop for property across (rdf-importer::child-nodes-or-text node) |
|---|
| 654 | do (is-true (rdf-importer::parse-property property 0))) |
|---|
| 655 | (let ((super-classes (rdf-importer::get-super-classes-of-node-content |
|---|
| 656 | node tm-id xml-base))) |
|---|
| 657 | (is (= (length super-classes) 8)) |
|---|
| 658 | (is-true |
|---|
| 659 | (find-if |
|---|
| 660 | #'(lambda(x) |
|---|
| 661 | (and |
|---|
| 662 | (string= |
|---|
| 663 | (getf x :psi) |
|---|
| 664 | "http://test-tm/base/initial/xml-base/first/content-type-1") |
|---|
| 665 | (string= |
|---|
| 666 | (getf x :topicid) |
|---|
| 667 | "http://test-tm/base/initial/xml-base/first/content-type-1") |
|---|
| 668 | (string= |
|---|
| 669 | (getf x :ID) |
|---|
| 670 | "http://test-tm/base/initial/xml-base/first#rdfID"))) |
|---|
| 671 | super-classes)) |
|---|
| 672 | (is-true (find-if |
|---|
| 673 | #'(lambda(x) |
|---|
| 674 | (and |
|---|
| 675 | (string= |
|---|
| 676 | (getf x :topicid) |
|---|
| 677 | (concat tm-id xml-base "/xml-base/first/c-about-type-2")) |
|---|
| 678 | (string= |
|---|
| 679 | (getf x :psi) |
|---|
| 680 | (concat tm-id xml-base "/xml-base/first/c-about-type-2")) |
|---|
| 681 | (string= (getf x :ID) |
|---|
| 682 | (concat tm-id xml-base |
|---|
| 683 | "/xml-base/first#rdfID2")))) |
|---|
| 684 | super-classes)) |
|---|
| 685 | (is-true (find-if |
|---|
| 686 | #'(lambda(x) |
|---|
| 687 | (and (string= (getf x :topicid) "c-nodeID-type-2") |
|---|
| 688 | (not (getf x :psi)) |
|---|
| 689 | (not (getf x :ID)))) |
|---|
| 690 | super-classes)) |
|---|
| 691 | (is-true (find-if |
|---|
| 692 | #'(lambda(x) |
|---|
| 693 | (and (string= (getf x :topicid) |
|---|
| 694 | "http://new-base#c-ID-type-2") |
|---|
| 695 | (string= (getf x :psi) |
|---|
| 696 | "http://new-base#c-ID-type-2") |
|---|
| 697 | (not (getf x :ID)))) |
|---|
| 698 | super-classes)) |
|---|
| 699 | (is (= (count-if #'(lambda(x) (> (length (getf x :topicid)) 0)) |
|---|
| 700 | super-classes) |
|---|
| 701 | 8)) |
|---|
| 702 | (is-true (find-if |
|---|
| 703 | #'(lambda(x) |
|---|
| 704 | (and |
|---|
| 705 | (string= |
|---|
| 706 | (getf x :ID) |
|---|
| 707 | "http://test-tm/base/initial/xml-base/first#rdfID3") |
|---|
| 708 | (not (getf x :psi)) |
|---|
| 709 | (> (length (getf x :topicid))))) |
|---|
| 710 | super-classes)) |
|---|
| 711 | (dom:append-child (elt (rdf-importer::child-nodes-or-text node) 1) |
|---|
| 712 | (dom:create-text-node dom-1 "new text")) |
|---|
| 713 | (signals error (rdf-importer::parse-property |
|---|
| 714 | (elt (rdf-importer::child-nodes-or-text node) 1) 0))))))) |
|---|
| 715 | |
|---|
| 716 | |
|---|
| 717 | (test test-get-associations-of-node-content |
|---|
| 718 | (let ((doc-1 |
|---|
| 719 | (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 720 | "xmlns:isi=\"" *rdf2tm-ns* "\" " |
|---|
| 721 | "xmlns:rdfs=\"" *rdfs-ns* "\" " |
|---|
| 722 | "xmlns:arcs=\"http://test/arcs/\" " |
|---|
| 723 | "xml:base=\"http://xml-base/first\" " |
|---|
| 724 | "rdf:about=\"resource\" rdf:type=\"attr-type\">" |
|---|
| 725 | "<rdf:type rdf:resource=\"anyType\" />" |
|---|
| 726 | "<rdf:type> </rdf:type>" |
|---|
| 727 | "<rdfs:subClassOf rdf:nodeID=\"anyClass\" />" |
|---|
| 728 | "<rdfs:subClassOf> </rdfs:subClassOf>" |
|---|
| 729 | "<rdf:unknown rdf:resource=\"assoc-1\"/>" |
|---|
| 730 | "<rdfs:unknown rdf:type=\"assoc-2-type\">" |
|---|
| 731 | " </rdfs:unknown>" |
|---|
| 732 | "<arcs:arc1 rdf:ID=\"rdfID-1\" " |
|---|
| 733 | "rdf:nodeID=\"arc1-nodeID\"/>" |
|---|
| 734 | "<arcs:arc2 rdf:parseType=\"Collection\">" |
|---|
| 735 | "<rdf:Description rdf:about=\"col\" />" |
|---|
| 736 | "</arcs:arc2>" |
|---|
| 737 | "<arcs:arc3 rdf:parseType=\"Resource\" " |
|---|
| 738 | "rdf:ID=\"rdfID-2\" />" |
|---|
| 739 | "<arcs:lit rdf:parseType=\"Literal\" />" |
|---|
| 740 | "<arcs:arc4 arcs:arc5=\"text-arc5\" />" |
|---|
| 741 | "<arcs:arc6 rdf:ID=\"rdfID-3\">" |
|---|
| 742 | "<rdf:Description rdf:about=\"con-1\" />" |
|---|
| 743 | "</arcs:arc6>" |
|---|
| 744 | "<arcs:arc7>" |
|---|
| 745 | "<rdf:Description rdf:nodeID=\"con-2\" />" |
|---|
| 746 | "</arcs:arc7>" |
|---|
| 747 | "<arcs:arc8>" |
|---|
| 748 | "<rdf:Description rdf:ID=\"rdfID-4\" />" |
|---|
| 749 | "</arcs:arc8>" |
|---|
| 750 | "<arcs:arc9 rdf:ID=\"rdfID-5\" xml:base=\"add\">" |
|---|
| 751 | "<rdf:Description />" |
|---|
| 752 | "</arcs:arc9>" |
|---|
| 753 | "<rdfs:type rdf:resource=\"assoc-11\"> </rdfs:type>" |
|---|
| 754 | "<rdf:subClassOf rdf:nodeID=\"assoc-12\" />" |
|---|
| 755 | "</rdf:Description>"))) |
|---|
| 756 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))) |
|---|
| 757 | (tm-id "http://test-tm")) |
|---|
| 758 | (is-true dom-1) |
|---|
| 759 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 760 | (let ((node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 761 | (loop for property across (rdf-importer::child-nodes-or-text node) |
|---|
| 762 | do (is-true (rdf-importer::parse-property property 0))) |
|---|
| 763 | (let ((associations |
|---|
| 764 | (rdf-importer::get-associations-of-node-content node tm-id nil))) |
|---|
| 765 | (is (= (length associations) 12)) |
|---|
| 766 | (is-true (find-if |
|---|
| 767 | #'(lambda(x) |
|---|
| 768 | (and (string= (getf x :type) |
|---|
| 769 | (concat *rdf-ns* "unknown")) |
|---|
| 770 | (string= (getf x :topicid) |
|---|
| 771 | "http://xml-base/first/assoc-1") |
|---|
| 772 | (string= (getf x :psi) |
|---|
| 773 | "http://xml-base/first/assoc-1") |
|---|
| 774 | (not (getf x :ID)))) |
|---|
| 775 | associations)) |
|---|
| 776 | (is-true (find-if |
|---|
| 777 | #'(lambda(x) |
|---|
| 778 | (and (string= (getf x :type) "http://test/arcs/arc1") |
|---|
| 779 | (string= (getf x :ID) "http://xml-base/first#rdfID-1") |
|---|
| 780 | (string= (getf x :topicid) "arc1-nodeID") |
|---|
| 781 | (not (getf x :psi)))) |
|---|
| 782 | associations)) |
|---|
| 783 | (is-true (find-if |
|---|
| 784 | #'(lambda(x) |
|---|
| 785 | (and (string= (getf x :type) "http://test/arcs/arc2") |
|---|
| 786 | (> (length (getf x :topicid)) 0) |
|---|
| 787 | (not (getf x :psi)) |
|---|
| 788 | (not (getf x :ID)))) |
|---|
| 789 | associations)) |
|---|
| 790 | (is-true (find-if |
|---|
| 791 | #'(lambda(x) |
|---|
| 792 | (and (string= (getf x :type) "http://test/arcs/arc3") |
|---|
| 793 | (string= (getf x :ID) |
|---|
| 794 | "http://xml-base/first#rdfID-2") |
|---|
| 795 | (not (getf x :psi)) |
|---|
| 796 | (> (length (getf x :topicid)) 0))) |
|---|
| 797 | associations)) |
|---|
| 798 | (is-true (find-if |
|---|
| 799 | #'(lambda(x) |
|---|
| 800 | (and (string= (getf x :type) "http://test/arcs/arc4") |
|---|
| 801 | (not (getf x :ID)) |
|---|
| 802 | (not (getf x :psi)) |
|---|
| 803 | (> (length (getf x :topicid)) 0))) |
|---|
| 804 | associations)) |
|---|
| 805 | (is-true (find-if |
|---|
| 806 | #'(lambda(x) |
|---|
| 807 | (and (string= (getf x :type) "http://test/arcs/arc4") |
|---|
| 808 | (not (getf x :ID)) |
|---|
| 809 | (not (getf x :psi)) |
|---|
| 810 | (> (length (getf x :topicid)) 0))) |
|---|
| 811 | associations)) |
|---|
| 812 | (is-true (find-if |
|---|
| 813 | #'(lambda(x) |
|---|
| 814 | (and (string= (getf x :type) "http://test/arcs/arc6") |
|---|
| 815 | (string= (getf x :ID) |
|---|
| 816 | "http://xml-base/first#rdfID-3") |
|---|
| 817 | (string= (getf x :topicid) |
|---|
| 818 | "http://xml-base/first/con-1") |
|---|
| 819 | (string= (getf x :psi) |
|---|
| 820 | "http://xml-base/first/con-1"))) |
|---|
| 821 | associations)) |
|---|
| 822 | (is-true (find-if |
|---|
| 823 | #'(lambda(x) |
|---|
| 824 | (and (string= (getf x :type) "http://test/arcs/arc7") |
|---|
| 825 | (not (getf x :ID)) |
|---|
| 826 | (string= (getf x :topicid) "con-2") |
|---|
| 827 | (not (getf x :psi)))) |
|---|
| 828 | associations)) |
|---|
| 829 | (is-true (find-if |
|---|
| 830 | #'(lambda(x) |
|---|
| 831 | (and (string= (getf x :type) "http://test/arcs/arc8") |
|---|
| 832 | (not (getf x :ID)) |
|---|
| 833 | (string= (getf x :topicid) |
|---|
| 834 | "http://xml-base/first#rdfID-4") |
|---|
| 835 | (string= (getf x :psi) |
|---|
| 836 | "http://xml-base/first#rdfID-4"))) |
|---|
| 837 | associations)) |
|---|
| 838 | (is-true (find-if |
|---|
| 839 | #'(lambda(x) |
|---|
| 840 | (and (string= (getf x :type) "http://test/arcs/arc9") |
|---|
| 841 | (string= (getf x :ID) |
|---|
| 842 | "http://xml-base/first/add#rdfID-5") |
|---|
| 843 | (not (getf x :psi)) |
|---|
| 844 | (> (length (getf x :topicid))))) |
|---|
| 845 | associations)) |
|---|
| 846 | (is-true (find-if |
|---|
| 847 | #'(lambda(x) |
|---|
| 848 | (and (string= (getf x :type) |
|---|
| 849 | (concat *rdfs-ns* "type")) |
|---|
| 850 | (not (getf x :ID)) |
|---|
| 851 | (string= (getf x :psi) |
|---|
| 852 | "http://xml-base/first/assoc-11") |
|---|
| 853 | (string= (getf x :topicid) |
|---|
| 854 | "http://xml-base/first/assoc-11"))) |
|---|
| 855 | associations)) |
|---|
| 856 | (is-true (find-if |
|---|
| 857 | #'(lambda(x) |
|---|
| 858 | (and (string= (getf x :type) |
|---|
| 859 | (concat *rdf-ns* "subClassOf")) |
|---|
| 860 | (not (getf x :ID)) |
|---|
| 861 | (not (getf x :psi)) |
|---|
| 862 | (string= (getf x :topicid) "assoc-12"))) |
|---|
| 863 | associations))))))) |
|---|
| 864 | |
|---|
| 865 | |
|---|
| 866 | (test test-parse-properties-of-node |
|---|
| 867 | (let ((doc-1 |
|---|
| 868 | (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 869 | "xmlns:arcs=\"http://test/arcs/\" " |
|---|
| 870 | "xml:base=\"http://xml-base/first\" " |
|---|
| 871 | "rdf:about=\"resource\" rdf:type=\"attr-type\" " |
|---|
| 872 | "rdf:li=\"li-attr\">" |
|---|
| 873 | "<rdf:li rdf:resource=\"anyType\" />" |
|---|
| 874 | "<rdf:li> text-1 </rdf:li>" |
|---|
| 875 | "<rdf:li rdf:nodeID=\"anyClass\" />" |
|---|
| 876 | "<rdf:li> </rdf:li>" |
|---|
| 877 | "<rdf:li rdf:resource=\"assoc-1\"/>" |
|---|
| 878 | "<rdf:li rdf:type=\"assoc-2-type\">" |
|---|
| 879 | " </rdf:li>" |
|---|
| 880 | "<rdf:li rdf:parseType=\"Literal\" > text-3</rdf:li>" |
|---|
| 881 | "<rdf:_123 arcs:arc5=\"text-arc5\"/>" |
|---|
| 882 | "<rdf:arc6 rdf:ID=\"rdfID-3\"> text-4 </rdf:arc6>" |
|---|
| 883 | "<rdf:arcs rdf:ID=\"rdfID-4\" xml:lang=\" \">" |
|---|
| 884 | "text-5</rdf:arcs>" |
|---|
| 885 | "</rdf:Description>"))) |
|---|
| 886 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))) |
|---|
| 887 | (tm-id "http://test-tm")) |
|---|
| 888 | (setf rdf-importer::*_n-map* nil) |
|---|
| 889 | (is-true dom-1) |
|---|
| 890 | (is (= (length (dom:child-nodes dom-1)))) |
|---|
| 891 | (let ((node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 892 | (is-true (rdf-importer::parse-node node)) |
|---|
| 893 | (is-true (rdf-importer::parse-properties-of-node |
|---|
| 894 | node "http://xml-base/first/resource")) |
|---|
| 895 | (is (= (length rdf-importer::*_n-map*) 1)) |
|---|
| 896 | (is (= (length (getf (first rdf-importer::*_n-map*) :props)) 8)) |
|---|
| 897 | (dotimes (iter (length rdf-importer::*_n-map*)) |
|---|
| 898 | (is-true (find-if |
|---|
| 899 | #'(lambda(x) |
|---|
| 900 | (string= (getf x :name) |
|---|
| 901 | (concat *rdf-ns* "_" |
|---|
| 902 | (write-to-string (+ 1 iter))))) |
|---|
| 903 | (getf (first rdf-importer::*_n-map*) :props)))) |
|---|
| 904 | (let ((assocs |
|---|
| 905 | (rdf-importer::get-associations-of-node-content node tm-id nil)) |
|---|
| 906 | (content-literals |
|---|
| 907 | (rdf-importer::get-literals-of-node-content node tm-id nil "de")) |
|---|
| 908 | (attr-literals |
|---|
| 909 | (rdf-importer::get-literals-of-node node nil))) |
|---|
| 910 | (is (= (length assocs) 5)) |
|---|
| 911 | (is (= (length content-literals) 5)) |
|---|
| 912 | (is (= (length attr-literals) 1)) |
|---|
| 913 | (is-true (find-if #'(lambda(x) |
|---|
| 914 | (and (string= (getf x :type) |
|---|
| 915 | (concat *rdf-ns* "_1")) |
|---|
| 916 | (not (getf x :lang)) |
|---|
| 917 | (string= (getf x :value) "li-attr") |
|---|
| 918 | (not (getf x :lang)) |
|---|
| 919 | (not (getf x :ID)))) |
|---|
| 920 | attr-literals)) |
|---|
| 921 | (is-true (find-if #'(lambda(x) |
|---|
| 922 | (and (string= (getf x :topicid) |
|---|
| 923 | "http://xml-base/first/anyType") |
|---|
| 924 | (string= (getf x :psi) |
|---|
| 925 | "http://xml-base/first/anyType") |
|---|
| 926 | (string= (getf x :type) |
|---|
| 927 | (concat *rdf-ns* "_2")) |
|---|
| 928 | (not (getf x :ID)))) |
|---|
| 929 | assocs)) |
|---|
| 930 | (is-true (find-if #'(lambda(x) |
|---|
| 931 | (and (string= (getf x :value) " text-1 ") |
|---|
| 932 | (string= (getf x :lang) "de") |
|---|
| 933 | (string= (getf x :datatype) *xml-string*) |
|---|
| 934 | (string= (getf x :type) |
|---|
| 935 | (concat *rdf-ns* "_3")) |
|---|
| 936 | (not (getf x :ID)))) |
|---|
| 937 | content-literals)) |
|---|
| 938 | (is-true (find-if #'(lambda(x) |
|---|
| 939 | (and (string= (getf x :topicid) "anyClass") |
|---|
| 940 | (not (getf x :psi)) |
|---|
| 941 | (string= (getf x :type) |
|---|
| 942 | (concat *rdf-ns* "_4")) |
|---|
| 943 | (not (getf x :ID)))) |
|---|
| 944 | assocs)) |
|---|
| 945 | (is-true (find-if #'(lambda(x) |
|---|
| 946 | (and (string= (getf x :value) " ") |
|---|
| 947 | (string= (getf x :type) |
|---|
| 948 | (concat *rdf-ns* "_5")) |
|---|
| 949 | (string= (getf x :datatype) *xml-string*) |
|---|
| 950 | (string= (getf x :lang) "de") |
|---|
| 951 | (not (getf x :ID)))) |
|---|
| 952 | content-literals)) |
|---|
| 953 | (is-true (find-if #'(lambda(x) |
|---|
| 954 | (and (string= (getf x :topicid) |
|---|
| 955 | "http://xml-base/first/assoc-1") |
|---|
| 956 | (string= (getf x :psi) |
|---|
| 957 | "http://xml-base/first/assoc-1") |
|---|
| 958 | (string= (getf x :type) |
|---|
| 959 | (concat *rdf-ns* "_6")) |
|---|
| 960 | (not (getf x :ID)))) |
|---|
| 961 | assocs)) |
|---|
| 962 | (is-true (find-if #'(lambda(x) |
|---|
| 963 | (and (> (length (getf x :topicid)) 0) |
|---|
| 964 | (not (getf x :psi)) |
|---|
| 965 | (string= (getf x :type) |
|---|
| 966 | (concat *rdf-ns* "_7")) |
|---|
| 967 | (not (getf x :ID)))) |
|---|
| 968 | assocs)) |
|---|
| 969 | (is-true (find-if #'(lambda(x) |
|---|
| 970 | (and (string= (getf x :value) " text-3") |
|---|
| 971 | (string= (getf x :lang) "de") |
|---|
| 972 | (string= (getf x :datatype) *xml-string*) |
|---|
| 973 | (string= (getf x :type) |
|---|
| 974 | (concat *rdf-ns* "_8")) |
|---|
| 975 | (not (getf x :ID)))) |
|---|
| 976 | content-literals)) |
|---|
| 977 | (is-true (find-if #'(lambda(x) |
|---|
| 978 | (and (string= (getf x :value) " text-4 ") |
|---|
| 979 | (string= (getf x :lang) "de") |
|---|
| 980 | (string= (getf x :datatype) *xml-string*) |
|---|
| 981 | (string= |
|---|
| 982 | (getf x :type) |
|---|
| 983 | (concat *rdf-ns* "arc6")) |
|---|
| 984 | (string= |
|---|
| 985 | (getf x :ID) |
|---|
| 986 | "http://xml-base/first#rdfID-3"))) |
|---|
| 987 | content-literals)) |
|---|
| 988 | (is-true (find-if #'(lambda(x) |
|---|
| 989 | (and (string= (getf x :value) "text-5") |
|---|
| 990 | (string= (getf x :lang) nil) |
|---|
| 991 | (string= (getf x :datatype) *xml-string*) |
|---|
| 992 | (string= |
|---|
| 993 | (getf x :type) |
|---|
| 994 | (concat *rdf-ns* "arcs")) |
|---|
| 995 | (string= |
|---|
| 996 | (getf x :ID) |
|---|
| 997 | "http://xml-base/first#rdfID-4"))) |
|---|
| 998 | content-literals))) |
|---|
| 999 | (setf rdf-importer::*_n-map* nil))))) |
|---|
| 1000 | |
|---|
| 1001 | |
|---|
| 1002 | (test test-import-node-1 |
|---|
| 1003 | "Tests the function import-node non-recursively." |
|---|
| 1004 | (let ((db-dir "data_base") |
|---|
| 1005 | (tm-id "http://test-tm/") |
|---|
| 1006 | (revision-1 100) |
|---|
| 1007 | (revision-2 200) |
|---|
| 1008 | (revision-3 300) |
|---|
| 1009 | (document-id "doc-id") |
|---|
| 1010 | (doc-1 |
|---|
| 1011 | (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 1012 | "xmlns:arcs=\"http://test/arcs/\" " |
|---|
| 1013 | "xmlns:rdfs=\"" *rdfs-ns* "\">" |
|---|
| 1014 | "<rdf:Description rdf:about=\"first-node\">" |
|---|
| 1015 | "<rdf:type rdf:resource=\"first-type\" />" |
|---|
| 1016 | "</rdf:Description>" |
|---|
| 1017 | "<rdf:Description rdf:type=\"second-type\" " |
|---|
| 1018 | "rdf:nodeID=\"second-node\">" |
|---|
| 1019 | "<rdfs:subClassOf>" |
|---|
| 1020 | "<rdf:Description rdf:ID=\"third-node\" />" |
|---|
| 1021 | "</rdfs:subClassOf>" |
|---|
| 1022 | "</rdf:Description>" |
|---|
| 1023 | "<rdf:Description arcs:arc1=\"arc-1\">" |
|---|
| 1024 | "<arcs:arc2 rdf:datatype=\"dt\">arc-2</arcs:arc2>" |
|---|
| 1025 | "</rdf:Description>" |
|---|
| 1026 | "<rdf:Description rdf:about=\"fourth-node\">" |
|---|
| 1027 | "<arcs:arc3 rdf:parseType=\"Literal\"><root>" |
|---|
| 1028 | "<content type=\"anyContent\">content</content>" |
|---|
| 1029 | "</root></arcs:arc3>" |
|---|
| 1030 | "</rdf:Description>" |
|---|
| 1031 | "<rdf:Description rdf:ID=\"fifth-node\">" |
|---|
| 1032 | "<arcs:arc4 rdf:parseType=\"Resource\">" |
|---|
| 1033 | "<arcs:arc5 rdf:resource=\"arc-5\" />" |
|---|
| 1034 | "</arcs:arc4>" |
|---|
| 1035 | "</rdf:Description>" |
|---|
| 1036 | "</rdf:RDF>"))) |
|---|
| 1037 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 1038 | (is-true dom-1) |
|---|
| 1039 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 1040 | (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 1041 | (is (= (length (dom:child-nodes rdf-node)) 5)) |
|---|
| 1042 | (let ((node (elt (dom:child-nodes rdf-node) 0))) |
|---|
| 1043 | (rdf-init-db :db-dir db-dir :start-revision revision-1) |
|---|
| 1044 | (rdf-importer::import-node node tm-id revision-2 |
|---|
| 1045 | :document-id document-id) |
|---|
| 1046 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21)) |
|---|
| 1047 | (let ((first-node (get-item-by-id "http://test-tm/first-node" |
|---|
| 1048 | :xtm-id document-id |
|---|
| 1049 | :revision 0)) |
|---|
| 1050 | (first-type (get-item-by-id "http://test-tm/first-type" |
|---|
| 1051 | :xtm-id document-id |
|---|
| 1052 | :revision 0))) |
|---|
| 1053 | (is-true first-node) |
|---|
| 1054 | (is (= (length (d::versions first-node)) 1)) |
|---|
| 1055 | (is (= (d::start-revision (first (d::versions first-node))) |
|---|
| 1056 | revision-2)) |
|---|
| 1057 | (is (= (d::end-revision (first (d::versions first-node))) 0)) |
|---|
| 1058 | (is-true first-type) |
|---|
| 1059 | (is (= (length (d:player-in-roles first-node)) 1)) |
|---|
| 1060 | (is (= (length (d:player-in-roles first-type)) 1)) |
|---|
| 1061 | (let ((instance-role |
|---|
| 1062 | (first (d:player-in-roles first-node :revision 0))) |
|---|
| 1063 | (type-role |
|---|
| 1064 | (first (d:player-in-roles first-type :revision 0))) |
|---|
| 1065 | (type-assoc |
|---|
| 1066 | (d:parent (first (d:player-in-roles first-node :revision 0)) |
|---|
| 1067 | :revision 0))) |
|---|
| 1068 | (is (= (length (d::versions type-assoc)) 1)) |
|---|
| 1069 | (is (= (d::start-revision (first (d::versions type-assoc))) |
|---|
| 1070 | revision-2)) |
|---|
| 1071 | (is (eql (d:instance-of instance-role) |
|---|
| 1072 | (d:get-item-by-psi *instance-psi*))) |
|---|
| 1073 | (is (eql (d:instance-of type-role) |
|---|
| 1074 | (d:get-item-by-psi *type-psi*))) |
|---|
| 1075 | (is (eql (d:instance-of type-assoc) |
|---|
| 1076 | (d:get-item-by-psi *type-instance-psi*))) |
|---|
| 1077 | (is (= (length (d:roles type-assoc :revision 0)) 2)) |
|---|
| 1078 | (is (= (length (d:psis first-node)) 1)) |
|---|
| 1079 | (is (= (length (d:psis first-type)) 1)) |
|---|
| 1080 | (is (string= (d:uri (first (d:psis first-node))) |
|---|
| 1081 | "http://test-tm/first-node")) |
|---|
| 1082 | (is (string= (d:uri (first (d:psis first-type))) |
|---|
| 1083 | "http://test-tm/first-type")) |
|---|
| 1084 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)))) |
|---|
| 1085 | (is (= (length (elephant:get-instances-by-class 'd:NameC)))) |
|---|
| 1086 | (is (= (length (elephant:get-instances-by-class 'd:VariantC))))) |
|---|
| 1087 | (dotimes (iter (length (dom:child-nodes rdf-node))) |
|---|
| 1088 | (rdf-importer::import-node (elt (dom:child-nodes rdf-node) iter) |
|---|
| 1089 | tm-id revision-3 |
|---|
| 1090 | :document-id document-id)) |
|---|
| 1091 | (let ((first-node (get-item-by-id "http://test-tm/first-node" |
|---|
| 1092 | :xtm-id document-id |
|---|
| 1093 | :revision 0)) |
|---|
| 1094 | (first-type (get-item-by-id "http://test-tm/first-type" |
|---|
| 1095 | :xtm-id document-id |
|---|
| 1096 | :revision 0)) |
|---|
| 1097 | (second-node (get-item-by-id "second-node" |
|---|
| 1098 | :xtm-id document-id |
|---|
| 1099 | :revision 0)) |
|---|
| 1100 | (second-type (get-item-by-id "http://test-tm/second-type" |
|---|
| 1101 | :xtm-id document-id |
|---|
| 1102 | :revision 0)) |
|---|
| 1103 | (third-node (get-item-by-id "http://test-tm#third-node" |
|---|
| 1104 | :xtm-id document-id |
|---|
| 1105 | :revision 0))) |
|---|
| 1106 | (is-true second-node) |
|---|
| 1107 | (is-false (d:psis second-node :revision 0)) |
|---|
| 1108 | (is-false (d:occurrences second-node :revision 0)) |
|---|
| 1109 | (is-false (d:names second-node :revision 0)) |
|---|
| 1110 | (is-true first-node) |
|---|
| 1111 | (is (= (length (d::versions first-node)) 2)) |
|---|
| 1112 | (is-true (find-if #'(lambda(x) |
|---|
| 1113 | (and (= (d::start-revision x) revision-2) |
|---|
| 1114 | (= (d::end-revision x) revision-3))) |
|---|
| 1115 | (d::versions first-node))) |
|---|
| 1116 | (is-true (find-if #'(lambda(x) |
|---|
| 1117 | (and (= (d::start-revision x) revision-3) |
|---|
| 1118 | (= (d::end-revision x) 0))) |
|---|
| 1119 | (d::versions first-node))) |
|---|
| 1120 | (let ((instance-role |
|---|
| 1121 | (first (d:player-in-roles first-node :revision 0))) |
|---|
| 1122 | (type-role |
|---|
| 1123 | (first (d:player-in-roles first-type :revision 0))) |
|---|
| 1124 | (type-assoc |
|---|
| 1125 | (d:parent (first (d:player-in-roles first-node |
|---|
| 1126 | :revision 0)))) |
|---|
| 1127 | (type-topic (get-item-by-psi *type-psi* :revision 0)) |
|---|
| 1128 | (instance-topic (get-item-by-psi *instance-psi* :revision 0)) |
|---|
| 1129 | (type-instance-topic (get-item-by-psi *type-instance-psi* |
|---|
| 1130 | :revision 0)) |
|---|
| 1131 | (supertype-topic (get-item-by-psi *supertype-psi* |
|---|
| 1132 | :revision 0)) |
|---|
| 1133 | (subtype-topic (get-item-by-psi *subtype-psi* |
|---|
| 1134 | :revision 0)) |
|---|
| 1135 | (supertype-subtype-topic |
|---|
| 1136 | (get-item-by-psi *supertype-subtype-psi* :revision 0)) |
|---|
| 1137 | (arc2-occurrence (elephant:get-instance-by-value |
|---|
| 1138 | 'd:OccurrenceC 'd:charvalue "arc-2")) |
|---|
| 1139 | (arc3-occurrence |
|---|
| 1140 | (elephant:get-instance-by-value |
|---|
| 1141 | 'd:OccurrenceC 'd:charvalue |
|---|
| 1142 | "<root><content type=\"anyContent\">content</content></root>")) |
|---|
| 1143 | (fifth-node (d:get-item-by-id "http://test-tm#fifth-node" |
|---|
| 1144 | :xtm-id document-id |
|---|
| 1145 | :revision 0))) |
|---|
| 1146 | (is (eql (d:instance-of instance-role :revision 0) |
|---|
| 1147 | (d:get-item-by-psi *instance-psi* :revision 0))) |
|---|
| 1148 | (is (eql (d:instance-of type-role :revision 0) |
|---|
| 1149 | (d:get-item-by-psi *type-psi* :revision 0))) |
|---|
| 1150 | (is (eql (d:instance-of type-assoc :revision 0) |
|---|
| 1151 | (d:get-item-by-psi *type-instance-psi* :revision 0))) |
|---|
| 1152 | (is (= (length (d:roles type-assoc :revision 0)) 2)) |
|---|
| 1153 | (is (= (length (d:psis first-node :revision 0)) 1)) |
|---|
| 1154 | (is (= (length (d:psis first-type :revision 0)) 1)) |
|---|
| 1155 | (is (= (length (d::versions type-assoc)) 2)) |
|---|
| 1156 | (is (= (length (d:player-in-roles second-node :revision 0)) 2)) |
|---|
| 1157 | (is-true (find-if |
|---|
| 1158 | #'(lambda(x) |
|---|
| 1159 | (and (eql (d:instance-of x) instance-topic) |
|---|
| 1160 | (eql (d:instance-of (d:parent x) ) |
|---|
| 1161 | type-instance-topic))) |
|---|
| 1162 | (d:player-in-roles second-node))) |
|---|
| 1163 | (is-true (find-if |
|---|
| 1164 | #'(lambda(x) |
|---|
| 1165 | (and (eql (d:instance-of x) subtype-topic) |
|---|
| 1166 | (eql (d:instance-of (d:parent x) ) |
|---|
| 1167 | supertype-subtype-topic))) |
|---|
| 1168 | (d:player-in-roles second-node))) |
|---|
| 1169 | (is-true (find-if |
|---|
| 1170 | #'(lambda(x) |
|---|
| 1171 | (and (eql (d:instance-of x) type-topic) |
|---|
| 1172 | (eql (d:instance-of (d:parent x) ) |
|---|
| 1173 | type-instance-topic))) |
|---|
| 1174 | (d:player-in-roles second-type))) |
|---|
| 1175 | (is-true (find-if |
|---|
| 1176 | #'(lambda(x) |
|---|
| 1177 | (and (eql (d:instance-of x) supertype-topic) |
|---|
| 1178 | (eql (d:instance-of (d:parent x) ) |
|---|
| 1179 | supertype-subtype-topic))) |
|---|
| 1180 | (d:player-in-roles third-node))) |
|---|
| 1181 | (is-true arc2-occurrence) |
|---|
| 1182 | (is (string= (d:datatype arc2-occurrence) "http://test-tm/dt")) |
|---|
| 1183 | (is-false (d:psis (d:parent arc2-occurrence))) |
|---|
| 1184 | (is (= (length (d::versions (d:parent arc2-occurrence))) 1)) |
|---|
| 1185 | (is (= (d::start-revision |
|---|
| 1186 | (first (d::versions (d:parent arc2-occurrence)))) |
|---|
| 1187 | revision-3)) |
|---|
| 1188 | (is (= (d::end-revision |
|---|
| 1189 | (first (d::versions (d:parent arc2-occurrence)))) 0)) |
|---|
| 1190 | (is-true arc3-occurrence) |
|---|
| 1191 | (is (= (length (d:psis (d:parent arc3-occurrence))))) |
|---|
| 1192 | (is (string= (d:uri (first (d:psis (d:parent arc3-occurrence)))) |
|---|
| 1193 | "http://test-tm/fourth-node")) |
|---|
| 1194 | (is (string= (d:datatype arc3-occurrence) |
|---|
| 1195 | *xml-string*)) |
|---|
| 1196 | (is-true fifth-node) |
|---|
| 1197 | (is (= (length (d:psis fifth-node)) 1)) |
|---|
| 1198 | (is (string= (d:uri (first (d:psis fifth-node))) |
|---|
| 1199 | "http://test-tm#fifth-node")) |
|---|
| 1200 | (is-false (d:occurrences fifth-node)) |
|---|
| 1201 | (is-false (d:names fifth-node)) |
|---|
| 1202 | (is (= (length (d:player-in-roles fifth-node)))) |
|---|
| 1203 | (let ((assoc (d:parent (first (d:player-in-roles |
|---|
| 1204 | fifth-node))))) |
|---|
| 1205 | (is-true assoc) |
|---|
| 1206 | (let ((object-role |
|---|
| 1207 | (find-if |
|---|
| 1208 | #'(lambda(role) |
|---|
| 1209 | (eql (d:instance-of role) |
|---|
| 1210 | (d:get-item-by-psi *rdf2tm-object*))) |
|---|
| 1211 | (d:roles assoc))) |
|---|
| 1212 | (subject-role |
|---|
| 1213 | (find-if |
|---|
| 1214 | #'(lambda(role) |
|---|
| 1215 | (eql (d:instance-of role) |
|---|
| 1216 | (d:get-item-by-psi *rdf2tm-subject*))) |
|---|
| 1217 | (d:roles assoc)))) |
|---|
| 1218 | (is-true object-role) |
|---|
| 1219 | (is-true subject-role) |
|---|
| 1220 | (is (eql (d:player subject-role) fifth-node)) |
|---|
| 1221 | (is-false (d:psis (d:player object-role)))))))))))) |
|---|
| 1222 | (close-tm-store)) |
|---|
| 1223 | |
|---|
| 1224 | |
|---|
| 1225 | (test test-import-dom |
|---|
| 1226 | "Tests the function import-node when used recursively." |
|---|
| 1227 | (let ((db-dir "data_base") |
|---|
| 1228 | (tm-id "http://test-tm/") |
|---|
| 1229 | (revision-1 100) |
|---|
| 1230 | (document-id "doc-id") |
|---|
| 1231 | (doc-1 |
|---|
| 1232 | (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 1233 | "xmlns:arcs=\"http://test/arcs/\">" |
|---|
| 1234 | " <rdf:Description rdf:about=\"first-node\">" |
|---|
| 1235 | " <rdf:type rdf:nodeID=\"second-node\"/>" |
|---|
| 1236 | " <arcs:arc1 rdf:resource=\"third-node\"/>" |
|---|
| 1237 | " <arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>" |
|---|
| 1238 | " <arcs:arc3>" |
|---|
| 1239 | " <rdf:Description>" |
|---|
| 1240 | " <arcs:arc4 rdf:parseType=\"Collection\">" |
|---|
| 1241 | " <rdf:Description rdf:about=\"item-1\"/>" |
|---|
| 1242 | " <rdf:Description rdf:about=\"item-2\">" |
|---|
| 1243 | " <arcs:arc5 rdf:parseType=\"Resource\">" |
|---|
| 1244 | " <arcs:arc6 rdf:resource=\"fourth-node\"/>" |
|---|
| 1245 | " <arcs:arc7>" |
|---|
| 1246 | " <rdf:Description rdf:about=\"fifth-node\"/>" |
|---|
| 1247 | " </arcs:arc7>" |
|---|
| 1248 | " <arcs:arc8 rdf:parseType=\"Collection\" />" |
|---|
| 1249 | " </arcs:arc5>" |
|---|
| 1250 | " </rdf:Description>" |
|---|
| 1251 | " </arcs:arc4>" |
|---|
| 1252 | " </rdf:Description>" |
|---|
| 1253 | " </arcs:arc3>" |
|---|
| 1254 | " </rdf:Description>" |
|---|
| 1255 | " <rdf:Description rdf:nodeID=\"second-node\" />" |
|---|
| 1256 | "</rdf:RDF>"))) |
|---|
| 1257 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 1258 | (is-true dom-1) |
|---|
| 1259 | (is (= (length (dom:child-nodes dom-1)) 1)) |
|---|
| 1260 | (rdf-init-db :db-dir db-dir :start-revision revision-1) |
|---|
| 1261 | (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 1262 | (is (= (length (rdf-importer::child-nodes-or-text rdf-node |
|---|
| 1263 | :trim t)) |
|---|
| 1264 | 2)) |
|---|
| 1265 | (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id |
|---|
| 1266 | :document-id document-id) |
|---|
| 1267 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 41)) |
|---|
| 1268 | (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12)) |
|---|
| 1269 | (setf rdf-importer::*current-xtm* document-id) |
|---|
| 1270 | (is (= (length |
|---|
| 1271 | (intersection |
|---|
| 1272 | (map 'list #'d:instance-of |
|---|
| 1273 | (elephant:get-instances-by-class 'd:AssociationC)) |
|---|
| 1274 | (list |
|---|
| 1275 | (d:get-item-by-id (concat constants::*rdf-nil*) |
|---|
| 1276 | :xtm-id rdf-importer::*rdf-core-xtm*) |
|---|
| 1277 | (d:get-item-by-psi constants::*type-instance-psi*) |
|---|
| 1278 | (dotimes (iter 9) |
|---|
| 1279 | (let ((pos (+ iter 1)) |
|---|
| 1280 | (topics nil)) |
|---|
| 1281 | (when (/= pos 2) |
|---|
| 1282 | (push (get-item-by-id |
|---|
| 1283 | (concat "http://test/arcs/arc" |
|---|
| 1284 | (write-to-string pos))) topics)) |
|---|
| 1285 | topics))))))) |
|---|
| 1286 | (let ((first-node (get-item-by-id "http://test-tm/first-node")) |
|---|
| 1287 | (second-node (get-item-by-id "second-node")) |
|---|
| 1288 | (third-node (get-item-by-id "http://test-tm/third-node")) |
|---|
| 1289 | (fourth-node (get-item-by-id "http://test-tm/fourth-node")) |
|---|
| 1290 | (fifth-node (get-item-by-id "http://test-tm/fifth-node")) |
|---|
| 1291 | (item-1 (get-item-by-id "http://test-tm/item-1")) |
|---|
| 1292 | (item-2 (get-item-by-id "http://test-tm/item-2")) |
|---|
| 1293 | (arc1 (get-item-by-id "http://test/arcs/arc1")) |
|---|
| 1294 | (arc2 (get-item-by-id "http://test/arcs/arc2")) |
|---|
| 1295 | (arc3 (get-item-by-id "http://test/arcs/arc3")) |
|---|
| 1296 | (arc4 (get-item-by-id "http://test/arcs/arc4")) |
|---|
| 1297 | (arc5 (get-item-by-id "http://test/arcs/arc5")) |
|---|
| 1298 | (arc6 (get-item-by-id "http://test/arcs/arc6")) |
|---|
| 1299 | (arc7 (get-item-by-id "http://test/arcs/arc7")) |
|---|
| 1300 | (arc8 (get-item-by-id "http://test/arcs/arc8")) |
|---|
| 1301 | (instance (d:get-item-by-psi constants::*instance-psi*)) |
|---|
| 1302 | (type (d:get-item-by-psi constants::*type-psi*)) |
|---|
| 1303 | (type-instance (d:get-item-by-psi |
|---|
| 1304 | constants:*type-instance-psi*)) |
|---|
| 1305 | (subject (d:get-item-by-psi constants::*rdf2tm-subject*)) |
|---|
| 1306 | (object (d:get-item-by-psi constants::*rdf2tm-object*)) |
|---|
| 1307 | (rdf-first (d:get-item-by-psi constants:*rdf-first*)) |
|---|
| 1308 | (rdf-rest (d:get-item-by-psi constants:*rdf-rest*)) |
|---|
| 1309 | (rdf-nil (d:get-item-by-psi constants:*rdf-nil*))) |
|---|
| 1310 | (is (= (length (d:psis first-node)) 1)) |
|---|
| 1311 | (is (string= (d:uri (first (d:psis first-node))) |
|---|
| 1312 | "http://test-tm/first-node")) |
|---|
| 1313 | (is (= (length (d:psis second-node)) 0)) |
|---|
| 1314 | (is (= (length (d:psis third-node)) 1)) |
|---|
| 1315 | (is (string= (d:uri (first (d:psis third-node))) |
|---|
| 1316 | "http://test-tm/third-node")) |
|---|
| 1317 | (is (= (length (d:psis fourth-node)) 1)) |
|---|
| 1318 | (is (string= (d:uri (first (d:psis fourth-node))) |
|---|
| 1319 | "http://test-tm/fourth-node")) |
|---|
| 1320 | (is (= (length (d:psis fifth-node)) 1)) |
|---|
| 1321 | (is (string= (d:uri (first (d:psis fifth-node))) |
|---|
| 1322 | "http://test-tm/fifth-node")) |
|---|
| 1323 | (is (= (length (d:psis item-1)) 1)) |
|---|
| 1324 | (is (string= (d:uri (first (d:psis item-1))) |
|---|
| 1325 | "http://test-tm/item-1")) |
|---|
| 1326 | (is (= (length (d:psis item-2)) 1)) |
|---|
| 1327 | (is (string= (d:uri (first (d:psis item-2))) |
|---|
| 1328 | "http://test-tm/item-2")) |
|---|
| 1329 | (is (= (length (d:psis arc1)) 1)) |
|---|
| 1330 | (is (string= (d:uri (first (d:psis arc1))) |
|---|
| 1331 | "http://test/arcs/arc1")) |
|---|
| 1332 | (is (= (length (d:psis arc2)) 1)) |
|---|
| 1333 | (is (string= (d:uri (first (d:psis arc2))) |
|---|
| 1334 | "http://test/arcs/arc2")) |
|---|
| 1335 | (is (= (length (d:psis arc3)) 1)) |
|---|
| 1336 | (is (string= (d:uri (first (d:psis arc3))) |
|---|
| 1337 | "http://test/arcs/arc3")) |
|---|
| 1338 | (is (= (length (d:psis arc4)) 1)) |
|---|
| 1339 | (is (string= (d:uri (first (d:psis arc4))) |
|---|
| 1340 | "http://test/arcs/arc4")) |
|---|
| 1341 | (is (= (length (d:psis arc5)) 1)) |
|---|
| 1342 | (is (string= (d:uri (first (d:psis arc5))) |
|---|
| 1343 | "http://test/arcs/arc5")) |
|---|
| 1344 | (is (= (length (d:psis arc6)) 1)) |
|---|
| 1345 | (is (string= (d:uri (first (d:psis arc6))) |
|---|
| 1346 | "http://test/arcs/arc6")) |
|---|
| 1347 | (is (= (length (d:psis arc7)) 1)) |
|---|
| 1348 | (is (string= (d:uri (first (d:psis arc7))) |
|---|
| 1349 | "http://test/arcs/arc7")) |
|---|
| 1350 | (is (= (length (d:psis arc8)) 1)) |
|---|
| 1351 | (is (string= (d:uri (first (d:psis arc8))) |
|---|
| 1352 | "http://test/arcs/arc8")) |
|---|
| 1353 | (is (= (length (d:psis rdf-first)) 1)) |
|---|
| 1354 | (is (string= (d:uri (first (d:psis rdf-first))) |
|---|
| 1355 | constants:*rdf-first*)) |
|---|
| 1356 | (is (= (length (d:psis rdf-rest)) 1)) |
|---|
| 1357 | (is (string= (d:uri (first (d:psis rdf-rest))) |
|---|
| 1358 | constants:*rdf-rest*)) |
|---|
| 1359 | (is (= (length (d:psis rdf-nil)) 1)) |
|---|
| 1360 | (is (string= (d:uri (first (d:psis rdf-nil))) |
|---|
| 1361 | constants:*rdf-nil*)) |
|---|
| 1362 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) |
|---|
| 1363 | 1)) |
|---|
| 1364 | (is (string= (d:charvalue (first (elephant:get-instances-by-class |
|---|
| 1365 | 'd:OccurrenceC))) |
|---|
| 1366 | "123")) |
|---|
| 1367 | (is (string= (d:datatype (first (elephant:get-instances-by-class |
|---|
| 1368 | 'd:OccurrenceC))) |
|---|
| 1369 | "http://test-tm/long")) |
|---|
| 1370 | (is (= (length (d:occurrences first-node)) 1)) |
|---|
| 1371 | (is (= (length (d:player-in-roles first-node)) 3)) |
|---|
| 1372 | (is (= (count-if |
|---|
| 1373 | #'(lambda(x) |
|---|
| 1374 | (or (and (eql (d:instance-of x) instance) |
|---|
| 1375 | (eql (d:instance-of (d:parent x)) |
|---|
| 1376 | type-instance)) |
|---|
| 1377 | (and (eql (d:instance-of x) subject) |
|---|
| 1378 | (eql (d:instance-of (d:parent x)) arc1)) |
|---|
| 1379 | (and (eql (d:instance-of x) subject) |
|---|
| 1380 | (eql (d:instance-of (d:parent x)) arc3)))) |
|---|
| 1381 | (d:player-in-roles first-node)) |
|---|
| 1382 | 3)) |
|---|
| 1383 | (is (= (length (d:player-in-roles second-node)) 1)) |
|---|
| 1384 | (is-true (find-if |
|---|
| 1385 | #'(lambda(x) |
|---|
| 1386 | (and (eql (d:instance-of x) type) |
|---|
| 1387 | (eql (d:instance-of (d:parent x)) |
|---|
| 1388 | type-instance))) |
|---|
| 1389 | (d:player-in-roles second-node))) |
|---|
| 1390 | (is (= (length (d:player-in-roles third-node)) 1)) |
|---|
| 1391 | (is-true (find-if |
|---|
| 1392 | #'(lambda(x) |
|---|
| 1393 | (and (eql (d:instance-of x) object) |
|---|
| 1394 | (eql (d:instance-of (d:parent x)) |
|---|
| 1395 | arc1))) |
|---|
| 1396 | (d:player-in-roles third-node))) |
|---|
| 1397 | (let ((uuid-1 |
|---|
| 1398 | (d:player |
|---|
| 1399 | (find-if |
|---|
| 1400 | #'(lambda(y) |
|---|
| 1401 | (and (eql (d:instance-of y) object) |
|---|
| 1402 | (= 0 (length (d:psis (d:player y)))))) |
|---|
| 1403 | (d:roles |
|---|
| 1404 | (d:parent |
|---|
| 1405 | (find-if |
|---|
| 1406 | #'(lambda(x) |
|---|
| 1407 | (and (eql (d:instance-of x) subject) |
|---|
| 1408 | (eql (d:instance-of (d:parent x)) arc3))) |
|---|
| 1409 | (d:player-in-roles first-node)))))))) |
|---|
| 1410 | (is-true uuid-1) |
|---|
| 1411 | (is (= (length (d:player-in-roles uuid-1)) 2)) |
|---|
| 1412 | (is-true (find-if |
|---|
| 1413 | #'(lambda(x) |
|---|
| 1414 | (and (eql (d:instance-of x) subject) |
|---|
| 1415 | (eql (d:instance-of (d:parent x)) arc4))) |
|---|
| 1416 | (d:player-in-roles uuid-1))) |
|---|
| 1417 | (let ((col-1 |
|---|
| 1418 | (d:player |
|---|
| 1419 | (find-if |
|---|
| 1420 | #'(lambda(y) |
|---|
| 1421 | (and (eql (d:instance-of y) object) |
|---|
| 1422 | (= 0 (length (d:psis (d:player y)))))) |
|---|
| 1423 | (d:roles |
|---|
| 1424 | (d:parent |
|---|
| 1425 | (find-if |
|---|
| 1426 | #'(lambda(x) |
|---|
| 1427 | (and (eql (d:instance-of x) subject) |
|---|
| 1428 | (eql (d:instance-of (d:parent x)) arc4))) |
|---|
| 1429 | (d:player-in-roles uuid-1)))))))) |
|---|
| 1430 | (is-true col-1) |
|---|
| 1431 | (is (= (length (d:player-in-roles col-1)) 3)) |
|---|
| 1432 | (is-true (find-if |
|---|
| 1433 | #'(lambda(x) |
|---|
| 1434 | (and (eql (d:instance-of x) subject) |
|---|
| 1435 | (eql (d:instance-of (d:parent x)) |
|---|
| 1436 | rdf-first))) |
|---|
| 1437 | (d:player-in-roles col-1))) |
|---|
| 1438 | (is-true (find-if |
|---|
| 1439 | #'(lambda(x) |
|---|
| 1440 | (and (eql (d:instance-of x) subject) |
|---|
| 1441 | (eql (d:instance-of (d:parent x)) |
|---|
| 1442 | rdf-rest))) |
|---|
| 1443 | (d:player-in-roles col-1))) |
|---|
| 1444 | (is-true (find-if |
|---|
| 1445 | #'(lambda(x) |
|---|
| 1446 | (and (eql (d:instance-of x) object) |
|---|
| 1447 | (eql (d:instance-of (d:parent x)) |
|---|
| 1448 | arc4))) |
|---|
| 1449 | (d:player-in-roles col-1))) |
|---|
| 1450 | (is (= (length (d:player-in-roles item-1)) 1)) |
|---|
| 1451 | (is-true (find-if |
|---|
| 1452 | #'(lambda(x) |
|---|
| 1453 | (and (eql (d:instance-of x) object) |
|---|
| 1454 | (eql (d:instance-of (d:parent x)) |
|---|
| 1455 | rdf-first))) |
|---|
| 1456 | (d:player-in-roles item-1))) |
|---|
| 1457 | (let ((col-2 |
|---|
| 1458 | (let ((role |
|---|
| 1459 | (find-if |
|---|
| 1460 | #'(lambda(x) |
|---|
| 1461 | (and (eql (d:instance-of x) subject) |
|---|
| 1462 | (eql (d:instance-of (d:parent x)) |
|---|
| 1463 | rdf-rest))) |
|---|
| 1464 | (d:player-in-roles col-1)))) |
|---|
| 1465 | (is (= (length (d:roles (d:parent role))) 2)) |
|---|
| 1466 | (let ((other-role |
|---|
| 1467 | (find-if #'(lambda(x) |
|---|
| 1468 | (and (not (eql x role)) |
|---|
| 1469 | (eql (d:instance-of x) |
|---|
| 1470 | object))) |
|---|
| 1471 | (d:roles (d:parent role))))) |
|---|
| 1472 | (d:player other-role))))) |
|---|
| 1473 | (is-true col-2) |
|---|
| 1474 | (is (= (length (d:psis col-2)) 0)) |
|---|
| 1475 | (is (= (length (d:player-in-roles col-2)) 3)) |
|---|
| 1476 | (is-true (find-if |
|---|
| 1477 | #'(lambda(x) |
|---|
| 1478 | (and (eql (d:instance-of x) subject) |
|---|
| 1479 | (eql (d:instance-of (d:parent x)) |
|---|
| 1480 | rdf-first))) |
|---|
| 1481 | (d:player-in-roles col-2))) |
|---|
| 1482 | (is-true (find-if |
|---|
| 1483 | #'(lambda(x) |
|---|
| 1484 | (and (eql (d:instance-of x) subject) |
|---|
| 1485 | (eql (d:instance-of (d:parent x)) |
|---|
| 1486 | rdf-rest))) |
|---|
| 1487 | (d:player-in-roles col-2))) |
|---|
| 1488 | (let ((col-3 |
|---|
| 1489 | (let ((role |
|---|
| 1490 | (find-if |
|---|
| 1491 | #'(lambda(x) |
|---|
| 1492 | (and (eql (d:instance-of x) subject) |
|---|
| 1493 | (eql (d:instance-of (d:parent x)) |
|---|
| 1494 | rdf-rest))) |
|---|
| 1495 | (d:player-in-roles col-2)))) |
|---|
| 1496 | |
|---|
| 1497 | (is (= (length (d:roles (d:parent role))) 2)) |
|---|
| 1498 | (let ((other-role |
|---|
| 1499 | (find-if |
|---|
| 1500 | #'(lambda(x) |
|---|
| 1501 | (not (eql x role))) |
|---|
| 1502 | (d:roles (d:parent role))))) |
|---|
| 1503 | (d:player other-role))))) |
|---|
| 1504 | (is-true col-3) |
|---|
| 1505 | (is (= (length (d:psis col-3)) 1)) |
|---|
| 1506 | (is (string= (d:uri (first (d:psis col-3))) |
|---|
| 1507 | constants:*rdf-nil*)) |
|---|
| 1508 | (is (= (length (d:player-in-roles col-3)) 2))))) |
|---|
| 1509 | (is (= (length (d:player-in-roles item-1)) 1)) |
|---|
| 1510 | (is (= (length (d:player-in-roles item-2)) 2)) |
|---|
| 1511 | (is-true (find-if |
|---|
| 1512 | #'(lambda(x) |
|---|
| 1513 | (and (eql (d:instance-of x) subject) |
|---|
| 1514 | (eql (d:instance-of (d:parent x)) arc5))) |
|---|
| 1515 | (d:player-in-roles item-2))) |
|---|
| 1516 | (let ((uuid-2 |
|---|
| 1517 | (d:player |
|---|
| 1518 | (find-if |
|---|
| 1519 | #'(lambda(y) |
|---|
| 1520 | (and (eql (d:instance-of y) object) |
|---|
| 1521 | (= 0 (length (d:psis (d:player y)))))) |
|---|
| 1522 | (d:roles |
|---|
| 1523 | (d:parent |
|---|
| 1524 | (find-if |
|---|
| 1525 | #'(lambda(x) |
|---|
| 1526 | (and (eql (d:instance-of x) subject) |
|---|
| 1527 | (eql (d:instance-of (d:parent x)) arc5))) |
|---|
| 1528 | (d:player-in-roles item-2)))))))) |
|---|
| 1529 | (is-true uuid-2) |
|---|
| 1530 | (is (= (length (d:player-in-roles uuid-2)) 4)) |
|---|
| 1531 | (is (= (count-if |
|---|
| 1532 | #'(lambda(x) |
|---|
| 1533 | (or (and (eql (d:instance-of x) object) |
|---|
| 1534 | (eql (d:instance-of (d:parent x)) arc5)) |
|---|
| 1535 | (and (eql (d:instance-of x) subject) |
|---|
| 1536 | (or |
|---|
| 1537 | (eql (d:instance-of (d:parent x)) arc6) |
|---|
| 1538 | (eql (d:instance-of (d:parent x)) arc7) |
|---|
| 1539 | (eql (d:instance-of |
|---|
| 1540 | (d:parent x)) arc8))))) |
|---|
| 1541 | (d:player-in-roles uuid-2)) |
|---|
| 1542 | 4)) |
|---|
| 1543 | (is (= (length (d:player-in-roles fourth-node)) 1)) |
|---|
| 1544 | (is (= (length (d:player-in-roles fifth-node)) 1)) |
|---|
| 1545 | (let ((col-2 |
|---|
| 1546 | (d:player |
|---|
| 1547 | (find-if |
|---|
| 1548 | #'(lambda(y) |
|---|
| 1549 | (and (eql (d:instance-of y) object) |
|---|
| 1550 | (= 1 (length (d:psis (d:player y)))))) |
|---|
| 1551 | (d:roles |
|---|
| 1552 | (d:parent |
|---|
| 1553 | (find-if |
|---|
| 1554 | #'(lambda(x) |
|---|
| 1555 | (and (eql (d:instance-of x) subject) |
|---|
| 1556 | (eql (d:instance-of (d:parent x)) arc8))) |
|---|
| 1557 | (d:player-in-roles uuid-2)))))))) |
|---|
| 1558 | (is (= (length (d:psis col-2)) 1)) |
|---|
| 1559 | (is (string= constants:*rdf-nil* |
|---|
| 1560 | (d:uri (first (d:psis col-2))))) |
|---|
| 1561 | (is-true col-2) |
|---|
| 1562 | (is (= (length (d:player-in-roles col-2)) 2))))))))) |
|---|
| 1563 | (close-tm-store)) |
|---|
| 1564 | |
|---|
| 1565 | |
|---|
| 1566 | (test test-poems-rdf-occurrences |
|---|
| 1567 | "Tests general functionality of the rdf-importer module with the file |
|---|
| 1568 | poems_light.rdf." |
|---|
| 1569 | (with-fixture rdf-test-db () |
|---|
| 1570 | (let ((topics (elephant:get-instances-by-class 'd:TopicC)) |
|---|
| 1571 | (occs (elephant:get-instances-by-class 'd:OccurrenceC)) |
|---|
| 1572 | (assocs (elephant:get-instances-by-class 'd:AssociationC)) |
|---|
| 1573 | (arcs "http://some.where/relationship/") |
|---|
| 1574 | (goethe "http://some.where/author/Goethe") |
|---|
| 1575 | (weimar "http://some.where/city/Weimar") |
|---|
| 1576 | (berlin "http://some.where/metropolis/Berlin") |
|---|
| 1577 | (frankfurt "http://some.where/metropolis/FrankfurtMain") |
|---|
| 1578 | (germany "http://some.where/country/Germany") |
|---|
| 1579 | (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") |
|---|
| 1580 | (prometheus "http://some.where/poem/Prometheus") |
|---|
| 1581 | (erlkoenig "http://some.where/ballad/Der_Erlkoenig") |
|---|
| 1582 | (date "http://www.w3.org/2001/XMLSchema#date") |
|---|
| 1583 | (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope/de")) |
|---|
| 1584 | (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) |
|---|
| 1585 | (is (= (length topics) 66)) |
|---|
| 1586 | (is (= (length occs) 23)) |
|---|
| 1587 | (is (= (length assocs) 30)) |
|---|
| 1588 | (is-true de) |
|---|
| 1589 | (is (= (count-if |
|---|
| 1590 | #'(lambda(x) |
|---|
| 1591 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1592 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1593 | (concat arcs "firstName")) |
|---|
| 1594 | (string= *xml-string* (d:datatype x)) |
|---|
| 1595 | (= (length (d:themes x)) 0) |
|---|
| 1596 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1597 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1598 | goethe))) |
|---|
| 1599 | occs) |
|---|
| 1600 | 1)) |
|---|
| 1601 | (is (= (count-if |
|---|
| 1602 | #'(lambda(x) |
|---|
| 1603 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1604 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1605 | (concat arcs "lastName")) |
|---|
| 1606 | (string= *xml-string* (d:datatype x)) |
|---|
| 1607 | (= (length (d:themes x)) 0) |
|---|
| 1608 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1609 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1610 | goethe))) |
|---|
| 1611 | occs) |
|---|
| 1612 | 1)) |
|---|
| 1613 | (is (= (count-if |
|---|
| 1614 | #'(lambda(x) |
|---|
| 1615 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1616 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1617 | (concat arcs "fullName")) |
|---|
| 1618 | (string= *xml-string* (d:datatype x)) |
|---|
| 1619 | (= (length (d:themes x)) 0) |
|---|
| 1620 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1621 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1622 | weimar))) |
|---|
| 1623 | occs) |
|---|
| 1624 | 1)) |
|---|
| 1625 | (is (= (count-if |
|---|
| 1626 | #'(lambda(x) |
|---|
| 1627 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1628 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1629 | (concat arcs "fullName")) |
|---|
| 1630 | (string= *xml-string* (d:datatype x)) |
|---|
| 1631 | (= (length (d:themes x)) 0) |
|---|
| 1632 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1633 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1634 | frankfurt))) |
|---|
| 1635 | occs) |
|---|
| 1636 | 1)) |
|---|
| 1637 | (is (= (count-if |
|---|
| 1638 | #'(lambda(x) |
|---|
| 1639 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1640 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1641 | (concat arcs "nativeName")) |
|---|
| 1642 | (string= *xml-string* (d:datatype x)) |
|---|
| 1643 | (= 1 (length (d:themes x))) |
|---|
| 1644 | (eql (first (d:themes x)) de) |
|---|
| 1645 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1646 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1647 | germany))) |
|---|
| 1648 | occs) |
|---|
| 1649 | 1)) |
|---|
| 1650 | (is (= (count-if |
|---|
| 1651 | #'(lambda(x) |
|---|
| 1652 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1653 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1654 | (concat arcs "title")) |
|---|
| 1655 | (string= *xml-string* (d:datatype x)) |
|---|
| 1656 | (string= (d:charvalue x) "Der Zauberlehrling") |
|---|
| 1657 | (= 1 (length (d:themes x))) |
|---|
| 1658 | (eql (first (d:themes x)) de) |
|---|
| 1659 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1660 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1661 | zauberlehrling))) |
|---|
| 1662 | occs) |
|---|
| 1663 | 1)) |
|---|
| 1664 | (is (= (count-if |
|---|
| 1665 | #'(lambda(x) |
|---|
| 1666 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1667 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1668 | (concat arcs "title")) |
|---|
| 1669 | (= 0 (length (d:themes x))) |
|---|
| 1670 | (string= (d:charvalue x) "Prometheus") |
|---|
| 1671 | (string= *xml-string* (d:datatype x)) |
|---|
| 1672 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1673 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1674 | prometheus))) |
|---|
| 1675 | occs) |
|---|
| 1676 | 1)) |
|---|
| 1677 | (is (= (count-if |
|---|
| 1678 | #'(lambda(x) |
|---|
| 1679 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1680 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1681 | (concat arcs "title")) |
|---|
| 1682 | (string= *xml-string* (d:datatype x)) |
|---|
| 1683 | (string= (d:charvalue x) "Der Erlkönig") |
|---|
| 1684 | (= 1 (length (d:themes x))) |
|---|
| 1685 | (eql (first (d:themes x)) de) |
|---|
| 1686 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1687 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1688 | erlkoenig))) |
|---|
| 1689 | occs) |
|---|
| 1690 | 1)) |
|---|
| 1691 | (is (= (count-if |
|---|
| 1692 | #'(lambda(x) |
|---|
| 1693 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1694 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1695 | (concat arcs "content")) |
|---|
| 1696 | (string= *xml-string* (d:datatype x)) |
|---|
| 1697 | (string= (d:charvalue x) "Hat der alte Hexenmeister ...") |
|---|
| 1698 | (= 1 (length (d:themes x))) |
|---|
| 1699 | (eql (first (d:themes x)) de) |
|---|
| 1700 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1701 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1702 | zauberlehrling))) |
|---|
| 1703 | occs) |
|---|
| 1704 | 1)) |
|---|
| 1705 | (is (= (count-if |
|---|
| 1706 | #'(lambda(x) |
|---|
| 1707 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1708 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1709 | (concat arcs "content")) |
|---|
| 1710 | (string= *xml-string* (d:datatype x)) |
|---|
| 1711 | (string= (d:charvalue x) |
|---|
| 1712 | " Bedecke deinen Himmel, Zeus, ... ") |
|---|
| 1713 | (= 1 (length (d:themes x))) |
|---|
| 1714 | (eql (first (d:themes x)) de) |
|---|
| 1715 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1716 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1717 | prometheus))) |
|---|
| 1718 | occs) |
|---|
| 1719 | 1)) |
|---|
| 1720 | (is (= (count-if |
|---|
| 1721 | #'(lambda(x) |
|---|
| 1722 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1723 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1724 | (concat arcs "content")) |
|---|
| 1725 | (string= *xml-string* (d:datatype x)) |
|---|
| 1726 | (string= (d:charvalue x) |
|---|
| 1727 | "Wer reitet so spÀt durch Nacht und Wind? ...") |
|---|
| 1728 | (= 1 (length (d:themes x))) |
|---|
| 1729 | (eql (first (d:themes x)) de) |
|---|
| 1730 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1731 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1732 | erlkoenig))) |
|---|
| 1733 | occs) |
|---|
| 1734 | 1)) |
|---|
| 1735 | (is (= (count-if |
|---|
| 1736 | #'(lambda(x) |
|---|
| 1737 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1738 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1739 | (concat arcs "population")) |
|---|
| 1740 | (string= long (d:datatype x)) |
|---|
| 1741 | (= 0 (length (d:themes x))) |
|---|
| 1742 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1743 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1744 | weimar))) |
|---|
| 1745 | occs) |
|---|
| 1746 | 1)) |
|---|
| 1747 | (is (= (count-if |
|---|
| 1748 | #'(lambda(x) |
|---|
| 1749 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1750 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1751 | (concat arcs "population")) |
|---|
| 1752 | (string= long (d:datatype x)) |
|---|
| 1753 | (= 0 (length (d:themes x))) |
|---|
| 1754 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1755 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1756 | frankfurt))) |
|---|
| 1757 | occs) |
|---|
| 1758 | 1)) |
|---|
| 1759 | (is (= (count-if |
|---|
| 1760 | #'(lambda(x) |
|---|
| 1761 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1762 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1763 | (concat arcs "population")) |
|---|
| 1764 | (string= long (d:datatype x)) |
|---|
| 1765 | (= 0 (length (d:themes x))) |
|---|
| 1766 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1767 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1768 | berlin))) |
|---|
| 1769 | occs) |
|---|
| 1770 | 1)) |
|---|
| 1771 | (is (= (count-if |
|---|
| 1772 | #'(lambda(x) |
|---|
| 1773 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1774 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1775 | (concat arcs "population")) |
|---|
| 1776 | (string= long (d:datatype x)) |
|---|
| 1777 | (= 0 (length (d:themes x))) |
|---|
| 1778 | (= (length (d:psis (d:parent x))) 1) |
|---|
| 1779 | (string= (d:uri (first (d:psis (d:parent x)))) |
|---|
| 1780 | germany))) |
|---|
| 1781 | occs) |
|---|
| 1782 | 1)) |
|---|
| 1783 | (is (= (count-if |
|---|
| 1784 | #'(lambda(x) |
|---|
| 1785 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1786 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1787 | (concat arcs "date")) |
|---|
| 1788 | (string= date (d:datatype x)) |
|---|
| 1789 | (= 0 (length (d:themes x))) |
|---|
| 1790 | (= (length (d:psis (d:parent x))) 0))) |
|---|
| 1791 | occs) |
|---|
| 1792 | 2)) |
|---|
| 1793 | (is (= (count-if |
|---|
| 1794 | #'(lambda(x) |
|---|
| 1795 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1796 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1797 | (concat arcs "start")) |
|---|
| 1798 | (string= date (d:datatype x)) |
|---|
| 1799 | (= 1 (length (d:themes x))) |
|---|
| 1800 | (eql (first (d:themes x)) de) |
|---|
| 1801 | (= (length (d:psis (d:parent x))) 0))) |
|---|
| 1802 | |
|---|
| 1803 | occs) |
|---|
| 1804 | 1)) |
|---|
| 1805 | (is (= (count-if |
|---|
| 1806 | #'(lambda(x) |
|---|
| 1807 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1808 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1809 | (concat arcs "start")) |
|---|
| 1810 | (string= date (d:datatype x)) |
|---|
| 1811 | (= 0 (length (d:themes x))) |
|---|
| 1812 | (= (length (d:psis (d:parent x))) 0))) |
|---|
| 1813 | |
|---|
| 1814 | occs) |
|---|
| 1815 | 2)) |
|---|
| 1816 | (is (= (count-if |
|---|
| 1817 | #'(lambda(x) |
|---|
| 1818 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1819 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1820 | (concat arcs "end")) |
|---|
| 1821 | (string= date (d:datatype x)) |
|---|
| 1822 | (= 1 (length (d:themes x))) |
|---|
| 1823 | (eql (first (d:themes x)) de) |
|---|
| 1824 | (= (length (d:psis (d:parent x))) 0))) |
|---|
| 1825 | occs) |
|---|
| 1826 | 1)) |
|---|
| 1827 | (is (= (count-if |
|---|
| 1828 | #'(lambda(x) |
|---|
| 1829 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1830 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1831 | (concat arcs "end")) |
|---|
| 1832 | (string= date (d:datatype x)) |
|---|
| 1833 | (= 0 (length (d:themes x))) |
|---|
| 1834 | (= (length (d:psis (d:parent x))) 0))) |
|---|
| 1835 | occs) |
|---|
| 1836 | 2))))) |
|---|
| 1837 | |
|---|
| 1838 | |
|---|
| 1839 | (test test-poems-rdf-associations |
|---|
| 1840 | "Tests general functionality of the rdf-importer module with the file |
|---|
| 1841 | poems_light.rdf." |
|---|
| 1842 | (with-fixture rdf-test-db () |
|---|
| 1843 | (let ((assocs (elephant:get-instances-by-class 'd:AssociationC)) |
|---|
| 1844 | (isi-object (d:get-item-by-psi constants::*rdf2tm-object*)) |
|---|
| 1845 | (isi-subject (d:get-item-by-psi constants::*rdf2tm-subject*)) |
|---|
| 1846 | (arcs "http://some.where/relationship/") |
|---|
| 1847 | (goethe "http://some.where/author/Goethe") |
|---|
| 1848 | (germany "http://some.where/country/Germany") |
|---|
| 1849 | (berlin "http://some.where/metropolis/Berlin") |
|---|
| 1850 | (german "http://some.where/language/German") |
|---|
| 1851 | (frankfurt "http://some.where/metropolis/FrankfurtMain") |
|---|
| 1852 | (weimar "http://some.where/city/Weimar") |
|---|
| 1853 | (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") |
|---|
| 1854 | (prometheus "http://some.where/poem/Prometheus") |
|---|
| 1855 | (erlkoenig "http://some.where/ballad/Der_Erlkoenig")) |
|---|
| 1856 | (is (= (count-if |
|---|
| 1857 | #'(lambda(x) |
|---|
| 1858 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1859 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1860 | (concat arcs "born")) |
|---|
| 1861 | (= (length (d:roles x)) 2) |
|---|
| 1862 | (find-if |
|---|
| 1863 | #'(lambda(y) |
|---|
| 1864 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1865 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1866 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1867 | goethe))) |
|---|
| 1868 | (d:roles x)) |
|---|
| 1869 | (find-if |
|---|
| 1870 | #'(lambda(y) |
|---|
| 1871 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1872 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 1873 | (d:roles x)))) |
|---|
| 1874 | assocs) |
|---|
| 1875 | 1)) |
|---|
| 1876 | (is (= (count-if |
|---|
| 1877 | #'(lambda(x) |
|---|
| 1878 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1879 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1880 | (concat arcs "died")) |
|---|
| 1881 | (find-if |
|---|
| 1882 | #'(lambda(y) |
|---|
| 1883 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1884 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1885 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1886 | goethe))) |
|---|
| 1887 | (d:roles x)) |
|---|
| 1888 | (find-if |
|---|
| 1889 | #'(lambda(y) |
|---|
| 1890 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1891 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 1892 | (d:roles x)))) |
|---|
| 1893 | assocs) |
|---|
| 1894 | 1)) |
|---|
| 1895 | (is (= (count-if |
|---|
| 1896 | #'(lambda(x) |
|---|
| 1897 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1898 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1899 | (concat arcs "wrote")) |
|---|
| 1900 | (find-if |
|---|
| 1901 | #'(lambda(y) |
|---|
| 1902 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1903 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1904 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1905 | goethe))) |
|---|
| 1906 | (d:roles x)) |
|---|
| 1907 | (find-if |
|---|
| 1908 | #'(lambda(y) |
|---|
| 1909 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1910 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 1911 | (d:roles x)))) |
|---|
| 1912 | assocs) |
|---|
| 1913 | 1)) |
|---|
| 1914 | (is (= (count-if |
|---|
| 1915 | #'(lambda(x) |
|---|
| 1916 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1917 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1918 | (concat arcs "capital")) |
|---|
| 1919 | (find-if |
|---|
| 1920 | #'(lambda(y) |
|---|
| 1921 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1922 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1923 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1924 | germany))) |
|---|
| 1925 | (d:roles x)) |
|---|
| 1926 | (find-if |
|---|
| 1927 | #'(lambda(y) |
|---|
| 1928 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1929 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1930 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1931 | berlin))) |
|---|
| 1932 | (d:roles x)))) |
|---|
| 1933 | assocs) |
|---|
| 1934 | 1)) |
|---|
| 1935 | (is (= (count-if |
|---|
| 1936 | #'(lambda(x) |
|---|
| 1937 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1938 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1939 | (concat arcs "officialese")) |
|---|
| 1940 | (find-if |
|---|
| 1941 | #'(lambda(y) |
|---|
| 1942 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1943 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1944 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1945 | germany))) |
|---|
| 1946 | (d:roles x)) |
|---|
| 1947 | (find-if |
|---|
| 1948 | #'(lambda(y) |
|---|
| 1949 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1950 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1951 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1952 | german))) |
|---|
| 1953 | (d:roles x)))) |
|---|
| 1954 | assocs) |
|---|
| 1955 | 1)) |
|---|
| 1956 | (is (= (count-if |
|---|
| 1957 | #'(lambda(x) |
|---|
| 1958 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1959 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1960 | (concat arcs "place")) |
|---|
| 1961 | (find-if |
|---|
| 1962 | #'(lambda(y) |
|---|
| 1963 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1964 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1965 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1966 | frankfurt))) |
|---|
| 1967 | (d:roles x)) |
|---|
| 1968 | (find-if |
|---|
| 1969 | #'(lambda(y) |
|---|
| 1970 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1971 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 1972 | (d:roles x)))) |
|---|
| 1973 | assocs) |
|---|
| 1974 | 1)) |
|---|
| 1975 | (is (= (count-if |
|---|
| 1976 | #'(lambda(x) |
|---|
| 1977 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1978 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1979 | (concat arcs "place")) |
|---|
| 1980 | (find-if |
|---|
| 1981 | #'(lambda(y) |
|---|
| 1982 | (and (eql (d:instance-of y) isi-object) |
|---|
| 1983 | (= (length (d:psis (d:player y))) 1) |
|---|
| 1984 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 1985 | weimar))) |
|---|
| 1986 | (d:roles x)) |
|---|
| 1987 | (find-if |
|---|
| 1988 | #'(lambda(y) |
|---|
| 1989 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 1990 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 1991 | (d:roles x)))) |
|---|
| 1992 | assocs) |
|---|
| 1993 | 1)) |
|---|
| 1994 | (is (= (count-if |
|---|
| 1995 | #'(lambda(x) |
|---|
| 1996 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 1997 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 1998 | (concat arcs "locatedIn")) |
|---|
| 1999 | (find-if |
|---|
| 2000 | #'(lambda(y) |
|---|
| 2001 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2002 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2003 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2004 | frankfurt))) |
|---|
| 2005 | (d:roles x)) |
|---|
| 2006 | (find-if |
|---|
| 2007 | #'(lambda(y) |
|---|
| 2008 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2009 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2010 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2011 | germany))) |
|---|
| 2012 | (d:roles x)))) |
|---|
| 2013 | assocs) |
|---|
| 2014 | 1)) |
|---|
| 2015 | (is (= (count-if |
|---|
| 2016 | #'(lambda(x) |
|---|
| 2017 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2018 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2019 | (concat arcs "locatedIn")) |
|---|
| 2020 | (find-if |
|---|
| 2021 | #'(lambda(y) |
|---|
| 2022 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2023 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2024 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2025 | weimar))) |
|---|
| 2026 | (d:roles x)) |
|---|
| 2027 | (find-if |
|---|
| 2028 | #'(lambda(y) |
|---|
| 2029 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2030 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2031 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2032 | germany))) |
|---|
| 2033 | (d:roles x)))) |
|---|
| 2034 | assocs) |
|---|
| 2035 | 1)) |
|---|
| 2036 | (is (= (count-if |
|---|
| 2037 | #'(lambda(x) |
|---|
| 2038 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2039 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2040 | (concat arcs "locatedIn")) |
|---|
| 2041 | (find-if |
|---|
| 2042 | #'(lambda(y) |
|---|
| 2043 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2044 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2045 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2046 | berlin))) |
|---|
| 2047 | (d:roles x)) |
|---|
| 2048 | (find-if |
|---|
| 2049 | #'(lambda(y) |
|---|
| 2050 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2051 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2052 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2053 | germany))) |
|---|
| 2054 | (d:roles x)))) |
|---|
| 2055 | assocs) |
|---|
| 2056 | 1)) |
|---|
| 2057 | (is (= (count-if |
|---|
| 2058 | #'(lambda(x) |
|---|
| 2059 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2060 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2061 | (concat arcs "dateRange")) |
|---|
| 2062 | (find-if |
|---|
| 2063 | #'(lambda(y) |
|---|
| 2064 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2065 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2066 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2067 | prometheus))) |
|---|
| 2068 | (d:roles x)) |
|---|
| 2069 | (find-if |
|---|
| 2070 | #'(lambda(y) |
|---|
| 2071 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2072 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2073 | (d:roles x)))) |
|---|
| 2074 | assocs) |
|---|
| 2075 | 1)) |
|---|
| 2076 | (is (= (count-if |
|---|
| 2077 | #'(lambda(x) |
|---|
| 2078 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2079 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2080 | (concat arcs "dateRange")) |
|---|
| 2081 | (find-if |
|---|
| 2082 | #'(lambda(y) |
|---|
| 2083 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2084 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2085 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2086 | zauberlehrling))) |
|---|
| 2087 | (d:roles x)) |
|---|
| 2088 | (find-if |
|---|
| 2089 | #'(lambda(y) |
|---|
| 2090 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2091 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2092 | (d:roles x)))) |
|---|
| 2093 | assocs) |
|---|
| 2094 | 1)) |
|---|
| 2095 | (is (= (count-if |
|---|
| 2096 | #'(lambda(x) |
|---|
| 2097 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2098 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2099 | (concat arcs "dateRange")) |
|---|
| 2100 | (find-if |
|---|
| 2101 | #'(lambda(y) |
|---|
| 2102 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2103 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2104 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2105 | erlkoenig))) |
|---|
| 2106 | (d:roles x)) |
|---|
| 2107 | (find-if |
|---|
| 2108 | #'(lambda(y) |
|---|
| 2109 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2110 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2111 | (d:roles x)))) |
|---|
| 2112 | assocs) |
|---|
| 2113 | 1)) |
|---|
| 2114 | (is (= (count-if |
|---|
| 2115 | #'(lambda(x) |
|---|
| 2116 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2117 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2118 | (concat constants:*rdf-ns* "_1")) |
|---|
| 2119 | (find-if |
|---|
| 2120 | #'(lambda(y) |
|---|
| 2121 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2122 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2123 | (d:roles x)) |
|---|
| 2124 | (find-if |
|---|
| 2125 | #'(lambda(y) |
|---|
| 2126 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2127 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2128 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2129 | zauberlehrling))) |
|---|
| 2130 | (d:roles x)))) |
|---|
| 2131 | assocs) |
|---|
| 2132 | 1)) |
|---|
| 2133 | (is (= (count-if |
|---|
| 2134 | #'(lambda(x) |
|---|
| 2135 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2136 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2137 | (concat constants:*rdf-ns* "_2")) |
|---|
| 2138 | (find-if |
|---|
| 2139 | #'(lambda(y) |
|---|
| 2140 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2141 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2142 | (d:roles x)) |
|---|
| 2143 | (find-if |
|---|
| 2144 | #'(lambda(y) |
|---|
| 2145 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2146 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2147 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2148 | erlkoenig))) |
|---|
| 2149 | (d:roles x)))) |
|---|
| 2150 | assocs) |
|---|
| 2151 | 1)) |
|---|
| 2152 | (is (= (count-if |
|---|
| 2153 | #'(lambda(x) |
|---|
| 2154 | (and (= (length (d:psis (d:instance-of x))) 1) |
|---|
| 2155 | (string= (d:uri (first (d:psis (d:instance-of x)))) |
|---|
| 2156 | (concat constants:*rdf-ns* "_3")) |
|---|
| 2157 | (find-if |
|---|
| 2158 | #'(lambda(y) |
|---|
| 2159 | (and (eql (d:instance-of y) isi-subject) |
|---|
| 2160 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2161 | (d:roles x)) |
|---|
| 2162 | (find-if |
|---|
| 2163 | #'(lambda(y) |
|---|
| 2164 | (and (eql (d:instance-of y) isi-object) |
|---|
| 2165 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2166 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2167 | prometheus))) |
|---|
| 2168 | (d:roles x)))) |
|---|
| 2169 | assocs) |
|---|
| 2170 | 1))))) |
|---|
| 2171 | |
|---|
| 2172 | |
|---|
| 2173 | (test test-poems-rdf-typing |
|---|
| 2174 | "Tests general functionality of the rdf-importer module with the file |
|---|
| 2175 | poems_light.rdf." |
|---|
| 2176 | (with-fixture rdf-test-db () |
|---|
| 2177 | (let ((assocs (elephant:get-instances-by-class 'd:AssociationC)) |
|---|
| 2178 | (type (get-item-by-psi constants:*type-psi*)) |
|---|
| 2179 | (instance (get-item-by-psi constants:*instance-psi*)) |
|---|
| 2180 | (type-instance (get-item-by-psi constants:*type-instance-psi*)) |
|---|
| 2181 | (subtype (get-item-by-psi constants:*subtype-psi*)) |
|---|
| 2182 | (supertype (get-item-by-psi constants:*supertype-psi*)) |
|---|
| 2183 | (supertype-subtype |
|---|
| 2184 | (get-item-by-psi constants:*supertype-subtype-psi*)) |
|---|
| 2185 | (region "http://some.where/types/Region") |
|---|
| 2186 | (metropolis "http://some.where/types/Metropolis") |
|---|
| 2187 | (city "http://some.where/types/City") |
|---|
| 2188 | (frankfurt "http://some.where/metropolis/FrankfurtMain") |
|---|
| 2189 | (weimar "http://some.where/city/Weimar") |
|---|
| 2190 | (berlin "http://some.where/metropolis/Berlin") |
|---|
| 2191 | (language "http://some.where/types/Language") |
|---|
| 2192 | (german "http://some.where/language/German") |
|---|
| 2193 | (author "http://some.where/types/Author") |
|---|
| 2194 | (goethe "http://some.where/author/Goethe") |
|---|
| 2195 | (bag (concat constants::*rdf-ns* "Bag")) |
|---|
| 2196 | (poem "http://some.where/types/Poem") |
|---|
| 2197 | (ballad "http://some.where/types/Ballad") |
|---|
| 2198 | (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") |
|---|
| 2199 | (prometheus "http://some.where/poem/Prometheus") |
|---|
| 2200 | (erlkoenig "http://some.where/ballad/Der_Erlkoenig") |
|---|
| 2201 | (country "http://some.where/types/Country")) |
|---|
| 2202 | (is (= (count-if |
|---|
| 2203 | #'(lambda(x) |
|---|
| 2204 | (and (eql (d:instance-of x) supertype-subtype) |
|---|
| 2205 | (= (length (d:roles x)) 2) |
|---|
| 2206 | (= (count-if |
|---|
| 2207 | #'(lambda(y) |
|---|
| 2208 | (or (eql (d:instance-of y) supertype) |
|---|
| 2209 | (eql (d:instance-of y) subtype))) |
|---|
| 2210 | (d:roles x))))) |
|---|
| 2211 | assocs))) |
|---|
| 2212 | (is (= (count-if |
|---|
| 2213 | #'(lambda(x) |
|---|
| 2214 | (and (eql (d:instance-of x) supertype-subtype) |
|---|
| 2215 | (= (length (d:roles x)) 2) |
|---|
| 2216 | (find-if |
|---|
| 2217 | #'(lambda(y) |
|---|
| 2218 | (and (eql (d:instance-of y) supertype) |
|---|
| 2219 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2220 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2221 | region))) |
|---|
| 2222 | (d:roles x)) |
|---|
| 2223 | (find-if |
|---|
| 2224 | #'(lambda(y) |
|---|
| 2225 | (and (eql (d:instance-of y) subtype) |
|---|
| 2226 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2227 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2228 | metropolis))) |
|---|
| 2229 | (d:roles x)))) |
|---|
| 2230 | assocs))) |
|---|
| 2231 | (is (= (count-if |
|---|
| 2232 | #'(lambda(x) |
|---|
| 2233 | (and (eql (d:instance-of x) supertype-subtype) |
|---|
| 2234 | (= (length (d:roles x)) 2) |
|---|
| 2235 | (find-if |
|---|
| 2236 | #'(lambda(y) |
|---|
| 2237 | (and (eql (d:instance-of y) supertype) |
|---|
| 2238 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2239 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2240 | region))) |
|---|
| 2241 | (d:roles x)) |
|---|
| 2242 | (find-if |
|---|
| 2243 | #'(lambda(y) |
|---|
| 2244 | (and (eql (d:instance-of y) subtype) |
|---|
| 2245 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2246 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2247 | city))) |
|---|
| 2248 | (d:roles x)))) |
|---|
| 2249 | assocs))) |
|---|
| 2250 | (is (= (count-if |
|---|
| 2251 | #'(lambda(x) |
|---|
| 2252 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2253 | (= (length (d:roles x)) 2) |
|---|
| 2254 | (find-if |
|---|
| 2255 | #'(lambda(y) |
|---|
| 2256 | (and (eql (d:instance-of y) type) |
|---|
| 2257 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2258 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2259 | metropolis))) |
|---|
| 2260 | (d:roles x)) |
|---|
| 2261 | (find-if |
|---|
| 2262 | #'(lambda(y) |
|---|
| 2263 | (and (eql (d:instance-of y) instance) |
|---|
| 2264 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2265 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2266 | frankfurt))) |
|---|
| 2267 | (d:roles x)))) |
|---|
| 2268 | assocs))) |
|---|
| 2269 | (is (= (count-if |
|---|
| 2270 | #'(lambda(x) |
|---|
| 2271 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2272 | (= (length (d:roles x)) 2) |
|---|
| 2273 | (find-if |
|---|
| 2274 | #'(lambda(y) |
|---|
| 2275 | (and (eql (d:instance-of y) type) |
|---|
| 2276 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2277 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2278 | metropolis))) |
|---|
| 2279 | (d:roles x)) |
|---|
| 2280 | (find-if |
|---|
| 2281 | #'(lambda(y) |
|---|
| 2282 | (and (eql (d:instance-of y) instance) |
|---|
| 2283 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2284 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2285 | berlin))) |
|---|
| 2286 | (d:roles x)))) |
|---|
| 2287 | assocs))) |
|---|
| 2288 | (is (= (count-if |
|---|
| 2289 | #'(lambda(x) |
|---|
| 2290 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2291 | (= (length (d:roles x)) 2) |
|---|
| 2292 | (find-if |
|---|
| 2293 | #'(lambda(y) |
|---|
| 2294 | (and (eql (d:instance-of y) type) |
|---|
| 2295 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2296 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2297 | city))) |
|---|
| 2298 | (d:roles x)) |
|---|
| 2299 | (find-if |
|---|
| 2300 | #'(lambda(y) |
|---|
| 2301 | (and (eql (d:instance-of y) instance) |
|---|
| 2302 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2303 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2304 | weimar))) |
|---|
| 2305 | (d:roles x)))) |
|---|
| 2306 | assocs))) |
|---|
| 2307 | (is (= (count-if |
|---|
| 2308 | #'(lambda(x) |
|---|
| 2309 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2310 | (= (length (d:roles x)) 2) |
|---|
| 2311 | (find-if |
|---|
| 2312 | #'(lambda(y) |
|---|
| 2313 | (and (eql (d:instance-of y) type) |
|---|
| 2314 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2315 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2316 | language))) |
|---|
| 2317 | (d:roles x)) |
|---|
| 2318 | (find-if |
|---|
| 2319 | #'(lambda(y) |
|---|
| 2320 | (and (eql (d:instance-of y) instance) |
|---|
| 2321 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2322 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2323 | german))) |
|---|
| 2324 | (d:roles x)))) |
|---|
| 2325 | assocs))) |
|---|
| 2326 | (is (= (count-if |
|---|
| 2327 | #'(lambda(x) |
|---|
| 2328 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2329 | (= (length (d:roles x)) 2) |
|---|
| 2330 | (find-if |
|---|
| 2331 | #'(lambda(y) |
|---|
| 2332 | (and (eql (d:instance-of y) type) |
|---|
| 2333 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2334 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2335 | bag))) |
|---|
| 2336 | (d:roles x)) |
|---|
| 2337 | (find-if |
|---|
| 2338 | #'(lambda(y) |
|---|
| 2339 | (and (eql (d:instance-of y) instance) |
|---|
| 2340 | (= (length (d:psis (d:player y))) 0))) |
|---|
| 2341 | (d:roles x)))) |
|---|
| 2342 | assocs))) |
|---|
| 2343 | (is (= (count-if |
|---|
| 2344 | #'(lambda(x) |
|---|
| 2345 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2346 | (= (length (d:roles x)) 2) |
|---|
| 2347 | (find-if |
|---|
| 2348 | #'(lambda(y) |
|---|
| 2349 | (and (eql (d:instance-of y) type) |
|---|
| 2350 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2351 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2352 | author))) |
|---|
| 2353 | (d:roles x)) |
|---|
| 2354 | (find-if |
|---|
| 2355 | #'(lambda(y) |
|---|
| 2356 | (and (eql (d:instance-of y) instance) |
|---|
| 2357 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2358 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2359 | goethe))) |
|---|
| 2360 | (d:roles x)))) |
|---|
| 2361 | assocs))) |
|---|
| 2362 | (is (= (count-if |
|---|
| 2363 | #'(lambda(x) |
|---|
| 2364 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2365 | (= (length (d:roles x)) 2) |
|---|
| 2366 | (find-if |
|---|
| 2367 | #'(lambda(y) |
|---|
| 2368 | (and (eql (d:instance-of y) type) |
|---|
| 2369 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2370 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2371 | ballad))) |
|---|
| 2372 | (d:roles x)) |
|---|
| 2373 | (find-if |
|---|
| 2374 | #'(lambda(y) |
|---|
| 2375 | (and (eql (d:instance-of y) instance) |
|---|
| 2376 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2377 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2378 | erlkoenig))) |
|---|
| 2379 | (d:roles x)))) |
|---|
| 2380 | assocs))) |
|---|
| 2381 | (is (= (count-if |
|---|
| 2382 | #'(lambda(x) |
|---|
| 2383 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2384 | (= (length (d:roles x)) 2) |
|---|
| 2385 | (find-if |
|---|
| 2386 | #'(lambda(y) |
|---|
| 2387 | (and (eql (d:instance-of y) type) |
|---|
| 2388 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2389 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2390 | poem))) |
|---|
| 2391 | (d:roles x)) |
|---|
| 2392 | (find-if |
|---|
| 2393 | #'(lambda(y) |
|---|
| 2394 | (and (eql (d:instance-of y) instance) |
|---|
| 2395 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2396 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2397 | zauberlehrling))) |
|---|
| 2398 | (d:roles x)))) |
|---|
| 2399 | assocs))) |
|---|
| 2400 | (is (= (count-if |
|---|
| 2401 | #'(lambda(x) |
|---|
| 2402 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2403 | (= (length (d:roles x)) 2) |
|---|
| 2404 | (find-if |
|---|
| 2405 | #'(lambda(y) |
|---|
| 2406 | (and (eql (d:instance-of y) type) |
|---|
| 2407 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2408 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2409 | poem))) |
|---|
| 2410 | (d:roles x)) |
|---|
| 2411 | (find-if |
|---|
| 2412 | #'(lambda(y) |
|---|
| 2413 | (and (eql (d:instance-of y) instance) |
|---|
| 2414 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2415 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2416 | prometheus))) |
|---|
| 2417 | (d:roles x)))) |
|---|
| 2418 | assocs))) |
|---|
| 2419 | (is (= (count-if |
|---|
| 2420 | #'(lambda(x) |
|---|
| 2421 | (and (eql (d:instance-of x) type-instance) |
|---|
| 2422 | (= (length (d:roles x)) 2) |
|---|
| 2423 | (find-if |
|---|
| 2424 | #'(lambda(y) |
|---|
| 2425 | (and (eql (d:instance-of y) type) |
|---|
| 2426 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2427 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2428 | country))) |
|---|
| 2429 | (d:roles x)) |
|---|
| 2430 | (find-if |
|---|
| 2431 | #'(lambda(y) |
|---|
| 2432 | (and (eql (d:instance-of y) instance) |
|---|
| 2433 | (= (length (d:psis (d:player y))) 1) |
|---|
| 2434 | (string= (d:uri (first (d:psis (d:player y)))) |
|---|
| 2435 | poem))) |
|---|
| 2436 | (d:roles x)))) |
|---|
| 2437 | assocs)))))) |
|---|
| 2438 | |
|---|
| 2439 | |
|---|
| 2440 | (defun check-topic (top psi) |
|---|
| 2441 | "A simple helper for test-poems-rdf-topics." |
|---|
| 2442 | (is-true top) |
|---|
| 2443 | (is (= (length (d:psis top)) (if psi 1 0))) |
|---|
| 2444 | (when psi |
|---|
| 2445 | (is (string= (d:uri (first (d:psis top))) psi))) |
|---|
| 2446 | (is (= (length (d:names top)) 0))) |
|---|
| 2447 | |
|---|
| 2448 | |
|---|
| 2449 | (test test-poems-rdf-topics |
|---|
| 2450 | "Tests general functionality of the rdf-importer module with the file |
|---|
| 2451 | poems_light.rdf." |
|---|
| 2452 | (with-fixture rdf-test-db () |
|---|
| 2453 | (let ((arcs "http://some.where/relationship/") |
|---|
| 2454 | (types "http://some.where/types/")) |
|---|
| 2455 | (let ((goethe (get-item-by-id "http://some.where/author/Goethe")) |
|---|
| 2456 | (author (get-item-by-id (concat types "Author"))) |
|---|
| 2457 | (first-name (get-item-by-id |
|---|
| 2458 | (concat arcs "firstName"))) |
|---|
| 2459 | (last-name (get-item-by-id |
|---|
| 2460 | (concat arcs "lastName"))) |
|---|
| 2461 | (born (get-item-by-id (concat arcs "born"))) |
|---|
| 2462 | (event (get-item-by-id (concat types "Event"))) |
|---|
| 2463 | (date (get-item-by-id (concat arcs "date"))) |
|---|
| 2464 | (place (get-item-by-id (concat arcs "place"))) |
|---|
| 2465 | (frankfurt (get-item-by-id |
|---|
| 2466 | "http://some.where/metropolis/FrankfurtMain")) |
|---|
| 2467 | (metropolis (get-item-by-id (concat types |
|---|
| 2468 | "Metropolis"))) |
|---|
| 2469 | (region (get-item-by-id (concat types "Region"))) |
|---|
| 2470 | (population (get-item-by-id (concat arcs |
|---|
| 2471 | "population"))) |
|---|
| 2472 | (locatedIn (get-item-by-id (concat arcs |
|---|
| 2473 | "locatedIn"))) |
|---|
| 2474 | (germany (get-item-by-id "http://some.where/country/Germany")) |
|---|
| 2475 | (country (get-item-by-id (concat types "Country"))) |
|---|
| 2476 | (native-name (get-item-by-id (concat arcs |
|---|
| 2477 | "nativeName"))) |
|---|
| 2478 | (officialese (get-item-by-id (concat arcs |
|---|
| 2479 | "officialese"))) |
|---|
| 2480 | (german (get-item-by-id "http://some.where/language/German")) |
|---|
| 2481 | (capital (get-item-by-id (concat arcs "capital"))) |
|---|
| 2482 | (berlin (get-item-by-id "http://some.where/metropolis/Berlin")) |
|---|
| 2483 | (died (get-item-by-id (concat arcs "died"))) |
|---|
| 2484 | (weimar (get-item-by-id "http://some.where/city/Weimar")) |
|---|
| 2485 | (city (get-item-by-id (concat types "City"))) |
|---|
| 2486 | (wrote (get-item-by-id (concat arcs "wrote"))) |
|---|
| 2487 | (goethe-literature (get-item-by-id "goethe_literature")) |
|---|
| 2488 | (bag (get-item-by-id (concat *rdf-ns* "Bag"))) |
|---|
| 2489 | (_1 (get-item-by-id (concat *rdf-ns* "_1"))) |
|---|
| 2490 | (_2 (get-item-by-id (concat *rdf-ns* "_2"))) |
|---|
| 2491 | (_3 (get-item-by-id (concat *rdf-ns* "_3"))) |
|---|
| 2492 | (zauberlehrling |
|---|
| 2493 | (get-item-by-id "http://some.where/poem/Der_Zauberlehrling")) |
|---|
| 2494 | (poem (get-item-by-id (concat types "Poem"))) |
|---|
| 2495 | (dateRange (get-item-by-id (concat arcs "dateRange"))) |
|---|
| 2496 | (start (get-item-by-id (concat arcs "start"))) |
|---|
| 2497 | (end (get-item-by-id (concat arcs "end"))) |
|---|
| 2498 | (title (get-item-by-id (concat arcs "title"))) |
|---|
| 2499 | (content (get-item-by-id (concat arcs "content"))) |
|---|
| 2500 | (erlkoenig (get-item-by-id "http://some.where/ballad/Der_Erlkoenig")) |
|---|
| 2501 | (ballad (get-item-by-id (concat types "Ballad"))) |
|---|
| 2502 | (de (get-item-by-id (concatenate |
|---|
| 2503 | 'string constants::*rdf2tm-scope-prefix* |
|---|
| 2504 | "de"))) |
|---|
| 2505 | (prometheus (get-item-by-id "http://some.where/poem/Prometheus")) |
|---|
| 2506 | (language (get-item-by-id (concat types "Language"))) |
|---|
| 2507 | (full-name (get-item-by-id (concat arcs "fullName")))) |
|---|
| 2508 | (check-topic goethe "http://some.where/author/Goethe") |
|---|
| 2509 | (check-topic author (concat types "Author")) |
|---|
| 2510 | (check-topic first-name (concat arcs "firstName")) |
|---|
| 2511 | (check-topic last-name (concat arcs "lastName")) |
|---|
| 2512 | (check-topic born (concat arcs "born")) |
|---|
| 2513 | (check-topic event (concat types "Event")) |
|---|
| 2514 | (check-topic date (concat arcs "date")) |
|---|
| 2515 | (check-topic place (concat arcs "place")) |
|---|
| 2516 | (check-topic frankfurt "http://some.where/metropolis/FrankfurtMain") |
|---|
| 2517 | (check-topic metropolis (concat types "Metropolis")) |
|---|
| 2518 | (check-topic region (concat types "Region")) |
|---|
| 2519 | (check-topic population (concat arcs "population")) |
|---|
| 2520 | (check-topic locatedIn (concat arcs "locatedIn")) |
|---|
| 2521 | (check-topic germany "http://some.where/country/Germany") |
|---|
| 2522 | (check-topic country (concat types "Country")) |
|---|
| 2523 | (check-topic native-name (concat arcs "nativeName")) |
|---|
| 2524 | (check-topic officialese (concat arcs "officialese")) |
|---|
| 2525 | (check-topic german "http://some.where/language/German") |
|---|
| 2526 | (check-topic capital (concat arcs "capital")) |
|---|
| 2527 | (check-topic berlin "http://some.where/metropolis/Berlin") |
|---|
| 2528 | (check-topic died (concat arcs "died")) |
|---|
| 2529 | (check-topic weimar "http://some.where/city/Weimar") |
|---|
| 2530 | (check-topic city (concat types "City")) |
|---|
| 2531 | (check-topic wrote (concat arcs "wrote")) |
|---|
| 2532 | (check-topic goethe-literature nil) |
|---|
| 2533 | (check-topic bag (concat *rdf-ns* "Bag")) |
|---|
| 2534 | (check-topic _1 (concat *rdf-ns* "_1")) |
|---|
| 2535 | (check-topic _2 (concat *rdf-ns* "_2")) |
|---|
| 2536 | (check-topic _3 (concat *rdf-ns* "_3")) |
|---|
| 2537 | (check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling") |
|---|
| 2538 | (check-topic poem (concat types "Poem")) |
|---|
| 2539 | (check-topic dateRange (concat arcs "dateRange")) |
|---|
| 2540 | (check-topic start (concat arcs "start")) |
|---|
| 2541 | (check-topic end (concat arcs "end")) |
|---|
| 2542 | (check-topic title (concat arcs "title")) |
|---|
| 2543 | (check-topic content (concat arcs "content")) |
|---|
| 2544 | (check-topic erlkoenig "http://some.where/ballad/Der_Erlkoenig") |
|---|
| 2545 | (check-topic ballad (concat types "Ballad")) |
|---|
| 2546 | (check-topic de (concat constants::*rdf2tm-scope-prefix* |
|---|
| 2547 | "de")) |
|---|
| 2548 | (check-topic prometheus "http://some.where/poem/Prometheus") |
|---|
| 2549 | (check-topic language (concat types "Language")) |
|---|
| 2550 | (check-topic full-name (concat arcs "fullName")) |
|---|
| 2551 | (is (= (count-if #'(lambda(x) |
|---|
| 2552 | (null (d:psis x))) |
|---|
| 2553 | (elephant:get-instances-by-class 'd:TopicC)) |
|---|
| 2554 | 6)))))) |
|---|
| 2555 | |
|---|
| 2556 | |
|---|
| 2557 | (test test-empty-collection |
|---|
| 2558 | "Tests importing of empty collections." |
|---|
| 2559 | (let ((db-dir "data_base") |
|---|
| 2560 | (tm-id "http://test-tm/") |
|---|
| 2561 | (revision-1 100) |
|---|
| 2562 | (document-id "doc-id") |
|---|
| 2563 | (doc-1 |
|---|
| 2564 | (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 2565 | "xmlns:arcs=\"http://test/arcs/\">" |
|---|
| 2566 | " <rdf:Description rdf:about=\"first-node\">" |
|---|
| 2567 | " <arcs:arc rdf:parseType=\"Collection\" />" |
|---|
| 2568 | " </rdf:Description>" |
|---|
| 2569 | "</rdf:RDF>"))) |
|---|
| 2570 | (let ((rdf-node (elt (dom:child-nodes |
|---|
| 2571 | (cxml:parse doc-1 (cxml-dom:make-dom-builder))) |
|---|
| 2572 | 0))) |
|---|
| 2573 | (is-true rdf-node) |
|---|
| 2574 | (rdf-init-db :db-dir db-dir :start-revision revision-1) |
|---|
| 2575 | (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id |
|---|
| 2576 | :document-id document-id) |
|---|
| 2577 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 22)) |
|---|
| 2578 | (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1)) |
|---|
| 2579 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0)) |
|---|
| 2580 | (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0)) |
|---|
| 2581 | (let ((first-node (d:get-item-by-id "http://test-tm/first-node" |
|---|
| 2582 | :xtm-id document-id)) |
|---|
| 2583 | (arc (d:get-item-by-id "http://test/arcs/arc" |
|---|
| 2584 | :xtm-id document-id)) |
|---|
| 2585 | (rdf-nil (d:get-item-by-id constants:*rdf-nil* |
|---|
| 2586 | :xtm-id document-id)) |
|---|
| 2587 | (subject (d:get-item-by-id constants:*rdf2tm-subject*)) |
|---|
| 2588 | (object (d:get-item-by-id constants:*rdf2tm-object*))) |
|---|
| 2589 | (is-true subject) |
|---|
| 2590 | (is-true object) |
|---|
| 2591 | (is-true first-node) |
|---|
| 2592 | (is (= (length (d:psis first-node)) 1)) |
|---|
| 2593 | (is (string= (d:uri (first (d:psis first-node))) |
|---|
| 2594 | "http://test-tm/first-node")) |
|---|
| 2595 | (is-true arc) |
|---|
| 2596 | (is (= (length (d:psis arc)) 1)) |
|---|
| 2597 | (is (string= (d:uri (first (d:psis arc))) |
|---|
| 2598 | "http://test/arcs/arc")) |
|---|
| 2599 | (is-true rdf-nil) |
|---|
| 2600 | (is (= (length (d:psis rdf-nil)) 1)) |
|---|
| 2601 | (is (string= (d:uri (first (d:psis rdf-nil))) constants:*rdf-nil*)) |
|---|
| 2602 | (is (= (length (d:player-in-roles first-node)) 1)) |
|---|
| 2603 | (is (= (length (d:player-in-roles arc)) 0)) |
|---|
| 2604 | (is (= (length (d:player-in-roles rdf-nil)) 1)) |
|---|
| 2605 | (is-true (find-if |
|---|
| 2606 | #'(lambda(x) |
|---|
| 2607 | (and (eql (d:instance-of x) subject) |
|---|
| 2608 | (eql (d:instance-of (d:parent x)) arc))) |
|---|
| 2609 | (d:player-in-roles first-node))) |
|---|
| 2610 | (is-true (find-if |
|---|
| 2611 | #'(lambda(x) |
|---|
| 2612 | (and (eql (d:instance-of x) object) |
|---|
| 2613 | (eql (d:instance-of (d:parent x)) arc))) |
|---|
| 2614 | (d:player-in-roles rdf-nil))))))) |
|---|
| 2615 | |
|---|
| 2616 | |
|---|
| 2617 | (test test-collection |
|---|
| 2618 | "Tests importing of non-empty collections." |
|---|
| 2619 | (let ((db-dir "data_base") |
|---|
| 2620 | (tm-id "http://test-tm/") |
|---|
| 2621 | (revision-1 100) |
|---|
| 2622 | (document-id "doc-id") |
|---|
| 2623 | (doc-1 |
|---|
| 2624 | (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 2625 | "xmlns:arcs=\"http://test/arcs/\">" |
|---|
| 2626 | " <rdf:Description rdf:about=\"first-node\">" |
|---|
| 2627 | " <arcs:arc rdf:parseType=\"Collection\">" |
|---|
| 2628 | " <rdf:Description rdf:about=\"item-1\"/>" |
|---|
| 2629 | " <arcs:Node rdf:about=\"item-2\"/>" |
|---|
| 2630 | " </arcs:arc>" |
|---|
| 2631 | " </rdf:Description>" |
|---|
| 2632 | "</rdf:RDF>"))) |
|---|
| 2633 | (let ((rdf-node (elt (dom:child-nodes |
|---|
| 2634 | (cxml:parse doc-1 (cxml-dom:make-dom-builder))) |
|---|
| 2635 | 0))) |
|---|
| 2636 | (is-true rdf-node) |
|---|
| 2637 | (rdf-init-db :db-dir db-dir :start-revision revision-1) |
|---|
| 2638 | (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id |
|---|
| 2639 | :document-id document-id) |
|---|
| 2640 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 29)) |
|---|
| 2641 | (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 6)) |
|---|
| 2642 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0)) |
|---|
| 2643 | (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0)) |
|---|
| 2644 | (let ((first-node (d:get-item-by-id "http://test-tm/first-node" |
|---|
| 2645 | :xtm-id document-id)) |
|---|
| 2646 | (arc (d:get-item-by-id "http://test/arcs/arc" |
|---|
| 2647 | :xtm-id document-id)) |
|---|
| 2648 | (item-1 (d:get-item-by-id "http://test-tm/item-1" |
|---|
| 2649 | :xtm-id document-id)) |
|---|
| 2650 | (item-2 (d:get-item-by-id "http://test-tm/item-2" |
|---|
| 2651 | :xtm-id document-id)) |
|---|
| 2652 | (node (d:get-item-by-id "http://test/arcs/Node" |
|---|
| 2653 | :xtm-id document-id)) |
|---|
| 2654 | (rdf-first (d:get-item-by-id constants:*rdf-first* |
|---|
| 2655 | :xtm-id document-id)) |
|---|
| 2656 | (rdf-rest (d:get-item-by-id constants:*rdf-rest* |
|---|
| 2657 | :xtm-id document-id)) |
|---|
| 2658 | (rdf-nil (d:get-item-by-id constants:*rdf-nil* |
|---|
| 2659 | :xtm-id document-id)) |
|---|
| 2660 | (subject (d:get-item-by-id constants:*rdf2tm-subject* |
|---|
| 2661 | :xtm-id document-id)) |
|---|
| 2662 | (object (d:get-item-by-id constants:*rdf2tm-object* |
|---|
| 2663 | :xtm-id document-id)) |
|---|
| 2664 | (instance (d:get-item-by-psi constants:*instance-psi*)) |
|---|
| 2665 | (type (d:get-item-by-psi constants:*type-psi*)) |
|---|
| 2666 | (type-instance (d:get-item-by-psi constants:*type-instance-psi*))) |
|---|
| 2667 | (is-true first-node) |
|---|
| 2668 | (is (= (length (d:psis first-node)) 1)) |
|---|
| 2669 | (is (string= (d:uri (first (d:psis first-node))) |
|---|
| 2670 | "http://test-tm/first-node")) |
|---|
| 2671 | (is (= (length (d:player-in-roles first-node)) 1)) |
|---|
| 2672 | (is-true arc) |
|---|
| 2673 | (is (= (length (d:psis arc)) 1)) |
|---|
| 2674 | (is (string= (d:uri (first (d:psis arc))) |
|---|
| 2675 | "http://test/arcs/arc")) |
|---|
| 2676 | (is (= (length (d:player-in-roles arc)) 0)) |
|---|
| 2677 | (is-true item-1) |
|---|
| 2678 | (is (= (length (d:psis item-1)) 1)) |
|---|
| 2679 | (is (string= (d:uri (first (d:psis item-1))) |
|---|
| 2680 | "http://test-tm/item-1")) |
|---|
| 2681 | (is (= (length (d:player-in-roles item-1)) 1)) |
|---|
| 2682 | (is-true item-2) |
|---|
| 2683 | (is (= (length (d:psis item-2)) 1)) |
|---|
| 2684 | (is (string= (d:uri (first (d:psis item-2))) |
|---|
| 2685 | "http://test-tm/item-2")) |
|---|
| 2686 | (is (= (length (d:player-in-roles item-2)) 2)) |
|---|
| 2687 | (is-true node) |
|---|
| 2688 | (is (= (length (d:psis node)) 1)) |
|---|
| 2689 | (is (string= (d:uri (first (d:psis node))) |
|---|
| 2690 | "http://test/arcs/Node")) |
|---|
| 2691 | (is (= (length (d:player-in-roles node)) 1)) |
|---|
| 2692 | (is-true rdf-first) |
|---|
| 2693 | (is-true rdf-rest) |
|---|
| 2694 | (is-true rdf-nil) |
|---|
| 2695 | (is (= (length (d:player-in-roles rdf-nil)) 1)) |
|---|
| 2696 | (is-true subject) |
|---|
| 2697 | (is-true object) |
|---|
| 2698 | (let ((uuid-1 |
|---|
| 2699 | (d:player |
|---|
| 2700 | (find-if |
|---|
| 2701 | #'(lambda(x) |
|---|
| 2702 | (not (eql x (first (d:player-in-roles first-node))))) |
|---|
| 2703 | (d:roles (d:parent (first (d:player-in-roles first-node))))))) |
|---|
| 2704 | (uuid-2 |
|---|
| 2705 | (d:player |
|---|
| 2706 | (find-if |
|---|
| 2707 | #'(lambda(x) |
|---|
| 2708 | (not (eql x (first (d:player-in-roles rdf-nil))))) |
|---|
| 2709 | (d:roles (d:parent (first (d:player-in-roles rdf-nil)))))))) |
|---|
| 2710 | (is-true uuid-1) |
|---|
| 2711 | (is (= (length (d:psis uuid-1)) 0)) |
|---|
| 2712 | (is (= (length (d:player-in-roles uuid-1)) 3)) |
|---|
| 2713 | (is-true uuid-2) |
|---|
| 2714 | (is (= (length (d:psis uuid-2)) 0)) |
|---|
| 2715 | (is (= (length (d:player-in-roles uuid-2)) 3)) |
|---|
| 2716 | (is-true (find-if |
|---|
| 2717 | #'(lambda(x) |
|---|
| 2718 | (and (eql (d:instance-of x) subject) |
|---|
| 2719 | (eql (d:instance-of (d:parent x)) arc))) |
|---|
| 2720 | (d:player-in-roles first-node))) |
|---|
| 2721 | (is-true (find-if |
|---|
| 2722 | #'(lambda(x) |
|---|
| 2723 | (and (eql (d:instance-of x) object) |
|---|
| 2724 | (eql (d:instance-of (d:parent x)) arc))) |
|---|
| 2725 | (d:player-in-roles uuid-1))) |
|---|
| 2726 | (is-true (find-if |
|---|
| 2727 | #'(lambda(x) |
|---|
| 2728 | (and (eql (d:instance-of x) subject) |
|---|
| 2729 | (eql (d:instance-of (d:parent x)) rdf-first))) |
|---|
| 2730 | (d:player-in-roles uuid-1))) |
|---|
| 2731 | (is-true (find-if |
|---|
| 2732 | #'(lambda(x) |
|---|
| 2733 | (and (eql (d:instance-of x) subject) |
|---|
| 2734 | (eql (d:instance-of (d:parent x)) rdf-rest))) |
|---|
| 2735 | (d:player-in-roles uuid-1))) |
|---|
| 2736 | (is-true (find-if |
|---|
| 2737 | #'(lambda(x) |
|---|
| 2738 | (and (eql (d:instance-of x) object) |
|---|
| 2739 | (eql (d:instance-of (d:parent x)) rdf-first))) |
|---|
| 2740 | (d:player-in-roles item-1))) |
|---|
| 2741 | (is-true (find-if |
|---|
| 2742 | #'(lambda(x) |
|---|
| 2743 | (and (eql (d:instance-of x) object) |
|---|
| 2744 | (eql (d:instance-of (d:parent x)) rdf-rest))) |
|---|
| 2745 | (d:player-in-roles uuid-2))) |
|---|
| 2746 | (is-true (find-if |
|---|
| 2747 | #'(lambda(x) |
|---|
| 2748 | (and (eql (d:instance-of x) subject) |
|---|
| 2749 | (eql (d:instance-of (d:parent x)) rdf-first))) |
|---|
| 2750 | (d:player-in-roles uuid-2))) |
|---|
| 2751 | (is-true (find-if |
|---|
| 2752 | #'(lambda(x) |
|---|
| 2753 | (and (eql (d:instance-of x) subject) |
|---|
| 2754 | (eql (d:instance-of (d:parent x)) rdf-rest))) |
|---|
| 2755 | (d:player-in-roles uuid-2))) |
|---|
| 2756 | (is-true (find-if |
|---|
| 2757 | #'(lambda(x) |
|---|
| 2758 | (and (eql (d:instance-of x) object) |
|---|
| 2759 | (eql (d:instance-of (d:parent x)) rdf-rest))) |
|---|
| 2760 | (d:player-in-roles rdf-nil))) |
|---|
| 2761 | (is-true (find-if |
|---|
| 2762 | #'(lambda(x) |
|---|
| 2763 | (and (eql (d:instance-of x) object) |
|---|
| 2764 | (eql (d:instance-of (d:parent x)) rdf-first))) |
|---|
| 2765 | (d:player-in-roles item-2))) |
|---|
| 2766 | (is-true (find-if |
|---|
| 2767 | #'(lambda(x) |
|---|
| 2768 | (and (eql (d:instance-of x) instance) |
|---|
| 2769 | (eql (d:instance-of (d:parent x)) type-instance))) |
|---|
| 2770 | (d:player-in-roles item-2))) |
|---|
| 2771 | (is-true (find-if |
|---|
| 2772 | #'(lambda(x) |
|---|
| 2773 | (and (eql (d:instance-of x) type) |
|---|
| 2774 | (eql (d:instance-of (d:parent x)) type-instance))) |
|---|
| 2775 | (d:player-in-roles node)))))))) |
|---|
| 2776 | |
|---|
| 2777 | |
|---|
| 2778 | (test test-xml-base |
|---|
| 2779 | "Tests the function get-xml-base." |
|---|
| 2780 | (let ((doc-1 |
|---|
| 2781 | (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " |
|---|
| 2782 | "xmlns:arcs=\"http://test/arcs/\">" |
|---|
| 2783 | " <rdf:Description xml:base=\"http://base-1\"/>" |
|---|
| 2784 | " <rdf:Description xml:base=\"http://base-2#\"/>" |
|---|
| 2785 | " <rdf:Description xml:base=\"http://base-3/\"/>" |
|---|
| 2786 | "</rdf:RDF>"))) |
|---|
| 2787 | (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) |
|---|
| 2788 | (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) |
|---|
| 2789 | (let ((n-1 (elt (rdf-importer::child-nodes-or-text rdf-node |
|---|
| 2790 | :trim t) 0)) |
|---|
| 2791 | (n-2 (elt (rdf-importer::child-nodes-or-text rdf-node |
|---|
| 2792 | :trim t) 1)) |
|---|
| 2793 | (n-3 (elt (rdf-importer::child-nodes-or-text rdf-node |
|---|
| 2794 | :trim t) 2))) |
|---|
| 2795 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2796 | (xml-tools:get-xml-base n-1) |
|---|
| 2797 | "test") |
|---|
| 2798 | "http://base-1/test")) |
|---|
| 2799 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2800 | (xml-tools:get-xml-base n-1) |
|---|
| 2801 | "/test") |
|---|
| 2802 | "http://base-1/test")) |
|---|
| 2803 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2804 | (xml-tools:get-xml-base n-1) |
|---|
| 2805 | "#test") |
|---|
| 2806 | "http://base-1#test")) |
|---|
| 2807 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2808 | (xml-tools:get-xml-base n-2) |
|---|
| 2809 | "test") |
|---|
| 2810 | "http://base-2#test")) |
|---|
| 2811 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2812 | (xml-tools:get-xml-base n-2) |
|---|
| 2813 | "#test") |
|---|
| 2814 | "http://base-2#test")) |
|---|
| 2815 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2816 | (xml-tools:get-xml-base n-2) |
|---|
| 2817 | "/test") |
|---|
| 2818 | "http://base-2/test")) |
|---|
| 2819 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2820 | (xml-tools:get-xml-base n-2) |
|---|
| 2821 | "/t/est") |
|---|
| 2822 | "http://base-2/t/est")) |
|---|
| 2823 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2824 | (xml-tools:get-xml-base n-2) |
|---|
| 2825 | "t/est") |
|---|
| 2826 | "http://base-2/t/est")) |
|---|
| 2827 | (signals error (xml-tools::concatenate-uri |
|---|
| 2828 | (xml-tools:get-xml-base n-2) "")) |
|---|
| 2829 | (signals error (xml-tools::concatenate-uri |
|---|
| 2830 | "" "test")) |
|---|
| 2831 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2832 | (xml-tools:get-xml-base n-3) |
|---|
| 2833 | "test") |
|---|
| 2834 | "http://base-3/test")) |
|---|
| 2835 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2836 | (xml-tools:get-xml-base n-3) |
|---|
| 2837 | "#test") |
|---|
| 2838 | "http://base-3/#test")) |
|---|
| 2839 | (is (string= (xml-tools::concatenate-uri |
|---|
| 2840 | (xml-tools:get-xml-base n-3) |
|---|
| 2841 | "/test") |
|---|
| 2842 | "http://base-3/test"))))))) |
|---|
| 2843 | |
|---|
| 2844 | |
|---|
| 2845 | (test test-full-mapping-marge |
|---|
| 2846 | "Tests the entire importer module." |
|---|
| 2847 | (let ((dir "data_base") |
|---|
| 2848 | (rdf-file unittests-constants:*full_mapping.rdf*) |
|---|
| 2849 | (tm-id "http://full-mapping/") |
|---|
| 2850 | (document-id "http://full_mapping.rdf")) |
|---|
| 2851 | (when elephant:*store-controller* |
|---|
| 2852 | (close-tm-store)) |
|---|
| 2853 | (fixtures::clean-out-db dir) |
|---|
| 2854 | (rdf-importer:import-from-rdf rdf-file dir |
|---|
| 2855 | :tm-id tm-id |
|---|
| 2856 | :document-id document-id) |
|---|
| 2857 | (open-tm-store dir) |
|---|
| 2858 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 15)) |
|---|
| 2859 | (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1)) |
|---|
| 2860 | (is (= (length (elephant:get-instances-by-class 'd:NameC)) 4)) |
|---|
| 2861 | (is (= (length (elephant:get-instances-by-class 'd:RoleC)) 2)) |
|---|
| 2862 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 2)) |
|---|
| 2863 | (is (= (length (elephant:get-instances-by-class 'd:VariantC)) 2)) |
|---|
| 2864 | (setf d:*current-xtm* document-id) |
|---|
| 2865 | (let ((firstName (get-item-by-id "http://simpsons/firstName")) |
|---|
| 2866 | (lastName (get-item-by-id "http://simpsons/lastName")) |
|---|
| 2867 | (display (get-item-by-id "http://simpsons/display")) |
|---|
| 2868 | (profession (get-item-by-id "http://simpsons/profession")) |
|---|
| 2869 | (married (get-item-by-id "http://simpsons/married")) |
|---|
| 2870 | (husband (get-item-by-id "http://simpsons/husband")) |
|---|
| 2871 | (wife (get-item-by-id "http://simpsons/wife")) |
|---|
| 2872 | (en (get-item-by-id "http://simpsons/en")) |
|---|
| 2873 | (type (get-item-by-psi *type-psi*)) |
|---|
| 2874 | (instance (get-item-by-psi *instance-psi*)) |
|---|
| 2875 | (type-instance (get-item-by-psi *type-instance-psi*)) |
|---|
| 2876 | (isi-object (get-item-by-psi *rdf2tm-object*)) |
|---|
| 2877 | (isi-subject (get-item-by-psi *rdf2tm-subject*)) |
|---|
| 2878 | (marge (get-item-by-id "http://simpsons/marge")) |
|---|
| 2879 | (homer (get-item-by-id "http://simpsons/homer")) |
|---|
| 2880 | (role-husband |
|---|
| 2881 | (find-if #'(lambda(x) |
|---|
| 2882 | (let ((iis (d:item-identifiers x))) |
|---|
| 2883 | (when (= (length iis) 1) |
|---|
| 2884 | (string= (d:uri (first iis)) |
|---|
| 2885 | "http://simpsons/role-husband/ii")))) |
|---|
| 2886 | (elephant:get-instances-by-class 'd:RoleC))) |
|---|
| 2887 | (role-wife |
|---|
| 2888 | (find-if #'(lambda(x) |
|---|
| 2889 | (let ((iis (d:item-identifiers x))) |
|---|
| 2890 | (when (= (length iis) 1) |
|---|
| 2891 | (string= (d:uri (first iis)) |
|---|
| 2892 | "http://simpsons/role-wife/ii")))) |
|---|
| 2893 | (elephant:get-instances-by-class 'd:RoleC)))) |
|---|
| 2894 | (is-true firstName) |
|---|
| 2895 | (is-true (empty-p firstName)) |
|---|
| 2896 | (is-true lastName) |
|---|
| 2897 | (is-true (empty-p lastName)) |
|---|
| 2898 | (is-true display) |
|---|
| 2899 | (is-true (empty-p display)) |
|---|
| 2900 | (is-true profession) |
|---|
| 2901 | (is-true (empty-p profession)) |
|---|
| 2902 | (is-true married) |
|---|
| 2903 | (is-true (empty-p married)) |
|---|
| 2904 | (is-true husband) |
|---|
| 2905 | (is-true (empty-p husband)) |
|---|
| 2906 | (is-true wife) |
|---|
| 2907 | (is-true (empty-p wife)) |
|---|
| 2908 | (is-true en) |
|---|
| 2909 | (is-true (empty-p en)) |
|---|
| 2910 | (is-true type) |
|---|
| 2911 | (is-true (empty-p type)) |
|---|
| 2912 | (is-true instance) |
|---|
| 2913 | (is-true (empty-p instance)) |
|---|
| 2914 | (is-true type-instance) |
|---|
| 2915 | (is-true (empty-p type-instance)) |
|---|
| 2916 | (is-true isi-object) |
|---|
| 2917 | (is-true (empty-p isi-object)) |
|---|
| 2918 | (is-true isi-subject) |
|---|
| 2919 | (is-true (empty-p isi-subject)) |
|---|
| 2920 | (is-true role-husband) |
|---|
| 2921 | (is-true role-wife) |
|---|
| 2922 | (is-true homer) |
|---|
| 2923 | (is (= (length (d:psis marge)) 2)) |
|---|
| 2924 | (is-true (find-if #'(lambda(x) |
|---|
| 2925 | (string= (d:uri x) "http://simpsons/marjorie")) |
|---|
| 2926 | (d:psis marge))) |
|---|
| 2927 | (is (= (length (d:names marge)) 2)) |
|---|
| 2928 | (let ((marge-fn (find-if #'(lambda(x) |
|---|
| 2929 | (eql (instance-of x) firstName)) |
|---|
| 2930 | (d:names marge))) |
|---|
| 2931 | (marge-ln (find-if #'(lambda(x) |
|---|
| 2932 | (eql (instance-of x) lastName)) |
|---|
| 2933 | (d:names marge))) |
|---|
| 2934 | (marge-occ (find-if #'(lambda(x) |
|---|
| 2935 | (eql (instance-of x) profession)) |
|---|
| 2936 | (d:occurrences marge)))) |
|---|
| 2937 | (is-true marge-fn) |
|---|
| 2938 | (is-true marge-ln) |
|---|
| 2939 | (is (string= (d:charvalue marge-fn) "Marjorie")) |
|---|
| 2940 | (is (string= (d:charvalue marge-ln) "Simpson")) |
|---|
| 2941 | (is (= (length (d:variants marge-fn :revision 0)) 1)) |
|---|
| 2942 | (is (= (length (d:themes (first (d:variants marge-fn :revision 0)) |
|---|
| 2943 | :revision 0)) 1)) |
|---|
| 2944 | (is (eql (first (d:themes (first (d:variants marge-fn :revision 0)) |
|---|
| 2945 | :revision 0)) display)) |
|---|
| 2946 | (is (string= (d:charvalue (first (d:variants marge-fn :revision 0))) "Marge")) |
|---|
| 2947 | (is (string= (d:datatype (first (d:variants marge-fn :revision 0))) *xml-string*)) |
|---|
| 2948 | (is-true marge-occ) |
|---|
| 2949 | (is (string= (d:charvalue marge-occ) "Housewife")) |
|---|
| 2950 | (is (string= (d:datatype marge-occ) *xml-string*)) |
|---|
| 2951 | (is (= (length (d:themes marge-occ :revision 0)) 0)) |
|---|
| 2952 | (is (= (length (d:psis marge :revision 0)) 2)))))) |
|---|
| 2953 | |
|---|
| 2954 | |
|---|
| 2955 | (test test-full-mapping-homer |
|---|
| 2956 | "Tests the entire importer module." |
|---|
| 2957 | (let ((dir "data_base") |
|---|
| 2958 | (rdf-file unittests-constants:*full_mapping.rdf*) |
|---|
| 2959 | (tm-id "http://full-mapping/") |
|---|
| 2960 | (document-id "http://full_mapping.rdf")) |
|---|
| 2961 | (when elephant:*store-controller* |
|---|
| 2962 | (close-tm-store)) |
|---|
| 2963 | (fixtures::clean-out-db dir) |
|---|
| 2964 | (rdf-importer:import-from-rdf rdf-file dir |
|---|
| 2965 | :tm-id tm-id |
|---|
| 2966 | :document-id document-id) |
|---|
| 2967 | (open-tm-store dir) |
|---|
| 2968 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 15)) |
|---|
| 2969 | (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1)) |
|---|
| 2970 | (is (= (length (elephant:get-instances-by-class 'd:NameC)) 4)) |
|---|
| 2971 | (is (= (length (elephant:get-instances-by-class 'd:RoleC)) 2)) |
|---|
| 2972 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 2)) |
|---|
| 2973 | (is (= (length (elephant:get-instances-by-class 'd:VariantC)) 2)) |
|---|
| 2974 | (setf d:*current-xtm* document-id) |
|---|
| 2975 | (let ((firstName (get-item-by-id "http://simpsons/firstName")) |
|---|
| 2976 | (lastName (get-item-by-id "http://simpsons/lastName")) |
|---|
| 2977 | (display (get-item-by-id "http://simpsons/display")) |
|---|
| 2978 | (profession (get-item-by-id "http://simpsons/profession")) |
|---|
| 2979 | (married (get-item-by-id "http://simpsons/married")) |
|---|
| 2980 | (husband (get-item-by-id "http://simpsons/husband")) |
|---|
| 2981 | (wife (get-item-by-id "http://simpsons/wife")) |
|---|
| 2982 | (en (get-item-by-id "http://simpsons/en")) |
|---|
| 2983 | (type (get-item-by-psi *type-psi*)) |
|---|
| 2984 | (instance (get-item-by-psi *instance-psi*)) |
|---|
| 2985 | (type-instance (get-item-by-psi *type-instance-psi*)) |
|---|
| 2986 | (isi-object (get-item-by-psi *rdf2tm-object*)) |
|---|
| 2987 | (isi-subject (get-item-by-psi *rdf2tm-subject*)) |
|---|
| 2988 | (marge (get-item-by-id "http://simpsons/marge")) |
|---|
| 2989 | (homer (get-item-by-id "http://simpsons/homer")) |
|---|
| 2990 | (role-husband |
|---|
| 2991 | (find-if #'(lambda(x) |
|---|
| 2992 | (let ((iis (d:item-identifiers x))) |
|---|
| 2993 | (when (= (length iis) 1) |
|---|
| 2994 | (string= (d:uri (first iis)) |
|---|
| 2995 | "http://simpsons/role-husband/ii")))) |
|---|
| 2996 | (elephant:get-instances-by-class 'd:RoleC))) |
|---|
| 2997 | (role-wife |
|---|
| 2998 | (find-if #'(lambda(x) |
|---|
| 2999 | (let ((iis (d:item-identifiers x))) |
|---|
| 3000 | (when (= (length iis) 1) |
|---|
| 3001 | (string= (d:uri (first iis)) |
|---|
| 3002 | "http://simpsons/role-wife/ii")))) |
|---|
| 3003 | (elephant:get-instances-by-class 'd:RoleC)))) |
|---|
| 3004 | (is-true firstName) |
|---|
| 3005 | (is-true (empty-p firstName)) |
|---|
| 3006 | (is-true lastName) |
|---|
| 3007 | (is-true (empty-p lastName)) |
|---|
| 3008 | (is-true display) |
|---|
| 3009 | (is-true (empty-p display)) |
|---|
| 3010 | (is-true profession) |
|---|
| 3011 | (is-true (empty-p profession)) |
|---|
| 3012 | (is-true married) |
|---|
| 3013 | (is-true (empty-p married)) |
|---|
| 3014 | (is-true husband) |
|---|
| 3015 | (is-true (empty-p husband)) |
|---|
| 3016 | (is-true wife) |
|---|
| 3017 | (is-true (empty-p wife)) |
|---|
| 3018 | (is-true en) |
|---|
| 3019 | (is-true (empty-p en)) |
|---|
| 3020 | (is-true type) |
|---|
| 3021 | (is-true (empty-p type)) |
|---|
| 3022 | (is-true instance) |
|---|
| 3023 | (is-true (empty-p instance)) |
|---|
| 3024 | (is-true type-instance) |
|---|
| 3025 | (is-true (empty-p type-instance)) |
|---|
| 3026 | (is-true isi-object) |
|---|
| 3027 | (is-true (empty-p isi-object)) |
|---|
| 3028 | (is-true isi-subject) |
|---|
| 3029 | (is-true (empty-p isi-subject)) |
|---|
| 3030 | (is-true role-husband) |
|---|
| 3031 | (is-true role-wife) |
|---|
| 3032 | (is-true marge) |
|---|
| 3033 | (is-true (find-if #'(lambda(x) |
|---|
| 3034 | (string= (d:uri x) "http://simpsons/homer_simpson")) |
|---|
| 3035 | (d:psis homer))) |
|---|
| 3036 | (is (= (length (d:locators homer)) 1)) |
|---|
| 3037 | (is-true (find-if #'(lambda(x) |
|---|
| 3038 | (string= (d:uri x) "http://some.where/resource")) |
|---|
| 3039 | (d:locators homer))) |
|---|
| 3040 | (is (= (length (d:item-identifiers homer)) 1)) |
|---|
| 3041 | (is-true (find-if #'(lambda(x) |
|---|
| 3042 | (string= (d:uri x) "http://simpsons/ii/homer")) |
|---|
| 3043 | (d:item-identifiers homer))) |
|---|
| 3044 | (is (= (length (d:names homer)) 2)) |
|---|
| 3045 | (let ((homer-fn (find-if #'(lambda(x) |
|---|
| 3046 | (eql (instance-of x) firstName)) |
|---|
| 3047 | (d:names homer))) |
|---|
| 3048 | (homer-ln (find-if #'(lambda(x) |
|---|
| 3049 | (eql (instance-of x) lastName)) |
|---|
| 3050 | (d:names homer))) |
|---|
| 3051 | (homer-occ (find-if #'(lambda(x) |
|---|
| 3052 | (eql (instance-of x) profession)) |
|---|
| 3053 | (d:occurrences homer)))) |
|---|
| 3054 | (is-true homer-fn) |
|---|
| 3055 | (is-true homer-ln) |
|---|
| 3056 | (is (string= (d:charvalue homer-fn) "Homer J.")) |
|---|
| 3057 | (is (string= (d:charvalue homer-ln) "Simpson")) |
|---|
| 3058 | (is (= (length (d:variants homer-fn)) 1)) |
|---|
| 3059 | (is (= (length (d:themes (first (d:variants homer-fn)))) 1)) |
|---|
| 3060 | (is (eql (first (d:themes (first (d:variants homer-fn)))) display)) |
|---|
| 3061 | (is (string= (d:charvalue (first (d:variants homer-fn))) "Homer")) |
|---|
| 3062 | (is (string= (d:datatype (first (d:variants homer-fn))) *xml-string*)) |
|---|
| 3063 | (is-true homer-occ) |
|---|
| 3064 | (is (string= (d:charvalue homer-occ) "Safety Inspector")) |
|---|
| 3065 | (is (string= (d:datatype homer-occ) *xml-string*)) |
|---|
| 3066 | (is (= (length (d:themes homer-occ)) 1)) |
|---|
| 3067 | (is (eql (first (d:themes homer-occ)) en)))))) |
|---|
| 3068 | |
|---|
| 3069 | |
|---|
| 3070 | (test test-full-mapping-association |
|---|
| 3071 | "Tests the entire importer module." |
|---|
| 3072 | (let ((dir "data_base") |
|---|
| 3073 | (rdf-file unittests-constants:*full_mapping.rdf*) |
|---|
| 3074 | (tm-id "http://full-mapping/") |
|---|
| 3075 | (document-id "http://full_mapping.rdf")) |
|---|
| 3076 | (when elephant:*store-controller* |
|---|
| 3077 | (close-tm-store)) |
|---|
| 3078 | (fixtures::clean-out-db dir) |
|---|
| 3079 | (rdf-importer:import-from-rdf rdf-file dir |
|---|
| 3080 | :tm-id tm-id |
|---|
| 3081 | :document-id document-id) |
|---|
| 3082 | (open-tm-store dir) |
|---|
| 3083 | (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 15)) |
|---|
| 3084 | (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1)) |
|---|
| 3085 | (is (= (length (elephant:get-instances-by-class 'd:NameC)) 4)) |
|---|
| 3086 | (is (= (length (elephant:get-instances-by-class 'd:RoleC)) 2)) |
|---|
| 3087 | (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 2)) |
|---|
| 3088 | (is (= (length (elephant:get-instances-by-class 'd:VariantC)) 2)) |
|---|
| 3089 | (setf d:*current-xtm* document-id) |
|---|
| 3090 | (let ((married (get-item-by-id "http://simpsons/married")) |
|---|
| 3091 | (husband (get-item-by-id "http://simpsons/husband")) |
|---|
| 3092 | (wife (get-item-by-id "http://simpsons/wife")) |
|---|
| 3093 | (marge (get-item-by-id "http://simpsons/marge")) |
|---|
| 3094 | (homer (get-item-by-id "http://simpsons/homer")) |
|---|
| 3095 | (assoc (first (elephant:get-instances-by-class 'd:AssociationC))) |
|---|
| 3096 | (role-husband |
|---|
| 3097 | (find-if #'(lambda(x) |
|---|
| 3098 | (let ((iis (d:item-identifiers x))) |
|---|
| 3099 | (when (= (length iis) 1) |
|---|
| 3100 | (string= (d:uri (first iis)) |
|---|
| 3101 | "http://simpsons/role-husband/ii")))) |
|---|
| 3102 | (elephant:get-instances-by-class 'd:RoleC))) |
|---|
| 3103 | (role-wife |
|---|
| 3104 | (find-if #'(lambda(x) |
|---|
| 3105 | (let ((iis (d:item-identifiers x))) |
|---|
| 3106 | (when (= (length iis) 1) |
|---|
| 3107 | (string= (d:uri (first iis)) |
|---|
| 3108 | "http://simpsons/role-wife/ii")))) |
|---|
| 3109 | (elephant:get-instances-by-class 'd:RoleC)))) |
|---|
| 3110 | (is-true married) |
|---|
| 3111 | (is-true (empty-p married)) |
|---|
| 3112 | (is-true husband) |
|---|
| 3113 | (is-true (empty-p husband)) |
|---|
| 3114 | (is-true wife) |
|---|
| 3115 | (is-true (empty-p wife)) |
|---|
| 3116 | (is-true role-husband) |
|---|
| 3117 | (is-true role-wife) |
|---|
| 3118 | (is-true marge) |
|---|
| 3119 | (is-true homer) |
|---|
| 3120 | (is (= (length (intersection (list role-husband role-wife) |
|---|
| 3121 | (d:roles assoc))) |
|---|
| 3122 | 2)) |
|---|
| 3123 | (is (eql (d:instance-of assoc) married)) |
|---|
| 3124 | (is (= (length (d:item-identifiers assoc)) 2)) |
|---|
| 3125 | (is (= (length |
|---|
| 3126 | (intersection |
|---|
| 3127 | (list |
|---|
| 3128 | (elephant:get-instance-by-value |
|---|
| 3129 | 'd:ItemIdentifierC 'd:uri "http://simpsons/married/ii-1") |
|---|
| 3130 | (elephant:get-instance-by-value |
|---|
| 3131 | 'd:ItemIdentifierC 'd:uri "http://simpsons/married/ii-2")) |
|---|
| 3132 | (d:item-identifiers assoc))) |
|---|
| 3133 | 2)) |
|---|
| 3134 | (is (eql (d:instance-of role-husband) husband)) |
|---|
| 3135 | (is (eql (d:instance-of role-wife) wife)) |
|---|
| 3136 | (is (eql (d:player role-husband) homer)) |
|---|
| 3137 | (is (eql (d:player role-wife) marge)) |
|---|
| 3138 | (is (= (length (d:item-identifiers role-husband)) 1)) |
|---|
| 3139 | (is (= (length (d:item-identifiers role-wife)) 1)) |
|---|
| 3140 | (is (string= (d:uri (first (d:item-identifiers role-husband))) |
|---|
| 3141 | "http://simpsons/role-husband/ii")) |
|---|
| 3142 | (is (string= (d:uri (first (d:item-identifiers role-wife))) |
|---|
| 3143 | "http://simpsons/role-wife/ii"))))) |
|---|
| 3144 | |
|---|
| 3145 | |
|---|
| 3146 | (defun run-rdf-importer-tests() |
|---|
| 3147 | "Runs all defined tests." |
|---|
| 3148 | (when elephant:*store-controller* |
|---|
| 3149 | (close-tm-store)) |
|---|
| 3150 | (it.bese.fiveam:run! 'test-get-literals-of-node) |
|---|
| 3151 | (it.bese.fiveam:run! 'test-parse-node) |
|---|
| 3152 | (it.bese.fiveam:run! 'test-get-literals-of-property) |
|---|
| 3153 | (it.bese.fiveam:run! 'test-parse-property) |
|---|
| 3154 | (it.bese.fiveam:run! 'test-get-types) |
|---|
| 3155 | (it.bese.fiveam:run! 'test-get-literals-of-content) |
|---|
| 3156 | (it.bese.fiveam:run! 'test-get-super-classes-of-node-content) |
|---|
| 3157 | (it.bese.fiveam:run! 'test-get-associations-of-node-content) |
|---|
| 3158 | (it.bese.fiveam:run! 'test-parse-properties-of-node) |
|---|
| 3159 | (it.bese.fiveam:run! 'test-import-node-1) |
|---|
| 3160 | (it.bese.fiveam:run! 'test-import-dom) |
|---|
| 3161 | (it.bese.fiveam:run! 'test-poems-rdf-occurrences) |
|---|
| 3162 | (it.bese.fiveam:run! 'test-poems-rdf-associations) |
|---|
| 3163 | (it.bese.fiveam:run! 'test-poems-rdf-typing) |
|---|
| 3164 | (it.bese.fiveam:run! 'test-poems-rdf-topics) |
|---|
| 3165 | (it.bese.fiveam:run! 'test-empty-collection) |
|---|
| 3166 | (it.bese.fiveam:run! 'test-collection) |
|---|
| 3167 | (it.bese.fiveam:run! 'test-xml-base) |
|---|
| 3168 | (it.bese.fiveam:run! 'test-full-mapping-marge) |
|---|
| 3169 | (it.bese.fiveam:run! 'test-full-mapping-homer) |
|---|
| 3170 | (it.bese.fiveam:run! 'test-full-mapping-association)) |
|---|