see changelog

harbour/ChangeLog

@@ -1,3 +1,9 @@
+19990709-19:00 Eddie Runia <eddie@runia.com>
+  + tests/working/clsdata.prg
+    Test program supplied by Bruno Cantero
+  * source/rtl/classes.c; source/rtl/tclass.prg
+    inheritance class data bug resolved.
+
 19990709-18:21 Antonio Linares <alinares@fivetech.com>
   + source/compiler/harbour.l
     added support for ppo #line token

harbour/source/rtl/classes.c

@@ -36,6 +36,7 @@
  *      OSEND
  *      SELECTSUPER
  *      __INSTSUPER
+ *      __WCLSDATAS
  *      __WDATAS
  *      __WDATADEC
  *      __WDATAINC
@@ -206,13 +207,18 @@ HARBOUR HB_CLASSADD(void)
 
       pNewMeth = pClass->pMethods + wAt;
       if( !pNewMeth->pMessage )
+      {
+         pNewMeth->pMessage = pMessage;
          pClass->wMethods++;                    /* One more message         */
-      pNewMeth->pMessage = pMessage;
+      }
+      else
+         printf("\nOld %i\n",(long) pNewMeth->pFunction);
 
       switch( wType )
       {
          case MET_METHOD:
               pNewMeth->pFunction = ( HARBOURFUNC ) hb_parnl( 3 );
+              printf("\nPointer=%i\n",hb_parnl( 3 ));
               break;
 
          case MET_DATA:
@@ -688,9 +694,10 @@ char * hb_GetClassName( PHB_ITEM pObject )
 static HARBOUR GetClassData( void )
 {
    WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
+   WORD wIndex = pMethod->wData;
 
    if( wClass && wClass <= wClasses )
-      hb_arrayGet( pClasses[ wClass - 1 ].pClassDatas, pMethod->wData,
+      hb_arrayGet( pClasses[ wClass - 1 ].pClassDatas, wIndex,
                    &stack.Return );
 }
 
@@ -1026,6 +1033,23 @@ HARBOUR HB___INSTSUPER( void )
 }
 
 
+/*
+ * <nSeq> = hb__wClsDatas( <hClass> )
+ *
+ * Return number of class datas
+ */
+HARBOUR HB___WCLSDATAS(void)
+{
+   WORD  wClass = hb_parnl( 1 );
+   PCLASS pClass;
+
+   if( wClass )
+   {
+      pClass = &pClasses[ wClass - 1 ];
+      hb_retni( hb_arrayLen( pClass->pClassDatas ) );
+   }
+}
+
 /*
  * <nSeq> = hb__wDataDec( <hClass> )
  *

harbour/source/rtl/tclass.prg

@@ -104,8 +104,9 @@ static function Create()
    local Self := QSelf()
    local n
    local nLen
-   local nLenDatas  := Len( ::aDatas )
-   local nDataBegin := 0
+   local nLenDatas   := Len( ::aDatas )
+   local nDataBegin  := 0
+   local nClassBegin := 0
    local hClass
    local hSuper
    local ahSuper := {}
@@ -121,6 +122,7 @@ static function Create()
       ClassAdd( hClass, "SUPER", hSuper, MET_SUPER )
 
       nDataBegin := __WDatas( hSuper )          // Get offset for new DATAs
+      nClassBegin := __WClsDatas( hSuper )      // Get offset for new ClassData
    endif
 
    ::hClass = hClass
@@ -138,8 +140,8 @@ static function Create()
 
    nLen = Len( ::aClsDatas )
    for n = 1 to nLen
-      ClassAdd( hClass, ::aClsDatas[ n ], n, MET_CLASSDATA )
-      ClassAdd( hClass, "_" + ::aClsDatas[ n ], n, MET_CLASSDATA )
+      ClassAdd( hClass, ::aClsDatas[ n ], n + nClassBegin, MET_CLASSDATA )
+      ClassAdd( hClass, "_" + ::aClsDatas[ n ], n + nClassBegin, MET_CLASSDATA )
    next
 
    nLen = Len( ::aInlines )

harbour/tests/working/clsdata.prg

@@ -0,0 +1,100 @@
+Function Main()
+
+   local o := TObject():New()
+   QOut( "o:Data1 => ", o:Data1 )
+   QOut( "o:ClassData1 => ", o:ClassData1 )
+   QOut( "o:Data2 => ", o:Data2 )
+   QOut( "o:ClassData2 => ", o:ClassData2 )
+   o:Test()
+
+return NIL
+
+Function TBaseObject()
+
+   static oClass
+
+   if oClass == NIL
+      oClass := TClass():New( "TBaseObject" )
+      oClass:AddData( "Data1" )
+      oClass:AddClassData( "ClassData1" )
+      oClass:AddMethod( "NewBase", @NewBase() )
+      oClass:AddMethod( "Test", @Test() )
+      oClass:AddMethod( "Method1", @Method1Base() )
+      oClass:AddMethod( "Method2", @Method2Base() )
+      oClass:Create()
+   endif
+return oClass:Instance()
+
+static function NewBase()
+
+   local self := QSelf()
+
+   ::Data1 := 1
+   ::ClassData1 := "A"
+return self
+
+static function Test()
+
+   local self := QSelf()
+
+   QOut( "Inside ::Test() " )
+   QOut( "calling ::Method1() " )
+   ::Method1()
+return self
+
+static function Method1Base()
+
+   local self := QSelf()
+
+   QOut( "I am Method1 from TBaseObject" )
+   ::Method2()
+return self
+
+static function Method2Base()
+
+   local self := QSelf()
+
+   QOut( "I am Method2 from TBaseObject" )
+return self
+
+Function TObject()
+
+   static oClass
+
+   if oClass == NIL
+      oClass := TClass():New( "TObject", "TBaseObject" )
+      oClass:AddData( "Data2" )
+      oClass:AddClassData( "ClassData2" )
+      oClass:AddMethod( "New", @New() )
+      oClass:AddMethod( "Method1", @Method1() )
+      oClass:AddMethod( "Method2", @Method2() )
+      oClass:Create()
+   endif
+return oClass:Instance()
+
+static function New()
+
+   local self := QSelf()
+
+   ::Super:NewBase()
+   ::Data1 := 1
+   ::ClassData1 := "A"
+   ::Data2 := 2
+// ClassData2 override ClassData1
+   ::ClassData2 := "B"
+return self
+
+static function Method1()
+
+   local self := QSelf()
+
+   QOut( "I am Method1 from TObject" )
+   ::Super:Method1()
+return self
+
+static function Method2()
+
+   local self := QSelf()
+
+   QOut( "I am Method2 from TObject" )
+return self