Author: lgiessmann Date: Tue Mar 16 07:32:28 2010 New Revision: 227 Log: new-datamodel: added some unit-tests for equivalent-constructs --> OccurrenceC, NameC, VariantC; changed some "dangerous" code-sections in equivalent-construct Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Tue Mar 16 07:32:28 2010 @@ -1445,32 +1445,42 @@ ;;; OccurrenceC (defmethod equivalent-construct ((construct OccurrenceC) - &key (start-revision 0) (charvalue "") + &key (start-revision 0) (reifier nil) + (item-identifiers nil) (charvalue "") (themes nil) (instance-of nil) - (datatype *xml-string*)) + (datatype "")) (declare (type (or null TopicC) instance-of) (string datatype) - (ignorable start-revision charvalue themes instance-of)) + (ignorable start-revision charvalue themes instance-of + reifier item-identifiers)) (let ((equivalent-characteristic (call-next-method))) - (and equivalent-characteristic - (string= (datatype construct) datatype)))) + (or (and equivalent-characteristic + (string= (datatype construct) datatype)) + (equivalent-reifiable-construct construct reifier item-identifiers + :start-revision start-revision)))) ;;; VariantC (defmethod equivalent-construct ((construct VariantC) - &key (start-revision 0) (charvalue "") - (themes nil) (datatype *xml-string*)) - (declare (string datatype) (ignorable start-revision charvalue themes)) + &key (start-revision 0) (reifier nil) + (item-identifiers nil) (charvalue "") + (themes nil) (datatype "")) + (declare (string datatype) (ignorable start-revision charvalue themes + reifier item-identifiers)) (let ((equivalent-characteristic (call-next-method))) - (and equivalent-characteristic - (string= (datatype construct) datatype)))) + (or (and equivalent-characteristic + (string= (datatype construct) datatype)) + (equivalent-reifiable-construct construct reifier item-identifiers + :start-revision start-revision)))) ;;; NameC (defmethod equivalent-construct ((construct NameC) - &key (start-revision 0) (charvalue "") + &key (start-revision 0) (reifier nil) + (item-identifiers nil) (charvalue "") (themes nil) (instance-of nil)) (declare (type (or null TopicC) instance-of) - (ignorable start-revision charvalue instance-of themes)) + (ignorable start-revision charvalue instance-of themes + reifier item-identifiers)) (call-next-method)) @@ -1759,9 +1769,11 @@ &key (start-revision 0)) (declare (integer start-revision) (list item-identifiers) (type (or null TopicC) reifier)) - (or (eql reifier (reifier construct :revision start-revision)) - (intersection (item-identifiers construct :revision start-revision) - item-identifiers)))) + (or (and (reifier construct :revision start-revision) + (eql reifier (reifier construct :revision start-revision))) + (and (item-identifiers construct :revision start-revision) + (intersection (item-identifiers construct :revision start-revision) + item-identifiers))))) (defmethod delete-construct :before ((construct ReifiableConstructC)) Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Tue Mar 16 07:32:28 2010 @@ -16,6 +16,8 @@ :unittests-constants) (:import-from :exceptions duplicate-identifier-error) + (:import-from :constants + *xml-string*) (:export :run-datamodel-tests :datamodel-test :test-VersionInfoC @@ -48,7 +50,10 @@ :test-delete-ScopableC :test-delete-AssociationC :test-delete-RoleC - :test-equivalent-PointerC)) + :test-equivalent-PointerC + :test-equivalent-OccurrenceC + :test-equivalent-NameC + :test-equivalent-VariantC)) ;;TODO: test merge-constructs when merging was caused by an item-dentifier, @@ -1356,6 +1361,136 @@ (is-false (d::equivalent-construct psi-1 :uri "psi-2"))))) +(test test-equivalent-OccurrenceC () + "Tests the functions equivalent-construct depending on OccurrenceC." + (with-fixture with-empty-db (*db-dir*) + (let ((occ-1 (make-instance 'd:OccurrenceC :charvalue "occ-1")) + (type-1 (make-instance 'd:TopicC)) + (type-2 (make-instance 'd:TopicC)) + (scope-1 (make-instance 'd:TopicC)) + (scope-2 (make-instance 'd:TopicC)) + (scope-3 (make-instance 'd:TopicC)) + (reifier-1 (make-instance 'd:TopicC)) + (reifier-2 (make-instance 'd:TopicC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (revision-0-5 50) + (version-1 100)) + (setf *TM-REVISION* version-1) + (add-type occ-1 type-1) + (add-theme occ-1 scope-1) + (add-theme occ-1 scope-2) + (is-true (d::equivalent-construct + occ-1 :charvalue "occ-1" :datatype constants:*xml-string* + :instance-of type-1 :themes (list scope-2 scope-1))) + (is-false (d::equivalent-construct + occ-1 :charvalue "occ-1" :datatype constants:*xml-string* + :instance-of type-1 :themes (list scope-2 scope-1) + :start-revision revision-0-5)) + (is-false (d::equivalent-construct + occ-1 :charvalue "occ-1" :datatype constants:*xml-string* + :instance-of type-2 :themes (list scope-1 scope-2))) + (is-false (d::equivalent-construct + occ-1 :charvalue "occ-1" :datatype constants:*xml-string* + :instance-of type-1 :themes (list scope-3 scope-2))) + (is-false (d::equivalent-construct + occ-1 :charvalue "occ-1" + :instance-of type-1 :themes (list scope-1 scope-2))) + (is-false (d::equivalent-construct + occ-1 :charvalue "occ-2" :datatype constants:*xml-string* + :instance-of type-1 :themes (list scope-2 scope-1))) + (add-item-identifier occ-1 ii-1) + (is-true (d::equivalent-construct occ-1 :item-identifiers (list ii-1))) + (is-false (d::equivalent-construct occ-1 :item-identifiers (list ii-2))) + (add-reifier occ-1 reifier-1) + (is-true (d::equivalent-construct occ-1 :reifier reifier-1)) + (is-false (d::equivalent-construct occ-1 :reifier reifier-2))))) + + +(test test-equivalent-NameC () + "Tests the functions equivalent-construct depending on NameC." + (with-fixture with-empty-db (*db-dir*) + (let ((nam-1 (make-instance 'd:NameC :charvalue "nam-1")) + (type-1 (make-instance 'd:TopicC)) + (type-2 (make-instance 'd:TopicC)) + (scope-1 (make-instance 'd:TopicC)) + (scope-2 (make-instance 'd:TopicC)) + (scope-3 (make-instance 'd:TopicC)) + (reifier-1 (make-instance 'd:TopicC)) + (reifier-2 (make-instance 'd:TopicC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (revision-0-5 50) + (version-1 100)) + (setf *TM-REVISION* version-1) + (add-type nam-1 type-1) + (add-theme nam-1 scope-1) + (add-theme nam-1 scope-2) + (is-true (d::equivalent-construct + nam-1 :charvalue "nam-1" :instance-of type-1 + :themes (list scope-2 scope-1))) + (is-false (d::equivalent-construct + nam-1 :charvalue "nam-1" :instance-of type-1 + :themes (list scope-2 scope-1) + :start-revision revision-0-5)) + (is-false (d::equivalent-construct + nam-1 :charvalue "nam-1" :instance-of type-2 + :themes (list scope-1 scope-2))) + (is-false (d::equivalent-construct + nam-1 :charvalue "nam-1" :instance-of type-1 + :themes (list scope-3 scope-2))) + (is-false (d::equivalent-construct + nam-1 :charvalue "nam-2" :instance-of type-1 + :themes (list scope-2 scope-1))) + (add-item-identifier nam-1 ii-1) + (is-true (d::equivalent-construct nam-1 :item-identifiers (list ii-1))) + (is-false (d::equivalent-construct nam-1 :item-identifiers (list ii-2))) + (add-reifier nam-1 reifier-1) + (is-true (d::equivalent-construct nam-1 :reifier reifier-1)) + (is-false (d::equivalent-construct nam-1 :reifier reifier-2))))) + + +(test test-equivalent-VariantC () + "Tests the functions equivalent-construct depending on VariantC." + (with-fixture with-empty-db (*db-dir*) + (let ((var-1 (make-instance 'd:OccurrenceC :charvalue "var-1")) + (scope-1 (make-instance 'd:TopicC)) + (scope-2 (make-instance 'd:TopicC)) + (scope-3 (make-instance 'd:TopicC)) + (reifier-1 (make-instance 'd:TopicC)) + (reifier-2 (make-instance 'd:TopicC)) + (ii-1 (make-instance 'd:ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC :uri "ii-2")) + (revision-0-5 50) + (version-1 100)) + (setf *TM-REVISION* version-1) + (add-theme var-1 scope-1) + (add-theme var-1 scope-2) + (is-true (d::equivalent-construct + var-1 :charvalue "var-1" :datatype constants:*xml-string* + :themes (list scope-2 scope-1))) + (is-false (d::equivalent-construct + var-1 :charvalue "var-1" :datatype constants:*xml-string* + :themes (list scope-2 scope-1) + :start-revision revision-0-5)) + (is-false (d::equivalent-construct + var-1 :charvalue "var-1" :datatype constants:*xml-string* + :themes (list scope-3 scope-2))) + (is-false (d::equivalent-construct + var-1 :charvalue "var-1" + :themes (list scope-1 scope-2))) + (is-false (d::equivalent-construct + var-1 :charvalue "var-2" :datatype constants:*xml-string* + :themes (list scope-2 scope-1))) + (add-item-identifier var-1 ii-1) + (is-true (d::equivalent-construct var-1 :item-identifiers (list ii-1))) + (is-false (d::equivalent-construct var-1 :item-identifiers (list ii-2))) + (add-reifier var-1 reifier-1) + (is-true (d::equivalent-construct var-1 :reifier reifier-1)) + (is-false (d::equivalent-construct var-1 :reifier reifier-2))))) + + + (defun run-datamodel-tests() "Runs all tests of this test-suite." (it.bese.fiveam:run! 'test-VersionInfoC) @@ -1389,4 +1524,7 @@ (it.bese.fiveam:run! 'test-delete-AssociationC) (it.bese.fiveam:run! 'test-delete-RoleC) (it.bese.fiveam:run! 'test-equivalent-PointerC) + (it.bese.fiveam:run! 'test-equivalent-OccurrenceC) + (it.bese.fiveam:run! 'test-equivalent-NameC) + (it.bese.fiveam:run! 'test-equivalent-VariantC) ) \ No newline at end of file