diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 6b5236d9c6..82d6f70e9a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,28 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + * harbour/source/vm/classes.c + + added hb_clsRealMethodName() function which I'm using in some + test code + + * harbour/tests/clsscast.prg + * updated to use __CLS_CNTSHRDATA() instead of __CLS_CNTCLSDATA() + + * harbour/utils/hbtest/rt_class.prg + + added tests for class and shared class variables/allocating + +2006-09-17 18:52 UTC+0100 Viktor Szakats (viktor.szakats syenar.hu) + * harbour/tests/testrpt.prg + ! Fixed fatal typo. + +2006-09-17 18:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * xharbour/include/hbvm.h + * xharbour/source/vm/hvm.c + + added hb_vmPushDynSym( PHB_DYNS ) + It should allow most applications to not use [P]HB_SYMB at all. + Removing PHB_SYMB from 3-rd party .c code may allow us to add + freeing unused symbol tables from HVM in the future. + * harbour/source/vm/classes.c * temporary restored hb_objGetpMethod() + added __ClsCntClasses() diff --git a/harbour/common.mak b/harbour/common.mak index d3509b1a30..521c3e6555 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -784,6 +784,7 @@ HBTEST_EXE_OBJS = \ $(OBJ_DIR)\rt_array.obj \ $(OBJ_DIR)\rt_file.obj \ $(OBJ_DIR)\rt_misc.obj \ + $(OBJ_DIR)\rt_class.obj \ #********************************************************** diff --git a/harbour/include/hbvm.h b/harbour/include/hbvm.h index a3b5e95744..e4dcd3b598 100644 --- a/harbour/include/hbvm.h +++ b/harbour/include/hbvm.h @@ -138,6 +138,7 @@ extern HB_EXPORT void hb_vmPushString( char * szText, ULONG length ); /* pu extern HB_EXPORT void hb_vmPushStringPcode( char * szText, ULONG length ); /* pushes a string from pcode on to the stack */ extern HB_EXPORT void hb_vmPushDate( long lDate ); /* pushes a long date onto the stack */ extern HB_EXPORT void hb_vmPushSymbol( PHB_SYMB pSym ); /* pushes a function pointer onto the stack */ +extern HB_EXPORT void hb_vmPushDynSym( PHB_DYNS pDynSym ); /* pushes a function/method pointer onto the stack */ extern HB_EXPORT void hb_vmPushPointer( void * ); /* push an item of HB_IT_POINTER type */ extern HB_EXPORT void hb_vmPushState( void ); /* push current VM state on stack */ extern HB_EXPORT void hb_vmPopState( void ); /* pop current VM state from stack */ diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 50189378e6..88216e7a79 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -167,8 +167,8 @@ typedef struct PHB_SYMB pFuncSym; /* Function symbol */ USHORT uiSprClass; /* Originalclass'handel (super or current class'handel if not herited). */ /*Added by RAC&JF*/ USHORT uiScope; /* Scoping value */ - USHORT uiData; /* Item position for instance data or shared data (Harbour like, begin from 1) or supercast offset (from 0) */ - USHORT uiOffset; /* position in pInitData for class datas (from 1) or offset to instance area in inherited instance data (from 0) */ + USHORT uiData; /* Item position for instance data, class or shared data (Harbour like, begin from 1) */ + USHORT uiOffset; /* position in pInitData for class datas (from 1) or offset to instance area in inherited instance data and supercast messages (from 0) */ #ifndef HB_NO_PROFILER ULONG ulCalls; /* profiler support */ ULONG ulTime; /* profiler support */ @@ -185,9 +185,9 @@ typedef struct PHB_ITEM pClassDatas; /* Harbour Array for Class Datas */ PHB_ITEM pSharedDatas; /* Harbour Array for Class Shared Datas */ PHB_ITEM pInlines; /* Array for inline codeblocks */ - PHB_SYMB pFunError; /* error handler for not defined messages */ - PHB_SYMB pDestructor; /* destructor for not this class objects */ ULONG ulOpFlags; /* Flags for overloaded operators */ + BOOL fHasDestructor; /* has the class destructor message? */ + BOOL fHasOnError; /* has the class OnError message? */ USHORT uiMethods; /* Total Method initialised Counter */ USHORT uiInitDatas; /* Total Method initialised Counter */ USHORT uiDatas; /* Total Data Counter */ @@ -269,6 +269,7 @@ static HB_SYMB s_opSymbols[ HB_OO_MAX_OPERATOR + 1 ] = { }; static HB_SYMB s___msgDestructor = { "__msgDestructor", {HB_FS_MESSAGE}, {NULL}, NULL }; +static HB_SYMB s___msgOnError = { "__msgOnError", {HB_FS_MESSAGE}, {NULL}, NULL }; static HB_SYMB s___msgSetData = { "__msgSetData", {HB_FS_MESSAGE}, {hb___msgSetData}, NULL }; static HB_SYMB s___msgGetData = { "__msgGetData", {HB_FS_MESSAGE}, {hb___msgGetData}, NULL }; @@ -420,8 +421,8 @@ static void hb_clsCopyClass( PCLASS pClsDst, PCLASS pClsSrc ) HB_TRACE(HB_TR_DEBUG, ("hb_clsCopyClass(%p,%p)", pClsDst, pClsSrc)); hb_clsDictInit( pClsDst, pClsSrc->uiHashKey ); - pClsDst->pFunError = pClsSrc->pFunError; - pClsDst->pDestructor = pClsSrc->pDestructor; + pClsDst->fHasOnError = pClsSrc->fHasOnError; + pClsDst->fHasDestructor = pClsSrc->fHasDestructor; /* CLASS DATA Not Shared ( new array, new value ) */ pClsDst->pClassDatas = hb_arrayClone( pClsSrc->pClassDatas ); @@ -613,6 +614,7 @@ void hb_clsInit( void ) } s___msgDestructor.pDynSym = hb_dynsymGetCase( s___msgDestructor.szName ); + s___msgOnError.pDynSym = hb_dynsymGetCase( s___msgOnError.szName ); s___msgClassName.pDynSym = hb_dynsymGetCase( s___msgClassName.szName ); /* Standard messages */ s___msgClassH.pDynSym = hb_dynsymGetCase( s___msgClassH.szName ); /* Not present in classdef. */ @@ -1053,10 +1055,6 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, } return pMethod->pFuncSym; } - else if( pMsg == s___msgDestructor.pDynSym && pClass->pDestructor ) - { - return pClass->pDestructor; - } } } else if( HB_IS_BLOCK( pObject ) ) @@ -1176,8 +1174,15 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, */ if( pStack ) { - if( pClass && pClass->pFunError ) - return pClass->pFunError; + if( pClass && pClass->fHasOnError ) + { + PMETHOD pMethod = hb_clsFindMsg( pClass, s___msgOnError.pDynSym ); + if( pMethod ) + { + pStack->uiMethod = pMethod - pClass->pMethods; + return pMethod->pFuncSym; + } + } /* remove this line if you want default HVM error message */ return &s___msgNoMethod; @@ -1191,7 +1196,7 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL hb_clsHasDestructor( USHORT uiClass ) { if( uiClass && uiClass <= s_uiClasses ) - return ( s_pClasses + ( uiClass - 1 ) )->pDestructor != NULL; + return ( s_pClasses + ( uiClass - 1 ) )->fHasDestructor; else return FALSE; } @@ -1206,7 +1211,7 @@ void hb_objDestructorCall( PHB_ITEM pObject ) { PCLASS pClass = s_pClasses + pObject->item.asArray.value->uiClass - 1; - if( pClass->pDestructor ) + if( pClass->fHasDestructor ) { USHORT uiAction; @@ -1489,7 +1494,11 @@ HB_FUNC( __CLSADDMSG ) uiScope |= HB_OO_CLSTP_PERSIST; /* translate names of operator overloading messages */ - if (strcmp("+", szMessage) == 0) + if( nType == HB_OO_MSG_DESTRUCTOR ) + pMessage = s___msgDestructor.pDynSym; + else if( nType == HB_OO_MSG_ONERROR ) + pMessage = s___msgOnError.pDynSym; + else if (strcmp("+", szMessage) == 0) pMessage = ( s_opSymbols + HB_OO_OP_PLUS )->pDynSym; else if (strcmp("-", szMessage) == 0) pMessage = ( s_opSymbols + HB_OO_OP_MINUS )->pDynSym; @@ -1762,12 +1771,14 @@ HB_FUNC( __CLSADDMSG ) case HB_OO_MSG_ONERROR: - pClass->pFunError = pFuncSym; + pNewMeth->pFuncSym = pFuncSym; + pClass->fHasOnError = TRUE; break; case HB_OO_MSG_DESTRUCTOR: - pClass->pDestructor = pFuncSym; + pNewMeth->pFuncSym = pFuncSym; + pClass->fHasDestructor = TRUE; break; default: @@ -2338,6 +2349,16 @@ HB_FUNC( __CLSINSTSUPER ) hb_retni( uiClassH ); } +/* + * = __ClsCntClasses() + * + * Return number of classes + */ +HB_FUNC( __CLSCNTCLASSES ) +{ + hb_retni( ( int ) s_uiClasses ); +} + /* * = __cls_CntClsData( ) * @@ -2351,7 +2372,6 @@ HB_FUNC( __CLS_CNTCLSDATA ) hb_arrayLen( s_pClasses[ uiClass - 1 ].pClassDatas ) : 0 ); } - /* * = __cls_CntShrData( ) * @@ -2365,7 +2385,6 @@ HB_FUNC( __CLS_CNTSHRDATA ) hb_arrayLen( s_pClasses[ uiClass - 1 ].pSharedDatas ) : 0 ); } - /* * = __cls_CntData( ) * @@ -2379,7 +2398,6 @@ HB_FUNC( __CLS_CNTDATA ) s_pClasses[ uiClass - 1 ].uiDatas : 0 ); } - /* * = __cls_DecData( ) * @@ -2395,7 +2413,6 @@ HB_FUNC( __CLS_DECDATA ) hb_retni( 0 ); } - /* * = __cls_IncData( ) * Increase number of datas and return new value @@ -3176,3 +3193,16 @@ void hb_clsAssociate( USHORT usClassH ) hb_vmPushLong( usClassH ); hb_vmFunction( 1 ); } + +/* + * This function is only for backward binary compatibility + * It will be removed in the future so please do not use it. + * Use hb_objHasMessage() instead. + */ +#if defined(__cplusplus) + extern "C" BOOL hb_objGetpMethod( PHB_ITEM pObject, PHB_SYMB pMessage ); +#endif +BOOL hb_objGetpMethod( PHB_ITEM pObject, PHB_SYMB pMessage ) +{ + return hb_objHasMessage( pObject, pMessage->pDynSym ); +} diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index bb7b5ef221..9c50551deb 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -4671,6 +4671,17 @@ HB_EXPORT void hb_vmPushSymbol( PHB_SYMB pSym ) pItem->item.asSymbol.stackstate = NULL; } +HB_EXPORT void hb_vmPushDynSym( PHB_DYNS pDynSym ) +{ + PHB_ITEM pItem = hb_stackAllocItem(); + + HB_TRACE(HB_TR_DEBUG, ("hb_vmPushDynSym(%p)", pDynSym)); + + pItem->type = HB_IT_SYMBOL; + pItem->item.asSymbol.value = pDynSym->pSymbol; + pItem->item.asSymbol.stackstate = NULL; +} + /* -3 -> HB_P_PUSHBLOCK * -2 -1 -> size of codeblock * 0 +1 -> number of expected parameters diff --git a/harbour/utils/hbtest/Makefile b/harbour/utils/hbtest/Makefile index ec38256f47..e8b43854ab 100644 --- a/harbour/utils/hbtest/Makefile +++ b/harbour/utils/hbtest/Makefile @@ -20,6 +20,7 @@ PRG_SOURCES=\ rt_str.prg \ rt_stra.prg \ rt_trans.prg \ + rt_class.prg \ PRG_MAIN=hbtest.prg diff --git a/harbour/utils/hbtest/hbtest.prg b/harbour/utils/hbtest/hbtest.prg index e7bd415364..ee3df13cad 100644 --- a/harbour/utils/hbtest/hbtest.prg +++ b/harbour/utils/hbtest/hbtest.prg @@ -151,6 +151,7 @@ FUNCTION Main( cPar1, cPar2 ) Main_MISC() #ifdef __HARBOUR__ Main_OPOVERL() + Main_CLASS() #endif Main_LAST() diff --git a/harbour/utils/hbtest/rt_class.prg b/harbour/utils/hbtest/rt_class.prg new file mode 100644 index 0000000000..ea0f7a2cd0 --- /dev/null +++ b/harbour/utils/hbtest/rt_class.prg @@ -0,0 +1,513 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Regression tests for the runtime library (strings) + * + * Copyright 2006 Przemyslaw Czerpak + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "rt_main.ch" + +/* Don't change the position of this #include. */ +#include "rt_vars.ch" + + +#include "hbclass.ch" + +MEMVAR objHolder, cDtorResult + +FUNCTION Main_CLASS() + LOCAL oValue, aRef + PRIVATE objHolder, cDtorResult + +#ifdef __HARBOUR__ + + /* Test destructors */ + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(0) + TEST_LINE( oValue:type , 0 ) + TEST_LINE( oValue := NIL , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "No references to self." ) + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(1) + TEST_LINE( oValue:type , 1 ) + TEST_LINE( oValue := NIL , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "Reference to self in instance variable." ) + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(2) + TEST_LINE( oValue:type , 2 ) + TEST_LINE( oValue := NIL , "E BASE 1301 Object Destructor Failure Reference to freed block " ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "Reference to self in class variable." ) + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(3) + TEST_LINE( oValue:type , 3 ) + TEST_LINE( oValue := NIL , "E BASE 1301 Object Destructor Failure Reference to freed block " ) + TEST_LINE( valtype(objHolder) , "A" ) + TEST_LINE( len(objHolder) , 0 ) + TEST_LINE( cDtorResult , "Reference to self in private memvar." ) + + + /* Tests with cross references and releasing by Garbage Collector */ + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(0) + TEST_LINE( oValue:type , 0 ) + /* create cross reference */ + aRef := { oValue, nil }; aRef[2] := aRef; aRef := NIL + TEST_LINE( oValue := NIL , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "" ) + TEST_LINE( hb_gcAll() , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "No references to self." ) + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(1) + TEST_LINE( oValue:type , 1 ) + /* create cross reference */ + aRef := { oValue, nil }; aRef[2] := aRef; aRef := NIL + TEST_LINE( oValue := NIL , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "" ) + TEST_LINE( hb_gcAll() , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "Reference to self in instance variable." ) + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(2) + TEST_LINE( oValue:type , 2 ) + /* create cross reference */ + aRef := { oValue, nil }; aRef[2] := aRef; aRef := NIL + TEST_LINE( oValue := NIL , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "" ) + TEST_LINE( hb_gcAll() , "E BASE 1301 Object Destructor Failure Reference to freed block " ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "Reference to self in class variable." ) + + TEST_LINE( cDtorResult := "" , "" ) + TEST_LINE( objHolder := NIL , NIL ) + oValue := DTORCLASS():NEW(3) + TEST_LINE( oValue:type , 3 ) + /* create cross reference */ + aRef := { oValue, nil }; aRef[2] := aRef; aRef := NIL + TEST_LINE( oValue := NIL , NIL ) + TEST_LINE( objHolder , NIL ) + TEST_LINE( cDtorResult , "" ) + TEST_LINE( hb_gcAll() , "E BASE 1301 Object Destructor Failure Reference to freed block " ) + TEST_LINE( valtype(objHolder) , "A" ) + TEST_LINE( len(objHolder) , 0 ) + TEST_LINE( cDtorResult , "Reference to self in private memvar." ) + + + + /* Test instance area allocating and casting */ + + oValue := IVARSCLASS4():new() + + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: (x1) (y1) (z1) (x2) (y2) (z2) (x3) (y3) (z3) (x4) (y4) (z4)" ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* simple assignment... */ + TEST_LINE( oValue:x1 := " X1 " , " X1 " ) + TEST_LINE( oValue:y1 := " Y1 " , " Y1 " ) + TEST_LINE( oValue:z1 := " Z1 " , " Z1 " ) + TEST_LINE( oValue:x2 := " X2 " , " X2 " ) + TEST_LINE( oValue:y2 := " Y2 " , " Y2 " ) + TEST_LINE( oValue:z2 := " Z2 " , " Z2 " ) + TEST_LINE( oValue:x3 := " X3 " , " X3 " ) + TEST_LINE( oValue:y3 := " Y3 " , " Y3 " ) + TEST_LINE( oValue:z3 := " Z3 " , " Z3 " ) + TEST_LINE( oValue:x4 := " X4 " , " X4 " ) + TEST_LINE( oValue:y4 := " Y4 " , " Y4 " ) + TEST_LINE( oValue:z4 := " Z4 " , " Z4 " ) + + TEST_LINE( oValue:x1 , " X1 " ) + TEST_LINE( oValue:y1 , " Y1 " ) + TEST_LINE( oValue:z1 , " Z1 " ) + TEST_LINE( oValue:x2 , " X2 " ) + TEST_LINE( oValue:y2 , " Y2 " ) + TEST_LINE( oValue:z2 , " Z2 " ) + TEST_LINE( oValue:x3 , " X3 " ) + TEST_LINE( oValue:y3 , " Y3 " ) + TEST_LINE( oValue:z3 , " Z3 " ) + TEST_LINE( oValue:x4 , " X4 " ) + TEST_LINE( oValue:y4 , " Y4 " ) + TEST_LINE( oValue:z4 , " Z4 " ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: X1 Y1 Z1 X2 Y2 Z2 X3 Y3 Z3 X4 Y4 Z4 " ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting IVARSCLASS1 instance variables... */ + TEST_LINE( oValue:IVARSCLASS1:x1 := "[X1]" , "[X1]" ) + TEST_LINE( oValue:IVARSCLASS1:y1 := "[Y1]" , "[Y1]" ) + TEST_LINE( oValue:IVARSCLASS1:z1 := "[Z1]" , "[Z1]" ) + + TEST_LINE( oValue:x1 , "[X1]" ) + TEST_LINE( oValue:y1 , "[Y1]" ) + TEST_LINE( oValue:z1 , "[Z1]" ) + TEST_LINE( oValue:x2 , " X2 " ) + TEST_LINE( oValue:y2 , " Y2 " ) + TEST_LINE( oValue:z2 , " Z2 " ) + TEST_LINE( oValue:x3 , " X3 " ) + TEST_LINE( oValue:y3 , " Y3 " ) + TEST_LINE( oValue:z3 , " Z3 " ) + TEST_LINE( oValue:x4 , " X4 " ) + TEST_LINE( oValue:y4 , " Y4 " ) + TEST_LINE( oValue:z4 , " Z4 " ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: [X1] [Y1] [Z1] X2 Y2 Z2 X3 Y3 Z3 X4 Y4 Z4 " ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting IVARSCLASS2 instance variables... */ + TEST_LINE( oValue:IVARSCLASS2:x2 := "[X2]" , "[X2]" ) + TEST_LINE( oValue:IVARSCLASS2:y2 := "[Y2]" , "[Y2]" ) + TEST_LINE( oValue:IVARSCLASS2:z2 := "[Z2]" , "[Z2]" ) + + TEST_LINE( oValue:x1 , "[X1]" ) + TEST_LINE( oValue:y1 , "[Y1]" ) + TEST_LINE( oValue:z1 , "[Z1]" ) + TEST_LINE( oValue:x2 , "[X2]" ) + TEST_LINE( oValue:y2 , "[Y2]" ) + TEST_LINE( oValue:z2 , "[Z2]" ) + TEST_LINE( oValue:x3 , " X3 " ) + TEST_LINE( oValue:y3 , " Y3 " ) + TEST_LINE( oValue:z3 , " Z3 " ) + TEST_LINE( oValue:x4 , " X4 " ) + TEST_LINE( oValue:y4 , " Y4 " ) + TEST_LINE( oValue:z4 , " Z4 " ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: [X1] [Y1] [Z1] [X2] [Y2] [Z2] X3 Y3 Z3 X4 Y4 Z4 " ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting IVARSCLASS3 instance variables... */ + TEST_LINE( oValue:IVARSCLASS3:x3 := "[X3]" , "[X3]" ) + TEST_LINE( oValue:IVARSCLASS3:y3 := "[Y3]" , "[Y3]" ) + TEST_LINE( oValue:IVARSCLASS3:z3 := "[Z3]" , "[Z3]" ) + + TEST_LINE( oValue:x1 , "[X1]" ) + TEST_LINE( oValue:y1 , "[Y1]" ) + TEST_LINE( oValue:z1 , "[Z1]" ) + TEST_LINE( oValue:x2 , "[X2]" ) + TEST_LINE( oValue:y2 , "[Y2]" ) + TEST_LINE( oValue:z2 , "[Z2]" ) + TEST_LINE( oValue:x3 , "[X3]" ) + TEST_LINE( oValue:y3 , "[Y3]" ) + TEST_LINE( oValue:z3 , "[Z3]" ) + TEST_LINE( oValue:x4 , " X4 " ) + TEST_LINE( oValue:y4 , " Y4 " ) + TEST_LINE( oValue:z4 , " Z4 " ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: [X1] [Y1] [Z1] [X2] [Y2] [Z2] [X3] [Y3] [Z3] X4 Y4 Z4 " ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting IVARSCLASS4 instance variables... */ + TEST_LINE( oValue:IVARSCLASS4:x4 := "[X4]" , "[X4]" ) + TEST_LINE( oValue:IVARSCLASS4:y4 := "[Y4]" , "[Y4]" ) + TEST_LINE( oValue:IVARSCLASS4:z4 := "[Z4]" , "[Z4]" ) + + TEST_LINE( oValue:x1 , "[X1]" ) + TEST_LINE( oValue:y1 , "[Y1]" ) + TEST_LINE( oValue:z1 , "[Z1]" ) + TEST_LINE( oValue:x2 , "[X2]" ) + TEST_LINE( oValue:y2 , "[Y2]" ) + TEST_LINE( oValue:z2 , "[Z2]" ) + TEST_LINE( oValue:x3 , "[X3]" ) + TEST_LINE( oValue:y3 , "[Y3]" ) + TEST_LINE( oValue:z3 , "[Z3]" ) + TEST_LINE( oValue:x4 , "[X4]" ) + TEST_LINE( oValue:y4 , "[Y4]" ) + TEST_LINE( oValue:z4 , "[Z4]" ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: [X1] [Y1] [Z1] [X2] [Y2] [Z2] [X3] [Y3] [Z3] [X4] [Y4] [Z4]" ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting IVARSCLASS3:IVARSCLASS1 instance variables... */ + TEST_LINE( oValue:IVARSCLASS3:IVARSCLASS1:x1 := "" , "" ) + TEST_LINE( oValue:IVARSCLASS3:IVARSCLASS1:y1 := "" , "" ) + TEST_LINE( oValue:IVARSCLASS3:IVARSCLASS1:z1 := "" , "" ) + + TEST_LINE( oValue:x1 , "" ) + TEST_LINE( oValue:y1 , "" ) + TEST_LINE( oValue:z1 , "" ) + TEST_LINE( oValue:x2 , "[X2]" ) + TEST_LINE( oValue:y2 , "[Y2]" ) + TEST_LINE( oValue:z2 , "[Z2]" ) + TEST_LINE( oValue:x3 , "[X3]" ) + TEST_LINE( oValue:y3 , "[Y3]" ) + TEST_LINE( oValue:z3 , "[Z3]" ) + TEST_LINE( oValue:x4 , "[X4]" ) + TEST_LINE( oValue:y4 , "[Y4]" ) + TEST_LINE( oValue:z4 , "[Z4]" ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: [X2] [Y2] [Z2] [X3] [Y3] [Z3] [X4] [Y4] [Z4]" ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting IVARSCLASS3:IVARSCLASS2 instance variables... */ + TEST_LINE( oValue:IVARSCLASS3:IVARSCLASS2:x2 := "" , "" ) + TEST_LINE( oValue:IVARSCLASS3:IVARSCLASS2:y2 := "" , "" ) + TEST_LINE( oValue:IVARSCLASS3:IVARSCLASS2:z2 := "" , "" ) + + TEST_LINE( oValue:x1 , "" ) + TEST_LINE( oValue:y1 , "" ) + TEST_LINE( oValue:z1 , "" ) + TEST_LINE( oValue:x2 , "" ) + TEST_LINE( oValue:y2 , "" ) + TEST_LINE( oValue:z2 , "" ) + TEST_LINE( oValue:x3 , "[X3]" ) + TEST_LINE( oValue:y3 , "[Y3]" ) + TEST_LINE( oValue:z3 , "[Z3]" ) + TEST_LINE( oValue:x4 , "[X4]" ) + TEST_LINE( oValue:y4 , "[Y4]" ) + TEST_LINE( oValue:z4 , "[Z4]" ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: [X3] [Y3] [Z3] [X4] [Y4] [Z4]" ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + + /* Setting SUPER instance variables... */ + TEST_LINE( oValue:super:x1 := "{X1}" , "{X1}" ) + TEST_LINE( oValue:super:y1 := "{Y1}" , "{Y1}" ) + TEST_LINE( oValue:super:z1 := "{Z1}" , "{Z1}" ) + TEST_LINE( oValue:super:x2 := "{X2}" , "{X2}" ) + TEST_LINE( oValue:super:y2 := "{Y2}" , "{Y2}" ) + TEST_LINE( oValue:super:z2 := "{Z2}" , "{Z2}" ) + TEST_LINE( oValue:super:x3 := "{X3}" , "{X3}" ) + TEST_LINE( oValue:super:y3 := "{Y3}" , "{Y3}" ) + TEST_LINE( oValue:super:z3 := "{Z3}" , "{Z3}" ) + + TEST_LINE( oValue:x1 , "{X1}" ) + TEST_LINE( oValue:y1 , "{Y1}" ) + TEST_LINE( oValue:z1 , "{Z1}" ) + TEST_LINE( oValue:x2 , "{X2}" ) + TEST_LINE( oValue:y2 , "{Y2}" ) + TEST_LINE( oValue:z2 , "{Z2}" ) + TEST_LINE( oValue:x3 , "{X3}" ) + TEST_LINE( oValue:y3 , "{Y3}" ) + TEST_LINE( oValue:z3 , "{Z3}" ) + TEST_LINE( oValue:x4 , "[X4]" ) + TEST_LINE( oValue:y4 , "[Y4]" ) + TEST_LINE( oValue:z4 , "[Z4]" ) + TEST_LINE( INSTANCE_DATA( oValue ) , "[12]: {X1} {Y1} {Z1} {X2} {Y2} {Z2} {X3} {Y3} {Z3} [X4] [Y4] [Z4]" ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTCLSDATA( oValue:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS1:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS2:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS3:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:IVARSCLASS4:classH ) , 0 ) + TEST_LINE( __CLS_CNTSHRDATA( oValue:classH ) , 0 ) + +#endif + + RETURN NIL + + +#ifdef __HARBOUR__ + +STATIC FUNCTION INSTANCE_DATA( oValue ) + LOCAL cData, i + + cData := "[" + LTRIM( STR( LEN( oValue ) ) ) + "]:" + FOR i := 1 TO LEN( oValue ) + IF VALTYPE( oValue[ i ] ) == "C" + cData += " " + oValue[ i ] + ELSEIF oValue[ i ] == NIL + cData += " NIL" + ELSE + cData += " ..." + ENDIF + NEXT + + RETURN cData + + + +CREATE CLASS DTORCLASS +EXPORTED: + VAR type + VAR var1 + CLASS VAR var2 + METHOD init + DESTRUCTOR dtor +END CLASS + +METHOD INIT( type ) CLASS DTORCLASS + ::type := type +RETURN self + +PROCEDURE DTOR CLASS DTORCLASS + IF ::type == 1 + cDtorResult += "Reference to self in instance variable." + ::var1 := self + ELSEIF ::Type == 2 + cDtorResult += "Reference to self in class variable." + ::var2 := self + ELSEIF ::Type == 3 + cDtorResult += "Reference to self in private memvar." + objHolder := self + ELSE + cDtorResult += "No references to self." + ENDIF + + RETURN + + + +CREATE CLASS IVARSCLASS1 +EXPORTED: + VAR x1 INIT "(x1)" + VAR y1 INIT "(y1)" + VAR z1 INIT "(z1)" +END CLASS + +CREATE CLASS IVARSCLASS2 FROM IVARSCLASS1 +EXPORTED: + VAR x2 INIT "(x2)" + VAR y2 INIT "(y2)" + VAR z2 INIT "(z2)" +END CLASS + +CREATE CLASS IVARSCLASS3 FROM IVARSCLASS1, IVARSCLASS2 +EXPORTED: + VAR x3 INIT "(x3)" + VAR y3 INIT "(y3)" + VAR z3 INIT "(z3)" +END CLASS + +CREATE CLASS IVARSCLASS4 FROM IVARSCLASS3, IVARSCLASS2 +EXPORTED: + VAR x4 INIT "(x4)" + VAR y4 INIT "(y4)" + VAR z4 INIT "(z4)" +END CLASS + +#endif + + +/* Don't change the position of this #include. */ +#include "rt_init.ch"