;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff ;;+ ;;+ Isidorus is freely distributable under the LLGPL license. ;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and ;;+ trunk/docs/LGPL-LICENSE.txt. ;;+----------------------------------------------------------------------------- (defpackage :importer-test (:use :common-lisp :xtm-importer :base-tools :datamodel :it.bese.FiveAM :unittests-constants :fixtures) (:import-from :constants *xtm2.0-ns*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-select-location-path) (:import-from :exceptions missing-reference-error duplicate-identifier-error not-mergable-error ) (:export :importer-test :test-error-detection :run-importer-tests :test-from-association-elem :test-create-instanceof-association :test-from-name-elem :test-from-scope-elem :test-from-type-elem :test-from-role-elem :test-from-occurrence-elem :test-merge-topic :test-setup-repository-xtm1.0 :test-topic-t100 :test-topicmaps :test-variants :test-variants-xtm1.0 :test-merge-topicmaps :test-merge-topicmaps-xtm1.0)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) (in-package :importer-test) (def-suite importer-test :description "tests various key functions of the importer") (in-suite importer-test) (defvar *T100-TM* (dom:document-element (cxml:parse-file *t100.xtm* (cxml-dom:make-dom-builder)))) (test test-from-type-elem "Test the from-type-elem function of the importer" (with-fixture initialized-test-db() (let ((type-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "topic") (*xtm2.0-ns* "occurrence") (*xtm2.0-ns* "type")))) (rev-1 *TM-REVISION*)) (loop for type-elem in type-elems do (is (typep (from-type-elem type-elem rev-1) 'TopicC))) (is-false (from-type-elem nil rev-1)) (let ((t100-occtype (from-type-elem (first type-elems) rev-1))) (format t "occtype: ~a~&" t100-occtype) (format t "occtype: ~a~&" (psis t100-occtype)) (is (string= "http://psi.egovpt.org/types/standardHasStatus" (uri (first (psis t100-occtype))))))))) (test test-from-scope-elem "Test the from-scope-elem function of the importer" (declare (optimize (debug 3))) (with-fixture initialized-test-db() (let ((scope-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "topic") (*xtm2.0-ns* "name") (*xtm2.0-ns* "scope")))) (rev-1 *TM-REVISION*)) (loop for scope-elem in scope-elems do (is (>= (length (from-scope-elem scope-elem rev-1)) 1))) (is-false (from-scope-elem nil rev-1)) (let ((t101-themes (from-scope-elem (first scope-elems) rev-1))) (is (= 1 (length t101-themes))) (is (string= (topic-id (first t101-themes) rev-1 *TEST-TM*) "t50a")))))) (test test-from-name-elem "Test the from-name-elem function of the importer" (with-fixture initialized-test-db() (let ((name-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "topic") (*xtm2.0-ns* "name")))) (top (get-item-by-id "t1")) ;an arbitrary topic (rev-1 *TM-REVISION*)) (loop for name-elem in name-elems do (is (typep (from-name-elem name-elem top rev-1) 'NameC))) (let ((t1-name (from-name-elem (first name-elems) top rev-1)) (t1-name-copy (from-name-elem (first name-elems) top rev-1)) (t101-longname (from-name-elem (nth 27 name-elems) top rev-1))) (is (string= (charvalue t1-name) "Topic Type")) (is (string= (charvalue t101-longname) "ISO/IEC 13250:2002: Topic Maps")) (is (= 1 (length (item-identifiers t101-longname :revision rev-1)))) (is (string= (uri (first (psis (instance-of t101-longname)))) "http://psi.egovpt.org/types/long-name")) (is (themes t101-longname :revision rev-1)) (is (string= (topic-id (first (themes t101-longname :revision rev-1)) rev-1 *TEST-TM*) "t50a")) (is (eq t1-name t1-name-copy)))))) ;must be merged (test test-from-occurrence-elem "Test the form-occurrence-elem function of the importer" (with-fixture initialized-test-db() (let ((occ-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "topic") (*xtm2.0-ns* "occurrence")))) (top (get-item-by-id "t1")) ;an abritrary topic (rev-1 *TM-REVISION*)) (loop for occ-elem in occ-elems do (is (typep (from-occurrence-elem occ-elem top rev-1) 'OccurrenceC))) (is (= 1 (length (elephant:get-instances-by-value 'ItemIdentifierC 'uri "http://psi.egovpt.org/itemIdentifiers#t100_o1")))) (let ((t100-occ1 (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://psi.egovpt.org/itemIdentifiers#t100_o1"))) (t100-occ2 (identified-construct (elephant:get-instance-by-value 'ItemIdentifierC 'uri "http://psi.egovpt.org/itemIdentifiers#t100_o2")))) (is (= 1 (length (item-identifiers t100-occ1 :revision rev-1)))) ;just to double-check (is (string= (uri (first (item-identifiers t100-occ1 :revision rev-1))) "http://psi.egovpt.org/itemIdentifiers#t100_o1")) (is (string= (charvalue t100-occ1) "http://www.budabe.de/")) (is (string= (datatype t100-occ1) "http://www.w3.org/2001/XMLSchema#anyURI")) (is (string= (datatype t100-occ2) "http://www.w3.org/2001/XMLSchema#string")))))) (test test-merge-topic "Test the merge-topic-elem function of the importer" (with-fixture initialized-test-db() (let ((topic-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "topic")))) (rev-1 *TM-REVISION*)) (loop for topic-elem in topic-elems do (is (typep (merge-topic-elem topic-elem rev-1 :tm fixtures::tm) 'TopicC))) (let ((top-t1 (merge-topic-elem (first topic-elems) rev-1 :tm fixtures::tm)) (top-t57 (get-item-by-id "t57")) (top-t101 (get-item-by-id "t101")) (top-t301 (get-item-by-id "t301")) (top-t301a (get-item-by-id "t301a")) ;one of the core PSIs (top-sup-sub (get-item-by-id "supertype-subtype" :xtm-id "core.xtm"))) (is (= (elephant::oid top-t301) (elephant::oid top-t301a))) (is-true top-t301a) (is (= (length (occurrences top-t1 :revision rev-1)) 0)) (is (= (length (occurrences top-t101 :revision rev-1)) 4)) (is (= (length (names top-t57 :revision rev-1)) 1)) (is (string= (uri (first (item-identifiers top-t57 :revision rev-1))) "http://psi.egovpt.org/itemIdentifiers#t57")) (is (= 2 (length (names top-t101 :revision rev-1)))) (is (= 2 (length (names top-t301 :revision rev-1)))) ;after merge (is-true (item-identifiers (first (names top-t301 :revision rev-1)) :revision rev-1)) ;after merge (is (= 2 (length (psis top-t301 :revision rev-1)))) ;after merge (is (= 3 (length (occurrences top-t301 :revision rev-1)))) ;after merge (is (string= "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype" (uri (first (psis top-sup-sub :revision rev-1))))))) ;34 topics in 35 topic elements in notificationbase.xtm and 14 ;core topics (is (= (+ 34 14) (length (elephant:get-instances-by-class 'TopicC)))))) (test test-from-role-elem "Test the form-role-elem function of the importer" (with-fixture initialized-test-db() (let ((role-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "association") (*xtm2.0-ns* "role")))) (rev-1 *TM-REVISION*)) (loop for role-elem in role-elems do (is (typep (from-role-elem role-elem revision) 'list))) (let ((12th-role (from-role-elem (nth 11 role-elems) revision))) (is (string= "t101" (topic-id (getf 12th-role :player) rev-1 *TEST-TM*))) (is (string= "t62" (topic-id (getf 12th-role :instance-of) rev-1 *TEST-TM*))))))) (test test-from-association-elem "Test the form-association-elem function of the importer" (with-fixture initialized-test-db() (let ((assoc-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "association")))) (rev-1 *TM-REVISION*)) (loop for assoc-elem in assoc-elems do (is (typep (from-association-elem assoc-elem rev-1 :tm fixtures::tm) 'AssociationC))) (let ((6th-assoc (sixth (elephant:get-instances-by-class 'AssociationC))) (last-assoc (seventh (elephant:get-instances-by-class 'AssociationC)))) (is (= 2 (length (roles last-assoc :revision rev-1)))) (is (= 1 (length (item-identifiers last-assoc :revision rev-1)))) (is (string= "t300" (topic-id (player (first (roles 6th-assoc :revision rev-1)) :revision rev-1) rev-1 *TEST-TM*))) (is (string= "t63" (topic-id (instance-of (first (roles 6th-assoc :revision rev-1)) :revision rev-1) rev-1 *TEST-TM*))) (is (string= "t301" (topic-id (player (first (roles last-assoc :revision rev-1)) :revision rev-1) rev-1 *TEST-TM*))))) (is (= 7 (length (elephant:get-instances-by-class 'AssociationC)))))) (test test-create-instanceof-association "Test the creation of instanceof associations" (declare (optimize (debug 3))) (with-fixture initialized-test-db() (let ((topic-elems (xpath-select-location-path *XTM-TM* '((*xtm2.0-ns* "topic")))) (rev-1 *TM-REVISION*)) (loop for topic-elem in topic-elems do (let (;this already implicitly creates the instanceOf ;associations as needed (topic (merge-topic-elem topic-elem rev-1 :tm fixtures::tm))) (dolist (io-role (map 'list #'d::parent-construct (d::slot-p topic 'd::player-in-roles))) (let ((io-assoc (parent io-role :revision rev-1))) (is (typep io-assoc 'AssociationC)) (is (string= (topic-id topic rev-1) (topic-id (player (second (roles io-assoc :revision rev-1)) :revision rev-1) rev-1))))))) (let* ((t101-top (get-item-by-id "t101" :revision rev-1)) ;get all the roles t101 is involved in (roles-101 (map 'list #'d::parent-construct (d::slot-p t101-top 'd::player-in-roles))) ;and filter those whose roletype is "instance" ;(returning, of course, a list) ;TODO: what we'd really need ;is a filter that works ;directly on the indices ;rather than instantiating ;many unnecessary role objects (role-101 (remove-if-not (lambda (role) (string= (uri (first (psis (instance-of role :revision rev-1) :revision rev-1))) "http://psi.topicmaps.org/iso13250/model/instance")) roles-101))) ;Topic t101 (= Topic Maps 2002 ;standard) is subclass of ;topic t3a (semantic standard) (is-true t101-top) (is (= 1 (length role-101))) (is (string= "t3a" (topic-id (player (first (roles (parent (first role-101)) :revision rev-1)) :revision rev-1) rev-1 *TEST-TM*))) (is (string= "type-instance" (topic-id (instance-of (parent (first role-101) :revision rev-1)) rev-1 "core.xtm"))))))) (test test-error-detection "Test for the detection of common errors such as dangling references, duplicate PSIs or item identifiers" (declare (optimize (debug 3))) (with-fixture bare-test-db() (signals missing-reference-error (let ((di-xtm-dom (dom:document-element (cxml:parse-file *dangling_instanceof.xtm* (cxml-dom:make-dom-builder))))) (importer di-xtm-dom :xtm-id "missing-reference-error-1" :tm-id "http://www.isidor.us/unittests/baretests")))) (with-fixture bare-test-db() (signals missing-reference-error (let ((xtm-dom (dom:document-element (cxml:parse-file *dangling_topicref.xtm* (cxml-dom:make-dom-builder))))) (importer xtm-dom :xtm-id "missing-reference-error-2" :tm-id "http://www.isidor.us/unittests/baretests")))) (with-fixture bare-test-db() (signals not-mergable-error (let ((xtm-dom (dom:document-element (cxml:parse-file *duplicate_identifier.xtm* (cxml-dom:make-dom-builder))))) (importer xtm-dom :xtm-id "duplicate-identifier-error-1" :tm-id "http://www.isidor.us/unittests/baretests"))))) (test test-topic-t100 "test for the entire topic t100. checks all slot values and references" (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xtm-importer:setup-repository *t100.xtm* dir :xtm-id *TEST-TM* :tm-id "http://www.isidor.us/unittests/topic-t100") (open-tm-store dir) (is (= 26 (length (elephant:get-instances-by-class 'TopicC)))) ;; are all topics in the db + std topics (is-true (get-item-by-id "t100" :revision 0)) ;; main topic (is-true (get-item-by-id "t3a" :revision 0)) ;; instanceOf (is-true (get-item-by-id "t50a" :revision 0)) ;; scope (is-true (get-item-by-id "t51" :revision 0)) ;; occurrence/type (is-true (get-item-by-id "t52" :revision 0)) ;; occurrence/resourceRef (is-true (get-item-by-id "t53" :revision 0)) ;; occurrence/type (is-true (get-item-by-id "t54" :revision 0)) ;; occurrence/type (is-true (get-item-by-id "t55" :revision 0)) ;; occurrence/type (let ((t100 (get-item-by-id "t100" :revision 0))) ;; checks instanceOf (is (= 1 (length (player-in-roles t100 :revision 0)))) (let* ((role-t100 (first (player-in-roles t100 :revision 0))) (assoc (parent role-t100 :revision 0)) (role-t3a (first (roles assoc :revision 0)))) (is (= 1 (length (psis (instance-of role-t100 :revision 0) :revision 0)))) (is (string= (uri (first (psis (instance-of role-t100 :revision 0) :revision 0))) "http://psi.topicmaps.org/iso13250/model/instance")) (is (= 1 (length (psis (instance-of role-t3a :revision 0) :revision 0)))) (is (string= (uri (first (psis (instance-of role-t3a :revision 0) :revision 0))) "http://psi.topicmaps.org/iso13250/model/type"))) ;; checks subjectIdentifier (is (= 1 (length (psis t100 :revision 0)))) (is (string= "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata" (uri (first (psis t100 :revision 0))))) (is (equal (identified-construct (first (psis t100 :revision 0)) :revision 0) t100)) ;;other association part ;; checks names (is (= 2 (length (names t100 :revision 0)))) (loop for item in (names t100 :revision 0) do (is (or (string= (charvalue item) "ISO 19115") (and (string= (charvalue item) "ISO 19115:2003 Geographic Information - Metadata") (= (length (themes item :revision 0)) 1) (= (length (psis (first (themes item :revision 0)) :revision 0))) (string= (uri (first (psis (first (themes item :revision 0)) :revision 0))) "http://psi.egovpt.org/types/long-name"))))) (is-true (used-as-theme (get-item-by-id "t50a" :revision 0) :revision 0)) ;checks the other part of the association -> fails ;; checks occurrences (setf *TM-REVISION* 0) (is (= 4 (length (occurrences (get-item-by-id "t100"))))) (loop for item in (occurrences t100) when (elephant:associatedp (get-item-by-id "t51") 'datamodel::used-as-type item) do (progn (is (string= (charvalue item) "#t52")) (is (string= (uri (first (psis (instance-of item)))) "http://psi.egovpt.org/types/standardHasStatus"))) when (elephant:associatedp (get-item-by-id "t53") 'datamodel::used-as-type item) do (progn (is (string= (charvalue item) "The ISO 19115 standard ...")) (is (string= (datatype item) "http://www.w3.org/2001/XMLSchema#string")) (is (string= (uri (first (psis (instance-of item)))) "http://psi.egovpt.org/types/description"))) when (elephant:associatedp (get-item-by-id "t54") 'datamodel::used-as-type item) do (progn (is (string= (charvalue item) "2003-01-01")) (is (string= (datatype item) "http://www.w3.org/2001/XMLSchema#date")) (is (string= (uri (first (psis (instance-of item)))) "http://psi.egovpt.org/types/standardValidFromDate"))) when (elephant:associatedp (get-item-by-id "t55") 'datamodel::used-as-type item) do (progn (is (string= (charvalue item) "http://www.editeur.org/standards/ISO19115.pdf")) (is (string= (uri (first (psis (instance-of item)))) "http://psi.egovpt.org/types/links")))))))) (test test-setup-repository-xtm1.0 "tests the importer-xtm1.0 functions" (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xtm-importer:setup-repository *sample_objects.xtm* dir :tm-id "http://www.isidor.us/unittests/xtm1.0-tests" :xtm-id *TEST-TM* :xtm-format :1.0) (setf *TM-REVISION* 0) (open-tm-store dir) ;14 + (23 core topics) (is (= 37 (length (elephant:get-instances-by-class 'TopicC)))) ;2 + (11 instanceOf) (is (= 13 (length (elephant:get-instances-by-class 'AssociationC)))) ;4 + (22 instanceOf-associations) (is (= 26 (length (elephant:get-instances-by-class 'RoleC)))) ;23 + (14 core topics) (is (= 37 (length (elephant:get-instances-by-class 'PersistentIdC)))) (is (= 0 (length (elephant:get-instances-by-class 'SubjectLocatorC)))) ;2 + (0 core topics) (is (= 2 (length (elephant:get-instances-by-class 'OccurrenceC)))) ;18 + (0 core topics) (is (= 18 (length (elephant:get-instances-by-class 'NameC)))) (let ((t-2526 (get-item-by-id "t-2526")) (t-2656 (get-item-by-id "t-2656")) (assoc (first (used-as-type (get-item-by-id "t89671052499"))))) (is (= (length (player-in-roles t-2526)) 1)) (is (= (length (psis t-2526)) 1)) (is (string= (uri (first (psis t-2526))) "http://psi.egovpt.org/types/serviceUsesTechnology")) (is (= (length (names t-2526)) 3)) (is (or (string= (charvalue (first (names t-2526))) "service uses technology") (string= (charvalue (second (names t-2526))) "service uses technology") (string= (charvalue (third (names t-2526))) "service uses technology"))) (is (or (string= (charvalue (first (names t-2526))) "uses technology") (string= (charvalue (second (names t-2526))) "uses technology") (string= (charvalue (third (names t-2526))) "uses technology"))) (is (or (string= (charvalue (first (names t-2526))) "used by service") (string= (charvalue (second (names t-2526))) "used by service") (string= (charvalue (third (names t-2526))) "used by service"))) (loop for name in (names t-2526) when (string= (charvalue name) "uses technology") do (is (= (length (themes name)) 1)) (is (eq (first (themes name)) (get-item-by-id "t-2555"))) when (string= (charvalue name) "used by service") do (is (= (length (themes name)) 1)) (is (eq (first (themes name)) (get-item-by-id "t-2593")))) (is (= (length (player-in-roles t-2656)) 2)) ;association + instanceOf (is (= (length (psis t-2656)) 1)) (is (string= (uri (first (psis t-2656))) "http://psi.egovpt.org/types/DO-NOT-SIGNAL-no-identifier-error")) (is (= (length (occurrences t-2656)) 2)) (loop for occ in (occurrences t-2656) when (eq (instance-of occ) (get-item-by-id "t-2625")) do (is (string= (charvalue occ) "0")) (is (string= (datatype occ) "http://www.w3.org/2001/XMLSchema#string")) when (eq (instance-of occ) (get-item-by-id "t-2626")) do (is (string= (charvalue occ) "unbounded")) (is (string= (datatype occ) "http://www.w3.org/2001/XMLSchema#string")) when (not (or (eq (instance-of occ) (get-item-by-id "t-2625")) (eq (instance-of occ) (get-item-by-id "t-2626")))) do (is-true (format t "bad occurrence found in t-2526"))) (is (= (length (roles assoc)) 2)) (loop for role in (roles assoc) when (eq (player role) (get-item-by-id "all-subjects")) do (is (eq (instance-of role) (get-item-by-id "broader-term"))) when (eq (player role) (get-item-by-id "t1106723946")) do (is (eq (instance-of role) (get-item-by-id "narrower-term"))) when (not (or (eq (player role) (get-item-by-id "all-subjects")) (eq (player role) (get-item-by-id "t1106723946")))) do (is-true (format t "bad role found in association: ~A" (topic-identifiers (player role))))))))) (test test-variants (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xtm-importer:setup-repository *notificationbase.xtm* dir :xtm-id *TEST-TM* :tm-id "http://isidorus.org/test-tm") (setf *TM-REVISION* 0) (open-tm-store dir) (let ((variants (elephant:get-instances-by-class 'VariantC))) (is (= (length variants) 4)) (loop for variant in variants do (let ((resourceData (charvalue variant)) (d-type (datatype variant)) (string-type "http://www.w3.org/2001/XMLSchema#string") (itemIdentities (map 'list #'uri (item-identifiers variant))) (parent-name-value (charvalue (parent variant))) (scopes (map 'list #'uri (map 'list #'(lambda(x) (first (psis x))) ;these topics have only one psi (themes variant)))) (sort-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") (display-psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display") (t50a-psi "http://psi.egovpt.org/types/long-name")) (cond ((string= resourceData "Long-Version") (is (string= parent-name-value "long version of a name")) (is (= (length (variants (parent variant))) 1)) (is (eql variant (first (variants (parent variant))))) (check-for-duplicate-identifiers variant) (is-false itemIdentities) (is (= (length scopes) 1)) (is (string= (first scopes) sort-psi)) (is (string= d-type string-type))) ((string= resourceData "Geographic Information - Metadata") (is (string= parent-name-value "ISO 19115")) (is (= (length (variants (parent variant))) 2)) (is (or (eql variant (first (variants (parent variant)))) (eql variant (second (variants (parent variant)))))) (check-for-duplicate-identifiers variant) (is (= (length scopes) 1)) (is (string= (first scopes) display-psi)) (is (= (length itemIdentities) 1)) (is (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t100_n1_v1")) (is (string= d-type string-type))) ((string= resourceData "ISO-19115") (check-for-duplicate-identifiers variant) (is (= (length itemIdentities) 1)) (is (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t100_n1_v2")) (is (= (length scopes) 1)) (is (string= (first scopes) sort-psi)) (is (string= d-type string-type))) ((string= resourceData "ISO/IEC-13250:2002") (is (string= parent-name-value "ISO/IEC 13250:2002: Topic Maps")) (is (= (length (variants (parent variant))) 1)) (is (eql variant (first (variants (parent variant))))) (check-for-duplicate-identifiers variant) (check-for-duplicate-identifiers variant) (is (= (length scopes) 2)) (is (or (string= (first scopes) t50a-psi) (string= (first scopes) sort-psi))) (is (or (string= (second scopes) t50a-psi) (string= (second scopes) sort-psi))) (is (= (length itemIdentities) 2)) (is (or (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1") (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2"))) (is (or (string= (second itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1") (string= (second itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2"))) (is (string= d-type string-type))) (t (is-true (format t "found bad resourceData in variant object: ~A~%" resourceData)))))))))) (test test-variants-xtm1.0 "tests the importer-xtm1.0 -> variants" (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xtm-importer:setup-repository *sample_objects.xtm* dir :xtm-id *TEST-TM* :xtm-format :1.0 :tm-id "http://isidorus.org/test-tm") (open-tm-store dir) (is (= (length (elephant:get-instances-by-class 'VariantC)) 5)) (let ((t-2526 (get-item-by-id "t-2526"))) (loop for baseName in (names t-2526) do (let ((baseNameString (charvalue baseName)) (name-variants (variants baseName))) (loop for variant in name-variants do (is (string= (datatype variant) "http://www.w3.org/2001/XMLSchema#string"))) (cond ((string= baseNameString "service uses technology") (is (= (length name-variants) 2)) (loop for variant in name-variants do (is (eql baseName (parent variant))) (let ((variantName (charvalue variant))) (cond ((string= variantName "service-uses-technology") (is (= (length (themes variant)) 1)) (is (eql (first (themes variant)) (get-item-by-id "sort")))) ((string= variantName "service uses technology") (is (= (length (themes variant)) 1)) (is (eql (first (themes variant)) (get-item-by-id "display")))) (t (is-true (format t "basevariantName found in t-2526: ~A~%" variantName))))))) ((string= baseNameString "uses technology") (is (= (length name-variants) 2)) (loop for variant in name-variants do (is (eql baseName (parent variant))) (let ((variantName (charvalue variant))) (cond ((string= variantName "uses technology") (is (= (length (themes variant)) 2)) (is-true (find (get-item-by-id "t-2555") (themes variant) :test #'eql)) (is-true (find (get-item-by-id "display") (themes variant) :test #'eql))) ((string= variantName "uses-technology") (is (= (length (themes variant)) 3)) (is-true (find (get-item-by-id "t-2555") (themes variant) :test #'eql)) (is-true (find (get-item-by-id "display") (themes variant) :test #'eql)) (is-true (find (get-item-by-id "sort") (themes variant) :test #'eql))) (t (is-true (format t "bad variantName found in t-2526: ~A~%" variantName))))))) ((string= baseNameString "used by service") (is (= (length name-variants) 1)) (loop for variant in name-variants do (is (eql baseName (parent variant))) (is (string= (charvalue variant) "used-by-service")) (is (= (length (themes variant)) 3)) (is-true (find (get-item-by-id "t-2593") (themes variant) :test #'eql)) (is-true (find (get-item-by-id "display") (themes variant) :test #'eql)) (is-true (find (get-item-by-id "sort") (themes variant) :test #'eql)))) (t (is-true (format t "bad baseNameString found in names of t-2526: ~A~%" baseNameString)))))))))) (test test-topicmaps "Test the working of the TopicMap class" (with-fixture initialized-test-db() (let ((tms (elephant:get-instances-by-class 'd:TopicMapC))) (is (= 2 (length tms))) (is-false (set-exclusive-or '("http://www.isidor.us/unittests/testtm" "http://www.topicmaps.org/xtm/1.0/core.xtm") (mapcan (lambda (tm) (mapcar #'uri (item-identifiers tm :revision 0))) tms) :test #'string=))))) (test test-merge-topicmaps (let ((dir "data_base") (tm-id-1 "tm-id-1") (tm-id-2 "tm-id-2")) (with-fixture with-empty-db (dir) (xtm-importer:setup-repository *poems_light_tm_ii.xtm* dir :tm-id tm-id-1) (xtm-importer:import-from-xtm *poems_light_tm_ii_merge.xtm* dir :tm-id tm-id-2) (with-revision 0 (let ((tm-1 (d:identified-construct (first (elephant:get-instances-by-value 'd:ItemIdentifierC 'd:uri tm-id-1)))) (tm-2 (d:identified-construct (first (elephant:get-instances-by-value 'd:ItemIdentifierC 'd:uri tm-id-2))))) (is-true tm-1) (is-true tm-2) (is (eql tm-1 tm-2)) (is-false (set-exclusive-or (map 'list #'d:uri (item-identifiers tm-1)) (list tm-id-1 tm-id-2 "http://some.where/poems_light_tm_ii_1" "http://some.where/poems_light_tm_ii_2") :test #'string=)) (is (eql (reifier tm-1) (d:get-item-by-item-identifier "http://some.where/poems/topicMap-reifier"))) (is (= (length (d:topics tm-1)) (+ 9 3))) (is (= (length (d:associations tm-1)) (+ 1 3))) (is (= (length (d:in-topicmaps (d:get-item-by-id "schiller"))) 1)) (is (eql (first (d:in-topicmaps (d:get-item-by-id "schiller"))) tm-1)) (let ((schiller-1 (d:get-item-by-id "schiller" :revision (first (last (d:get-all-revisions))))) (schiller-2 (d:get-item-by-id "schiller" :revision (elt (d:get-all-revisions) (- (length (d:get-all-revisions)) 2))))) (is-true schiller-1) (is-false schiller-2))))))) (test test-merge-topicmaps-xtm1.0 (let ((dir "data_base") (tm-id-1 "tm-id-1")) (with-fixture with-empty-db (dir) (xtm-importer:setup-repository *poems_light_tm_reification_xtm1.0.xtm* dir :tm-id tm-id-1 :xtm-format :1.0) (open-tm-store dir) (with-revision 0 (let ((tm-1 (d:identified-construct (first (elephant:get-instances-by-value 'd:ItemIdentifierC 'd:uri tm-id-1))))) (is-true tm-1) (is (= (length (topics tm-1)) (+ 8 3))) (is (= (length (associations tm-1)) (+ 1 2))) (is (eql (reifier tm-1) (get-item-by-psi "#tm-reifier")))))))) (defun run-importer-tests () (run! 'importer-test))