Author: lgiessmann Date: Sun Feb 21 15:34:01 2010 New Revision: 199 Log: new-datamodel: added some example code files that analyses certain situations and elephant's behviour Added: branches/new-datamodel/playground/ branches/new-datamodel/playground/ii_versioned_association.lisp branches/new-datamodel/playground/system_crash.lisp branches/new-datamodel/playground/versioned-pointer.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp Added: branches/new-datamodel/playground/ii_versioned_association.lisp ============================================================================== --- (empty file) +++ branches/new-datamodel/playground/ii_versioned_association.lisp Sun Feb 21 15:34:01 2010 @@ -0,0 +1,117 @@ +(asdf:operate 'asdf:load-op 'elephant) +(use-package :elephant) + +(defpclass VersionInfoC() + ((start-revision :initarg :start-revision + :accessor start-revision + :type integer + :initform 0) + (end-revision :initarg :end-revision + :accessor end-revision + :type integer + :initform 0) + (versioned-construct :initarg :versioned-construct + :accessor versioned-construct + :associate VersionedConstructC))) + +(defpclass VersionedConstructC() + ((versions :initarg :versions + :accessor versions + :inherit t + :associate (VersionInfoC versioned-construct)))) + + +(defpclass VersionedAssociationC(VersionedConstructC) + ()) + + +(defpclass PointerAssociationC (VersionedAssociationC) + ((identifier :initarg :identifier + :accessor identifier + :inherit t + :initform (error "From PointerAssociationC(): identifier must be set") + :associate PointerC))) + + +(defpclass ItemIdAssociationC(PointerAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From ItemIdAssociationC(): parent-construct must be set") + :associate ReifiableConstructC))) + + +(defpclass TopicMapConstructC() + ()) + + +(defpclass ReifiableConstructC(TopicMapConstructC) + ((item-identifiers :associate (ItemIdAssociationC parent-construct) + :inherit t))) + + +(defpclass PointerC(TopicMapConstructC) + ((uri :initarg :uri + :accessor uri + :inherit t + :type string + :initform (error "From PointerC(): uri must be set for a pointer") + :index t) + (identified-construct :associate (PointerAssociationC identifier) + :inherit t))) + + +(defpclass IdentifierC(PointerC) + ()) + + +(defpclass ItemIdentifierC(IdentifierC) + () + (:index t)) + + +(open-store '(:BDB "data_base")) +(defvar *p* (make-instance 'PointerC + :uri "anyUri")) +(defvar *pa* (make-instance 'PointerAssociationC + :identifier *p*)) + +(defvar *ii* (make-instance 'ItemIdentifierC + :uri "anyUri")) + +(defvar *pa-ii* (make-instance 'PointerAssociationC + :identifier *ii*)) + +(defvar *ii-2* (make-instance 'ItemIdentifierC + :uri "anyUri")) + +(defvar *rc* (make-instance 'ReifiableConstructC)) + + +(defvar *ia* (make-instance 'ItemIdAssociationC + :identifier *ii-2* + :parent-construct *rc*)) + + +(when (not (slot-value *p* 'identified-construct)) + (error ">> 1")) + +(when (not (slot-value *pa* 'identifier)) + (error ">> 2")) + +(when (not (slot-value *ii* 'identified-construct)) + (error ">> 3")) + +(when (not (slot-value *pa-ii* 'identifier)) + (error ">> 4")) + +(when (not (slot-value *ii-2* 'identified-construct)) + (error ">> 5")) + +(when (not (slot-value *rc* 'item-identifiers)) + (error ">> 6")) + +(when (not (slot-value *ia* 'parent-construct)) + (error ">> 7")) + +(when (not (slot-value *ia* 'identifier)) + (error ">> 8")) \ No newline at end of file Added: branches/new-datamodel/playground/system_crash.lisp ============================================================================== --- (empty file) +++ branches/new-datamodel/playground/system_crash.lisp Sun Feb 21 15:34:01 2010 @@ -0,0 +1,3 @@ +(sb-mop:class-slots (find-class 'd:ItemIdentifierC)) +(sb-mop:class-finalized-p (find-class 'd:ItemIdentifierC)) +(sb-mop:finalize-inheritance (find-class 'd:ItemIdentifierC)) Added: branches/new-datamodel/playground/versioned-pointer.lisp ============================================================================== --- (empty file) +++ branches/new-datamodel/playground/versioned-pointer.lisp Sun Feb 21 15:34:01 2010 @@ -0,0 +1,28 @@ +(asdf:operate 'asdf:load-op 'elephant) +(elephant:open-store '(:BDB "data_base")) +(defpclass Relation() + ((to-a :associate NodeA + :accessor to-a + :initarg :to-a) + (to-b :associate NodeB + :accessor to-b + :initarg :to-b) + (version :initarg :version + :accessor version + :type integer + :index t)) + (:index t)) +(defpclass NodeA() + ((relation-to-b :associate (Relation to-a) + :accessor relation-to-b + :initarg :relation-to-b)) + (:index t)) +(defpclass NodeB() + ((relation-to-a :associate (Relation to-b) + :accessor relation-to-a + :initarg :relation-to-a)) + (:index t)) +(defvar *rel* (make-instance 'Relation + :to-a (make-instance 'NodeA) + :to-b (make-instance 'NodeB) + :version 1)) Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Feb 21 15:34:01 2010 @@ -190,7 +190,7 @@ (defpclass PointerC(TopicMapConstructC) ((uri :initarg :uri :accessor uri - :inherit t + ;:inherit t :type string :initform (error "From PointerC(): uri must be set for a pointer") :index t @@ -308,7 +308,7 @@ (charvalue :initarg :charvalue :accessor charvalue :type string - :inherit t + ;:inherit t :initform "" :index t :documentation "Contains the actual data of this object.")) @@ -426,7 +426,7 @@ (defpclass PointerAssociationC (VersionedAssociationC) ((identifier :initarg :identifier :accessor identifier - :inherit t + ;:inherit t :initform (error "From PointerAssociationC(): identifier must be set") :associate PointerC :documentation "The actual data that is associated with @@ -469,7 +469,7 @@ (defpclass CharacteristicAssociationC(VersionedAssociationC) ((characteristic :initarg :characteristic :accessor characteristic - :inherit t + ;:inherit t :initform (error "From CharacteristicCAssociation(): characteristic must be set") :associate CharactersiticC :documentation "Associates this object with the actual