[isidorus-cvs] r224 - branches/new-datamodel/playground

[Lukas Giessmann]

Author: lgiessmann
Date: Sat Mar 13 16:09:24 2010
New Revision: 224

Log:
new-datamodel: added a new sample file for call-next-mehtod in a multiple-inheritance scenario

Added:
   branches/new-datamodel/playground/call-next-method_multiple-inheritance.lisp

Added: branches/new-datamodel/playground/call-next-method_multiple-inheritance.lisp
==============================================================================
--- (empty file)
+++ branches/new-datamodel/playground/call-next-method_multiple-inheritance.lisp	Sat Mar 13 16:09:24 2010
@@ -0,0 +1,31 @@
+(defclass CharacteristicC()
+	   ((value :accessor value
+		   :initarg :value
+		   :type string)))
+
+(defclass DatatypableC()
+	   ((datatype :accessor datatype
+		      :initarg :datatype
+		      :type string)))
+
+(defclass OccurrenceC (CharacteristicC DatatypableC)
+	   ())
+
+(defgeneric equivalent-construct (construct &rest args))
+
+(defmethod equivalent-construct ((construct OccurrenceC) &rest args)
+	   (format t "equivalent-construct --> OccurrenceC: ~a~%" args)
+	   (call-next-method construct args))
+
+(defmethod equivalent-construct ((construct CharacteristicC) &rest args)
+	   (format t "equivalent-construct --> CharacteristicC: ~a~%" args)
+	   (call-next-method construct (first args))
+	   (string= (value construct) (getf (first args) :value)))
+
+(defmethod equivalent-construct ((construct DatatypableC) &rest args)
+	   (format t "equivalent-construct --> DatatypableC: ~a~%" args)
+	   (string= (datatype construct) (getf (first args) :datatype)))
+
+(defvar *occ* (make-instance 'Occurrencec :value "value" :datatype "datatype"))
+
+(equivalent-construct *occ* :value "value" :datatype "datatype")