[isidorus-cvs] r199 - in branches/new-datamodel: playground src/model

[Lukas Giessmann]

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