| 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 | (in-package :datamodel) |
|---|
| 11 | |
|---|
| 12 | (defgeneric equalT (construct1 construct2) |
|---|
| 13 | (:documentation "Test for full equality of two elephant objects")) |
|---|
| 14 | |
|---|
| 15 | (defmethod equalT ((x TopicMapConstructC) (y TopicMapConstructC)) |
|---|
| 16 | (when (equal (type-of x) (type-of y)) |
|---|
| 17 | (loop for slot in (sb-pcl:class-slots (find-class (type-of x))) |
|---|
| 18 | |
|---|
| 19 | ;; does not compare the OID and the DBCONNECTION-SPEC-PST slot |
|---|
| 20 | when(and (not (equal (symbol-name (sb-pcl:slot-definition-name slot)) "OID")) |
|---|
| 21 | (not (equal (symbol-name (sb-pcl:slot-definition-name slot)) "DBCONNECTION-SPEC-PST"))) |
|---|
| 22 | |
|---|
| 23 | ;; iterates through all lists in the 'TopicMapConstructC |
|---|
| 24 | do (if (equal 'CONS (type-of (slot-value x (sb-pcl:slot-definition-name slot)))) |
|---|
| 25 | (loop for item-x in (slot-value x (sb-pcl:slot-definition-name slot)) |
|---|
| 26 | for item-y in (slot-value y (sb-pcl:slot-definition-name slot)) |
|---|
| 27 | do (if (typep item-x 'TopicMapConstructC) |
|---|
| 28 | (when (not (equalT item-x item-y)) |
|---|
| 29 | (return-from equalT nil)) |
|---|
| 30 | (when (not (equal item-x item-y)) |
|---|
| 31 | (return-from equalT nil)))) |
|---|
| 32 | |
|---|
| 33 | ;; (else - not 'CONS) atomic values |
|---|
| 34 | (if (typep (sb-pcl:slot-definition-name slot) 'TopicMapConstructC) |
|---|
| 35 | (when (not (equalT (slot-value x (sb-pcl:slot-definition-name slot)) |
|---|
| 36 | (slot-value y (sb-pcl:slot-definition-name slot)))) |
|---|
| 37 | (return-from equalT nil)) |
|---|
| 38 | (when (not (equal (slot-value x (sb-pcl:slot-definition-name slot)) |
|---|
| 39 | (slot-value y (sb-pcl:slot-definition-name slot)))) |
|---|
| 40 | (return-from equalT nil)))) |
|---|
| 41 | (return-from equalT t))) |
|---|
| 42 | nil) |
|---|
