[isidorus-cvs] r123 - trunk/src/unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Thu Aug 27 10:49:28 UTC 2009
Author: lgiessmann
Date: Thu Aug 27 06:49:28 2009
New Revision: 123
Log:
Added:
trunk/src/unit_tests/rdf_exporter_test.lisp
Added: trunk/src/unit_tests/rdf_exporter_test.lisp
==============================================================================
--- (empty file)
+++ trunk/src/unit_tests/rdf_exporter_test.lisp Thu Aug 27 06:49:28 2009
@@ -0,0 +1,883 @@
+;;+-----------------------------------------------------------------------------
+;;+ Isidorus
+;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann
+;;+
+;;+ Isidorus is freely distributable under the LGPL license.
+;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt.
+;;+-----------------------------------------------------------------------------
+
+
+(defpackage :rdf-exporter-test
+ (:use
+ :common-lisp
+ :xml-importer
+ :datamodel
+ :it.bese.FiveAM
+ :fixtures)
+ (:import-from :constants
+ *rdf-ns*
+ *rdfs-ns*
+ *rdf2tm-ns*
+ *tm2rdf-ns*
+ *xml-ns*
+ *xml-string*
+ *xml-uri*)
+ (:import-from :xml-tools
+ xpath-child-elems-by-qname
+ xpath-single-child-elem-by-qname
+ xpath-select-location-path
+ get-ns-attribute)
+ (:export :run-rdf-exporter-tests
+ :test-resources
+ :test-goethe
+ :test-erlkoenig
+ :test-prometheus
+ :test-zauberlehrling
+ :test-frankfurt
+ :test-weimar
+ :test-berlin
+ :test-region
+ :test-city-and-metropolis
+ :test-germany
+ :test-german
+ :test-born-event
+ :test-died-event
+ :test-dateRange-zauberlehrling
+ :test-dateRange-erlkoenig
+ :test-dateRange-prometheus
+ :test-schiller
+ :test-single-nodes
+ :test-collection
+ :test-association))
+
+(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
+
+(in-package :rdf-exporter-test)
+
+
+(def-suite rdf-exporter-test
+ :description "tests various key functions of the exporter")
+
+(in-suite rdf-exporter-test)
+
+
+(defvar *sw-arc* "http://some.where/relationship/")
+(defvar *xml-ulong* "http://www.w3.org/2001/XMLSchema#unsignedLong")
+(defvar *xml-date* "http://www.w3.org/2001/XMLSchema#date")
+
+
+(defun get-dom-root ()
+ "Returns the document's root node."
+ (let ((dom (cxml:parse-file "./__out__.rdf" (cxml-dom:make-dom-builder))))
+ (when dom
+ (let ((child-nodes (dom:child-nodes dom)))
+ (when (> (length child-nodes) 0)
+ (elt child-nodes 0))))))
+
+
+(defun identifier-p (owner-elem value &key (what "itemIdentity"))
+ "Returns t if the owner element owns a property correponding to the
+ attribute what and the value."
+ (literal-p owner-elem *tm2rdf-ns* what value :datatype *xml-uri*))
+
+
+(defun role-p (owner-elem roletype-uri item-identifiers
+ &key (player-uri nil) (player-id nil))
+ "Returns t if the owner-element has a node that corresponds to a
+ role with the given parameters."
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item)))
+ (and (= (length (dom:child-nodes item))
+ (+ 3 (length item-identifiers)))
+ (string= node-ns *tm2rdf-ns*)
+ (string= node-name "role")
+ (type-p item (concatenate 'string *tm2rdf-ns* "Role"))
+ (if player-uri
+ (property-p item *tm2rdf-ns* "player"
+ :resource player-uri)
+ (property-p item *tm2rdf-ns* "player"
+ :nodeID player-id))
+ (property-p item *tm2rdf-ns* "roletype"
+ :resource roletype-uri)
+ (= (length item-identifiers)
+ (length (loop for ii in item-identifiers
+ when (identifier-p item ii)
+ collect ii)))))
+ return t))
+
+
+(defun get-resources-by-uri (uri)
+ "Returns a list of resource elements that owns the attribute
+ about with the value of uri."
+ (let ((root (get-dom-root)))
+ (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
+ (loop for item across resources
+ when (string= (get-ns-attribute item "about") uri)
+ collect item))))
+
+
+(defun get-resources-by-id (id)
+ "Returns a list of resource elements that owns the attribute
+ nodeID with the value of id."
+ (let ((root (get-dom-root)))
+ (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
+ (loop for item across resources
+ when (string= (get-ns-attribute item "nodeID") id)
+ collect item))))
+
+
+(defun type-p (owner-elem type-uri)
+ "Returns t if the given uri is contained in a property
+ within the owner-elem."
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item))
+ (resource (rdf-importer::get-ns-attribute
+ item "resource")))
+ (and (string= node-ns *rdf-ns*)
+ (string= node-name "type")
+ (string= resource type-uri)))
+ return t))
+
+
+(defun literal-p (owner-elem arc-uri arc-name literal-value
+ &key (datatype *xml-string*)
+ (xml-lang nil))
+ "Returns t if the owner-elem contains an arc with the uri
+ arc-uri, the arc-name and the literal content literal-value."
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item))
+ (value (rdf-importer::child-nodes-or-text item :trim nil))
+ (fn-datatype (rdf-importer::get-ns-attribute item "datatype"))
+ (fn-xml-lang (rdf-importer::get-ns-attribute
+ item "lang" :ns-uri *xml-ns*)))
+ (and (string= node-ns arc-uri)
+ (string= node-name arc-name)
+ (and (stringp literal-value)
+ (string= value literal-value))
+ (string= datatype (if fn-datatype
+ fn-datatype
+ ""))
+ (or (not (or xml-lang fn-xml-lang))
+ (and (and xml-lang fn-xml-lang)
+ (string= xml-lang fn-xml-lang)))))
+ return t))
+
+
+(defun property-p (owner-elem arc-uri arc-name
+ &key (resource "") (nodeID ""))
+ "Returns t if the owner element owns a property with the
+ given characteristics."
+ (if (and (string= resource "") (string= nodeID ""))
+ nil
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item))
+ (fn-resource (unless (dom:text-node-p item)
+ (rdf-importer::get-ns-attribute item
+ "resource")))
+ (fn-nodeID (rdf-importer::get-ns-attribute item "nodeID")))
+ (and (string= node-ns arc-uri)
+ (string= node-name arc-name)
+ (or (and fn-resource
+ (string= fn-resource resource))
+ (and fn-nodeID
+ (string= fn-nodeID nodeID)))))
+ return t)))
+
+
+(defun variant-p (owner-elem variant-scopes item-identifiers variant-value
+ &key (datatype *xml-string*))
+ "Returns t if the owner contains a variant element with the passed
+ characteristics."
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item)))
+ (and (= (+ (length variant-scopes)
+ (length item-identifiers)
+ 2)
+ (length (dom:child-nodes owner-elem)))
+ (string= node-ns *tm2rdf-ns*)
+ (string= node-name "variant")
+ (literal-p item *tm2rdf-ns* "value" variant-value
+ :datatype datatype)
+ (= (length variant-scopes)
+ (length (loop for scope in variant-scopes
+ when (property-p item *tm2rdf-ns* "scope"
+ :resource scope)
+ collect scope)))
+ (= (length item-identifiers)
+ (length (loop for ii in item-identifiers
+ when (identifier-p item ii)
+ collect ii)))
+ (type-p item (concatenate 'string *tm2rdf-ns* "Variant"))))
+ return t))
+
+
+(defun name-p (owner-elem name-type name-scopes item-identifiers name-value
+ &key (variants nil))
+ "Returns t if the parent node owns a name with the given characterics."
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item)))
+ (and (= (length (dom:child-nodes item))
+ (+ 3 (length name-scopes)
+ (length item-identifiers)
+ (length variants)))
+ (string= node-ns *tm2rdf-ns*)
+ (string= node-name "name")
+ (type-p item (concatenate 'string *tm2rdf-ns*
+ "Name"))
+ (property-p item *tm2rdf-ns* "nametype" :resource name-type)
+ (= (length name-scopes)
+ (length (loop for scope in name-scopes
+ when (property-p item *tm2rdf-ns* "scope"
+ :resource scope)
+ collect scope)))
+ (= (length item-identifiers)
+ (length (loop for ii in item-identifiers
+ when (identifier-p item ii)
+ collect ii)))
+ (= (length variants)
+ (length (loop for variant in variants
+ when (variant-p
+ item (getf variant :scopes)
+ (getf variant :item-identifiers)
+ (getf variant :value)
+ :datatype (getf variant :datatype))
+ collect variant)))
+ (literal-p item *tm2rdf-ns* "value" name-value)))
+ return t))
+
+
+(defun occurrence-p (owner-elem occurrence-type occurrence-scopes
+ item-identifiers occurrence-value
+ &key (datatype *xml-string*))
+ "Returns t if the parent node owns an occurrence with the given characterics."
+ (loop for item across (dom:child-nodes owner-elem)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item)))
+ (and (= (length (dom:child-nodes item))
+ (+ 3 (length occurrence-scopes)
+ (length item-identifiers)))
+ (string= node-ns *tm2rdf-ns*)
+ (string= node-name "occurrence")
+ (type-p item (concatenate 'string *tm2rdf-ns*
+ "Occurrence"))
+ (property-p item *tm2rdf-ns* "occurrencetype"
+ :resource occurrence-type)
+ (= (length occurrence-scopes)
+ (length (loop for scope in occurrence-scopes
+ when (property-p item *tm2rdf-ns* "scope"
+ :resource scope)
+ collect scope)))
+ (= (length item-identifiers)
+ (length (loop for ii in item-identifiers
+ when (identifier-p item ii)
+ collect ii)))
+ (literal-p item *tm2rdf-ns* "value" occurrence-value
+ :datatype datatype)))
+ return t))
+
+
+(test test-resources
+ "Tests the general amount of resources."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((root (get-dom-root)))
+ (is-true root)
+ (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
+ (is (= (length resources) 29))
+ (is (= (length (loop for item across resources
+ when (get-ns-attribute item "about")
+ collect item))
+ 19))
+ (is (= (length (loop for item across resources
+ when (get-ns-attribute item "nodeID")
+ collect item))
+ 10))))))
+
+
+(test test-goethe
+ "Tests the resource goethe."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe")))
+ (is (= (length goethes) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 7))
+ goethes)))
+ (is-true me)
+ (is (type-p me "http://isidorus/tm2rdf_mapping/Topic"))
+ (is (type-p me "http://some.where/types/Author"))
+ (is (literal-p me *sw-arc* "lastName"
+ "von Goethe"))
+ (is (name-p me "http://some.where/relationship/firstName" nil
+ (list "http://some.where/name_ii_1") "Johann Wolfgang"))
+ (let ((born-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "28.08.1749"))))))
+ (died-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "22.03.1832")))))))
+ (is-true (property-p me *sw-arc* "born" :nodeID born-id))
+ (is-true (property-p me *sw-arc* "died" :nodeID died-id)))
+ (is-true (loop for item across (dom:child-nodes me)
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item))
+ (nodeID (rdf-importer::get-ns-attribute
+ item "nodeID")))
+ (and (string= node-ns *sw-arc*)
+ (string= node-name "wrote")
+ nodeID))
+ return t))))))
+
+
+(test test-erlkoenig
+ "Tests the resource erlkoenig."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((erlkoenigs (get-resources-by-uri
+ "http://some.where/ballad/Der_Erlkoenig")))
+ (is (= (length erlkoenigs) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 5))
+ erlkoenigs)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/Ballad"))
+ (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic")))
+ (is-true (literal-p me *sw-arc* "content"
+ "Wer reitet so spät durch Nacht und Wind? ..."
+ :xml-lang "de"))
+ (is-true (occurrence-p me "http://some.where/relationship/title"
+ (list "http://some.where/scope/en") nil
+ "Der Erlkönig"))
+ (let ((dateRange-id
+ (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "31.12.1782")))))))
+ (is-true (property-p me *sw-arc* "dateRange"
+ :nodeID dateRange-id)))))))
+
+
+(test test-prometheus
+ "Tests the resoruce prometheus."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((prometheus (get-resources-by-uri
+ "http://some.where/poem/Prometheus")))
+ (is (= (length prometheus) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 4))
+ prometheus)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/Poem"))
+ (is-true (literal-p me *sw-arc* "title"
+ "Prometheus" :xml-lang "de"))
+ (is-true (literal-p me *sw-arc* "content"
+ "Bedecke deinen Himmel, Zeus, ..."
+ :xml-lang "de"))
+ (let ((dateRange-id
+ (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "01.01.1772")))))))
+ (is-true (property-p me *sw-arc* "dateRange"
+ :nodeID dateRange-id)))))))
+
+
+(test test-zauberlehrling
+ "Tests the resoruce zauberlehrling."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((zauberlehrlings (get-resources-by-uri
+ "http://some.where/poem/Der_Zauberlehrling")))
+ (is (= (length zauberlehrlings) ))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 10))
+ zauberlehrlings)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/Poem"))
+ (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic")))
+ (is-true (identifier-p me "http://some.where/poem/Zauberlehrling"
+ :what "subjectIdentifier"))
+ (is-true (identifier-p
+ me "http://some.where/poem/Zauberlehrling_itemIdentity_1"))
+ (is-true (identifier-p
+ me "http://some.where/poem/Zauberlehrling_itemIdentity_2"))
+ (is-true (identifier-p me "http://some.where/resource_1"
+ :what "subjectLocator"))
+ (is-true (identifier-p me "http://some.where/resource_2"
+ :what "subjectLocator"))
+ (is-true (literal-p me "http://some.where/relationship/" "content"
+ "Hat der alte Hexenmeister ..."))
+ (is-true (occurrence-p me "http://some.where/relationship/title"
+ (list "http://some.where/scope/en"
+ "http://isidorus/rdf2tm_mapping/scope/de")
+ (list "http://some.where/occurrence_ii_1"
+ "http://some.where/occurrence_ii_2")
+ "Der Zauberlehrling"))
+ (let ((dateRange-id
+ (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue "01.01.1797")))))))
+ (is-true (property-p me *sw-arc* "dateRange"
+ :nodeID dateRange-id)))))))
+
+
+(test test-frankfurt
+ "Tests the resoruce frankfurt."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((frankfurts (get-resources-by-uri
+ "http://some.where/metropolis/FrankfurtMain")))
+ (is (= (length frankfurts) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 4))
+ frankfurts)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/Metropolis"))
+ (is-true (literal-p me *sw-arc* "fullName" "Frankfurt am Main"))
+ (is-true (literal-p me *sw-arc* "population" "659000"
+ :datatype *xml-ulong*))
+ (is-true (property-p me *sw-arc* "locatedIn"
+ :resource "http://some.where/country/Germany"))))))
+
+(test test-weimar
+ "Tests the resoruce weimar."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((weimars (get-resources-by-uri
+ "http://some.where/city/Weimar")))
+ (is (= (length weimars) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 4))
+ weimars)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/City"))
+ (is-true (literal-p me *sw-arc* "fullName" "Weimar"))
+ (is-true (literal-p me *sw-arc* "population" "64720"
+ :datatype *xml-ulong*))
+ (is-true (property-p me *sw-arc* "locatedIn"
+ :resource "http://some.where/country/Germany"))))))
+
+
+(test test-berlin
+ "Tests the resource berlin."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((berlins (get-resources-by-uri
+ "http://some.where/metropolis/Berlin")))
+ (is (= (length berlins) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 4))
+ berlins)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/Metropolis"))
+ (is-true (literal-p me *sw-arc* "fullName" "Berlin"))
+ (is-true (literal-p me *sw-arc* "population" "3431473"
+ :datatype *xml-ulong*))
+ (is-true (property-p me *sw-arc* "locatedIn"
+ :resource "http://some.where/country/Germany"))))))
+
+
+(test test-region
+ "Tests the resource region."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((regions (get-resources-by-uri
+ "http://some.where/types/Region"))
+ (citys (get-resources-by-uri
+ "http://some.where/types/City"))
+ (metropolis (get-resources-by-uri
+ "http://some.where/types/Metropolis")))
+ (is (= (length regions) 1))
+ (is (= (length (dom:child-nodes (elt regions 0))) 0))
+ (is (= (length citys) 1))
+ (is (= (length (dom:child-nodes (elt citys 0))) 1))
+ (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf"
+ :resource "http://some.where/types/Region"))
+ (is (= (length metropolis) 1))
+ (is (= (length (dom:child-nodes (elt metropolis 0))) 1))
+ (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf"
+ :resource "http://some.where/types/Region")))))
+
+
+(test test-city-and-metropolis
+ "Tests the resource city and metropolis."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((citys (get-resources-by-uri
+ "http://some.where/types/City")))
+ (is (= (length citys) 1))
+ (is (= (length (dom:child-nodes (elt citys 0))) 1))
+ (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf"
+ :resource "http://some.where/types/Region")))
+ (let ((metropolis (get-resources-by-uri
+ "http://some.where/types/Metropolis")))
+ (is (= (length metropolis) 1))
+ (is (= (length (dom:child-nodes (elt metropolis 0))) 1))
+ (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf"
+ :resource "http://some.where/types/Region")))))
+
+
+(test test-germany
+ "Tests the resource germany."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((germanys (get-resources-by-uri
+ "http://some.where/country/Germany")))
+ (is (= (length germanys) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 5))
+ germanys)))
+ (is-true me)
+ (is-true (type-p me "http://some.where/types/Country"))
+ (is-true (literal-p me *sw-arc* "nativeName" "Deutschland"
+ :xml-lang "de"))
+ (is-true (literal-p me *sw-arc* "population" "82099232"
+ :datatype *xml-ulong*))
+ (is-true (property-p me *sw-arc* "capital"
+ :resource "http://some.where/metropolis/Berlin"))
+ (is-true (property-p me *sw-arc* "officialese"
+ :resource "http://some.where/language/German"))))))
+
+
+(test test-german
+ "Tests the resource german."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((germans (get-resources-by-uri
+ "http://some.where/language/German")))
+ (is (= (length germans) 1))
+ (is-true (type-p (elt germans 0) "http://some.where/types/Language")))))
+
+
+(test test-born-event
+ "Tests the blank node of the born-event."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((born-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value 'd:OccurrenceC
+ 'd:charvalue
+ "28.08.1749")))))))
+ (is-true born-id)
+ (let ((born-events (get-resources-by-id born-id)))
+ (is (= (length born-events) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 3))
+ born-events)))
+ (is-true me)
+ (is-true (literal-p me *sw-arc* "date" "28.08.1749"
+ :datatype *xml-date*))
+ (is-true (type-p me "http://some.where/types/Event"))
+ (is-true
+ (property-p me *sw-arc* "place"
+ :resource
+ "http://some.where/metropolis/FrankfurtMain")))))))
+
+
+(test test-died-event
+ "Tests the blank node of the born-event."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((born-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value 'd:OccurrenceC
+ 'd:charvalue
+ "22.03.1832")))))))
+ (is-true born-id)
+ (let ((born-events (get-resources-by-id born-id)))
+ (is (= (length born-events) 1))
+ (let ((me (find-if #'(lambda(x)
+ (= (length (dom:child-nodes x)) 3))
+ born-events)))
+ (is-true me)
+ (is-true (literal-p me *sw-arc* "date" "22.03.1832"
+ :datatype *xml-date*))
+ (is-true (type-p me "http://some.where/types/Event"))
+ (is-true
+ (property-p me *sw-arc* "place"
+ :resource
+ "http://some.where/city/Weimar")))))))
+
+
+(test test-dateRange-zauberlehrling
+ "Tests the node of zauberlehrling's dateRange."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((dr-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value 'd:OccurrenceC
+ 'd:charvalue
+ "01.01.1797")))))))
+ (is-true dr-id)
+ (let ((drs (get-resources-by-id dr-id)))
+ (is (= (length drs) 1))
+ (let ((me (elt drs 0)))
+ (is-true (literal-p me *sw-arc* "start" "01.01.1797"
+ :datatype *xml-date*))
+ (is-true (literal-p me *sw-arc* "end" "31.12.1797"
+ :datatype *xml-date*)))))))
+
+
+(test test-dateRange-erlkoenig
+ "Tests the node of erlkoenig's dateRange."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((dr-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value 'd:OccurrenceC
+ 'd:charvalue
+ "01.01.1782")))))))
+ (is-true dr-id)
+ (let ((drs (get-resources-by-id dr-id)))
+ (is (= (length drs) 1))
+ (let ((me (elt drs 0)))
+ (is-true (literal-p me *sw-arc* "start" "01.01.1782"
+ :datatype *xml-date*))
+ (is-true (literal-p me *sw-arc* "end" "31.12.1782"
+ :datatype *xml-date*)))))))
+
+
+(test test-dateRange-prometheus
+ "Tests the node of prometheus' dateRange."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((dr-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value 'd:OccurrenceC
+ 'd:charvalue
+ "01.01.1772")))))))
+ (is-true dr-id)
+ (let ((drs (get-resources-by-id dr-id)))
+ (is (= (length drs) 1))
+ (let ((me (elt drs 0)))
+ (is-true (literal-p me *sw-arc* "start" "01.01.1772"
+ :datatype *xml-date*))
+ (is-true (literal-p me *sw-arc* "end" "31.12.1774"
+ :datatype *xml-date*)))))))
+
+
+(test test-schiller
+ "Tests the node of schiller."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((schiller-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue
+ "http://de.wikipedia.org/wiki/Schiller")))))))
+ (is-true schiller-id)
+ (is (= (length (get-resources-by-id schiller-id)) 1))
+ (let ((me (elt (get-resources-by-id schiller-id) 0)))
+ (is-true (type-p me "http://some.where/types/Author"))
+ (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Topic")))
+ (is-true (literal-p me *sw-arc* "authorInfo"
+ "http://de.wikipedia.org/wiki/Schiller"
+ :datatype *xml-uri*))
+ (is-true
+ (name-p me "http://some.where/relationship/firstName"
+ nil nil "Johann Christoph Friedrich"
+ :variants
+ (list
+ (list
+ :item-identifiers
+ (list "http://some.where/variant_ii_1")
+ :scopes
+ (list "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
+ :value "Friedrich"
+ :datatype *xml-string*))))
+ (is-true
+ (name-p me "http://some.where/relationship/lastName"
+ nil nil "von Schiller"))))))
+
+
+(test test-single-nodes
+ "Tests all nodes that are not part of a statement."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((authors (get-resources-by-uri "http://some.where/types/Author"))
+ (events (get-resources-by-uri "http://some.where/types/Event"))
+ (country (get-resources-by-uri "http://some.where/types/Country"))
+ (poem (get-resources-by-uri "http://some.where/types/Poem"))
+ (ballad (get-resources-by-uri "http://some.where/types/Ballad"))
+ (language (get-resources-by-uri "http://some.where/types/Language"))
+ (rdf-nil (get-resources-by-uri (concatenate 'string *rdf-ns* "nil"))))
+ (is-true authors)
+ (is (= (length authors) 1))
+ (is (= (length (dom:child-nodes (elt authors 0))) 0))
+ (is-true events)
+ (is (= (length events) 1))
+ (is (= (length (dom:child-nodes (elt events 0))) 0))
+ (is-true country)
+ (is (= (length country) 1))
+ (is (= (length (dom:child-nodes (elt country 0))) 0))
+ (is-true poem)
+ (is (= (length poem) 1))
+ (is (= (length (dom:child-nodes (elt poem 0))) 0))
+ (is-true ballad)
+ (is (= (length ballad) 1))
+ (is (= (length (dom:child-nodes (elt ballad 0))) 0))
+ (is-true language)
+ (is (= (length language) 1))
+ (is (= (length (dom:child-nodes (elt language 0))) 0))
+ (is-true rdf-nil)
+ (is (= (length rdf-nil) 1))
+ (is (= (length (dom:child-nodes (elt rdf-nil 0))) 0)))))
+
+
+(test test-collection
+ "Tests a collection that has be exported as a construct of rdf:first,
+ rdf:rest and rdf:nil."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe")))
+ (let ((wrote-goethe
+ (loop for item across (dom:child-nodes (elt goethes 0))
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item)))
+ (and (string= node-ns *sw-arc*)
+ (string= node-name "wrote")))
+ return item)))
+ (let ((id-1 (rdf-importer::get-ns-attribute wrote-goethe"nodeID")))
+ (is-true id-1)
+ (let ((node-1s (get-resources-by-id id-1)))
+ (is (= (length node-1s) 1))
+ (is (= (length (dom:child-nodes (elt node-1s 0))) 2))
+ (is-true (property-p (elt node-1s 0) *rdf-ns* "first"
+ :resource
+ "http://some.where/poem/Der_Zauberlehrling"))
+ (let ((rest-arc-1
+ (loop for item across (dom:child-nodes (elt node-1s 0))
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item))
+ (nodeID (rdf-importer::get-ns-attribute
+ item "nodeID")))
+ (and (string= node-ns *rdf-ns*)
+ (string= node-name "rest")
+ nodeID))
+ return item)))
+ (is-true rest-arc-1)
+ (let ((id-2 (rdf-importer::get-ns-attribute rest-arc-1 "nodeID")))
+ (let ((node-2s (get-resources-by-id id-2)))
+ (is (= (length node-2s) 1))
+ (is (= (length (dom:child-nodes (elt node-2s 0))) 2))
+ (is-true (property-p
+ (elt node-2s 0) *rdf-ns* "first"
+ :resource
+ "http://some.where/ballad/Der_Erlkoenig"))
+ (let ((rest-arc-2
+ (loop for item across (dom:child-nodes (elt node-2s 0))
+ when (let ((node-ns (dom:namespace-uri item))
+ (node-name (rdf-importer::get-node-name item))
+ (nodeID (rdf-importer::get-ns-attribute
+ item "nodeID")))
+ (and (string= node-ns *rdf-ns*)
+ (string= node-name "rest")
+ nodeID))
+ return item)))
+ (is-true rest-arc-2)
+ (let ((id-3 (rdf-importer::get-ns-attribute rest-arc-2
+ "nodeID")))
+ (let ((node-3s (get-resources-by-id id-3)))
+ (is (= (length node-3s) 1))
+ (is (= (length (dom:child-nodes (elt node-3s 0))) 2))
+ (is-true (property-p
+ (elt node-3s 0) *rdf-ns* "first"
+ :resource
+ "http://some.where/poem/Prometheus"))
+ (is-true
+ (property-p
+ (elt node-3s 0) *rdf-ns* "rest"
+ :resource
+ (concatenate 'string *rdf-ns* "nil")))))))))))))))
+
+
+(test test-association
+ "Tests a TM association with four roles and one item-identifier."
+ (with-fixture rdf-exporter-test-db ()
+ (let ((assoc-id (elephant::oid
+ (d:identified-construct
+ (elephant:get-instance-by-value
+ 'd:ItemIdentifierC 'd:uri
+ "http://some.where/test-association")))))
+ (is-true assoc-id)
+ (let ((assocs (get-resources-by-id
+ (concatenate 'string "id_" (write-to-string assoc-id)))))
+ (is (= (length assocs)))
+ (let ((me (elt assocs 0)))
+ (is (= (length (dom:child-nodes me)) 7))
+ (is-true (type-p me (concatenate 'string *tm2rdf-ns* "Association")))
+ (is-true (identifier-p me "http://some.where/test-association"))
+ (is-true (property-p me *tm2rdf-ns* "associationtype"
+ :resource (concatenate
+ 'string *sw-arc*
+ "associatedWithEachOther")))
+ (is-true (role-p me "http://some.where/roletype/writer"
+ nil :player-uri "http://some.where/author/Goethe"))
+
+ (let ((schiller-id (concatenate
+ 'string "id_"
+ (write-to-string
+ (elephant::oid
+ (d:topic
+ (elephant:get-instance-by-value
+ 'd:OccurrenceC 'd:charvalue
+ "http://de.wikipedia.org/wiki/Schiller")))))))
+ (is-true (role-p me "http://some.where/roletype/writer"
+ nil :player-id schiller-id)))
+ (is-true (role-p me "http://some.where/roletype/literature"
+ nil :player-uri "http://some.where/types/Poem"))
+ (is-true (role-p me "http://some.where/roletype/literature"
+ (list "http://some.where/test-role")
+ :player-uri "http://some.where/types/Ballad")))))))
+
+
+
+
+(defun run-rdf-exporter-tests()
+ "Runs all test cases of this suite."
+ (when elephant:*store-controller*
+ (elephant:close-store))
+ (it.bese.fiveam:run! 'test-resources)
+ (it.bese.fiveam:run! 'test-goethe)
+ (it.bese.fiveam:run! 'test-erlkoenig)
+ (it.bese.fiveam:run! 'test-prometheus)
+ (it.bese.fiveam:run! 'test-zauberlehrling)
+ (it.bese.fiveam:run! 'test-frankfurt)
+ (it.bese.fiveam:run! 'test-weimar)
+ (it.bese.fiveam:run! 'test-berlin)
+ (it.bese.fiveam:run! 'test-region)
+ (it.bese.fiveam:run! 'test-city-and-metropolis)
+ (it.bese.fiveam:run! 'test-germany)
+ (it.bese.fiveam:run! 'test-german)
+ (it.bese.fiveam:run! 'test-born-event)
+ (it.bese.fiveam:run! 'test-died-event)
+ (it.bese.fiveam:run! 'test-dateRange-zauberlehrling)
+ (it.bese.fiveam:run! 'test-dateRange-erlkoenig)
+ (it.bese.fiveam:run! 'test-dateRange-prometheus)
+ (it.bese.fiveam:run! 'test-schiller)
+ (it.bese.fiveam:run! 'test-single-nodes)
+ (it.bese.fiveam:run! 'test-collection)
+ (it.bese.fiveam:run! 'test-association))
\ No newline at end of file
More information about the Isidorus-cvs
mailing list