diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3bdc661f18..a1b6c12a18 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,9 @@ +19990709-19:00 Eddie Runia + + 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 + source/compiler/harbour.l added support for ppo #line token diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c index 8a02971445..267f0bb864 100644 --- a/harbour/source/rtl/classes.c +++ b/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 ) } +/* + * = hb__wClsDatas( ) + * + * 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 ) ); + } +} + /* * = hb__wDataDec( ) * diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 6aca5433be..21cbfec110 100644 --- a/harbour/source/rtl/tclass.prg +++ b/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 ) diff --git a/harbour/tests/working/clsdata.prg b/harbour/tests/working/clsdata.prg new file mode 100644 index 0000000000..f5ddeacb3c --- /dev/null +++ b/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