From 77d31074e8bfdc3c0d5127bb6aa5c29311189bbf Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Wed, 13 Sep 2006 01:12:18 +0000 Subject: [PATCH] 2006-09-13 03:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/vm/classes.c * keep class shared data in separate array + added __CLS_CNTSHRDATA( hClass ) -> nSharedDatas % some minor optimizations * harbour/tests/clsscast.prg + added test code for shared class data allocating and casting * harbour/include/hbapicls.h * harbour/source/vm/hvm.c * harbour/source/vm/itemapi.c + added support for FOR EACH overloading - it's work in progress do not create any code which may use current solution - it may change in the nearest future --- harbour/ChangeLog | 16 ++ harbour/include/hbapicls.h | 13 +- harbour/source/vm/classes.c | 139 ++++++++------ harbour/source/vm/hvm.c | 90 ++++++--- harbour/source/vm/itemapi.c | 23 +-- harbour/tests/clsscast.prg | 374 ++++++++++++++++++++++++++++++++++++ 6 files changed, 556 insertions(+), 99 deletions(-) create mode 100644 harbour/tests/clsscast.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 67b15a160c..00c6c3c2f5 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,22 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + is not supported now. This is sth what I'd like to discuss soon when + I'll add destructors. Please think now if we should allow to execute + destructors and other cleanup user code when we are returning to + nearest expection trap (BEGIN SEQUENCE / [ RECOVER /] END) cleaning + the HVM stack. + +2006-09-13 14:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/compiler/genc.c + * harbour/source/compiler/gencli.c + * harbour/source/compiler/harbour.c + ! fixed number of compiled functions shown in compilation status + ! added workaround for GPF in empty #pragma begindump/enddump + statement + +2006-09-13 03:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/vm/classes.c * keep class shared data in separate array + added __CLS_CNTSHRDATA( hClass ) -> nSharedDatas % some minor optimizations diff --git a/harbour/include/hbapicls.h b/harbour/include/hbapicls.h index 7166943044..079fa0e457 100644 --- a/harbour/include/hbapicls.h +++ b/harbour/include/hbapicls.h @@ -80,13 +80,14 @@ HB_EXTERN_BEGIN #define HB_OO_OP_AND 18 #define HB_OO_OP_OR 19 #define HB_OO_OP_ARRAYINDEX 20 -#define HB_OO_OP_ENUMNEXT 21 -#define HB_OO_OP_ENUMPREV 22 -#define HB_OO_OP_ENUMINDEX 23 -#define HB_OO_OP_ENUMBASE 24 -#define HB_OO_OP_ENUMVALUE 25 +#define HB_OO_OP_ENUMINDEX 21 +#define HB_OO_OP_ENUMBASE 22 +#define HB_OO_OP_ENUMVALUE 23 +#define HB_OO_OP_ENUMSTART 24 +#define HB_OO_OP_ENUMSKIP 25 +#define HB_OO_OP_ENUMSTOP 26 -#define HB_OO_MAX_OPERATOR 25 +#define HB_OO_MAX_OPERATOR 26 extern void hb_clsInit( void ); /* initialize Classy/OO system at HVM startup */ extern void hb_clsReleaseAll( void ); /* releases all defined classes */ diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 40c1c5c361..a750e18f2d 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -182,7 +182,8 @@ typedef struct PHB_DYNS pClassSym; /* Class symbolic name */ PMETHOD pMethods; /* Class methods */ PINITDATA pInitData; /* Class/instance Initialization data */ - PHB_ITEM pClassDatas; /* Harbour Array for ClassDatas and shared */ + 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 */ ULONG ulOpFlags; /* Flags for overloaded operators */ @@ -197,9 +198,9 @@ typedef struct #define BUCKETSIZE ( 1 << BUCKETBITS ) #define BUCKETMASK ( BUCKETSIZE - 1 ) #define HASHBITS 3 -#define HASH_KEY ( 1 << HASHBITS ) +#define HASH_KEY ( ( 1 << HASHBITS ) - 1 ) #define HASH_KEYMAX ( 1 << ( 16 - BUCKETBITS ) ) -#define hb_clsMthNum(p) ( ( ULONG ) (p)->uiHashKey << BUCKETBITS ) +#define hb_clsMthNum(p) ( ( ( ULONG ) (p)->uiHashKey + 1 ) << BUCKETBITS ) static HARBOUR hb___msgGetData( void ); static HARBOUR hb___msgSetData( void ); @@ -227,32 +228,33 @@ static HARBOUR hb___msgEval( void ); * to HB_OO_OP_* constants in hbapicls.h, [druzus] */ static HB_SYMB s_opSymbols[ HB_OO_MAX_OPERATOR + 1 ] = { - { "__OPPLUS", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 01 */ - { "__OPMINUS", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 02 */ - { "__OPMULT", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 03 */ - { "__OPDIVIDE", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 04 */ - { "__OPMOD", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 05 */ - { "__OPPOWER", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 06 */ - { "__OPINC", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 07 */ - { "__OPDEC", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 08 */ - { "__OPEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 09 */ - { "__OPEXACTEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 10 */ - { "__OPNOTEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 11 */ - { "__OPLESS", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 12 */ - { "__OPLESSEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 13 */ - { "__OPGREATER", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 14 */ - { "__OPGREATEREQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 15 */ - { "__OPADDIGN", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 16 */ - { "__OPINSTRING", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 17 */ - { "__OPNOT", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 18 */ - { "__OPAND", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 19 */ - { "__OPOR", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 20 */ - { "__OPARRAYINDEX", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 21 */ - { "__ENUMNEXT", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 22 */ - { "__ENUMPREV", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 23 */ - { "__ENUMINDEX", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 24 */ - { "__ENUMBASE", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 25 */ - { "__ENUMVALUE", {HB_FS_MESSAGE}, {NULL}, NULL } /* 26 */ + { "__OPPLUS", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 00 */ + { "__OPMINUS", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 01 */ + { "__OPMULT", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 02 */ + { "__OPDIVIDE", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 03 */ + { "__OPMOD", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 04 */ + { "__OPPOWER", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 05 */ + { "__OPINC", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 06 */ + { "__OPDEC", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 07 */ + { "__OPEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 08 */ + { "__OPEXACTEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 09 */ + { "__OPNOTEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 10 */ + { "__OPLESS", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 11 */ + { "__OPLESSEQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 12 */ + { "__OPGREATER", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 13 */ + { "__OPGREATEREQUAL", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 14 */ + { "__OPADDIGN", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 15 */ + { "__OPINSTRING", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 16 */ + { "__OPNOT", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 17 */ + { "__OPAND", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 18 */ + { "__OPOR", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 19 */ + { "__OPARRAYINDEX", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 20 */ + { "__ENUMINDEX", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 21 */ + { "__ENUMBASE", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 22 */ + { "__ENUMVALUE", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 23 */ + { "__ENUMSTART", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 24 */ + { "__ENUMSKIP", {HB_FS_MESSAGE}, {NULL}, NULL }, /* 25 */ + { "__ENUMSTOP", {HB_FS_MESSAGE}, {NULL}, NULL } /* 26 */ }; static HB_SYMB s___msgSetData = { "__msgSetData", {HB_FS_MESSAGE}, {hb___msgSetData}, NULL }; @@ -334,7 +336,7 @@ static BOOL hb_clsDictRealloc( PCLASS pClass ) HB_TRACE(HB_TR_DEBUG, ("hb_clsDictRealloc(%p)", pClass)); - ulNewHashKey = pClass->uiHashKey; + ulNewHashKey = ( ULONG ) pClass->uiHashKey + 1; ulLimit = ulNewHashKey << BUCKETBITS; do @@ -379,7 +381,7 @@ static BOOL hb_clsDictRealloc( PCLASS pClass ) } while( ul < ulLimit ); - pClass->uiHashKey = ( USHORT ) ulNewHashKey; + pClass->uiHashKey = ( USHORT ) ( ulNewHashKey - 1 ); hb_xfree( pClass->pMethods ); pClass->pMethods = pNewMethods; @@ -392,7 +394,7 @@ static void hb_clsDictInit( PCLASS pClass, USHORT uiHashKey ) HB_TRACE(HB_TR_DEBUG, ("hb_clsDictInit(%p,%hu)", pClass, uiHashKey)); - ulSize = ( ( ULONG ) uiHashKey << BUCKETBITS ) * sizeof( METHOD ); + ulSize = ( ( ( ULONG ) uiHashKey + 1 ) << BUCKETBITS ) * sizeof( METHOD ); pClass->uiHashKey = uiHashKey; pClass->pMethods = ( PMETHOD ) hb_xgrab( ulSize ); memset( pClass->pMethods, 0, ulSize ); @@ -405,7 +407,7 @@ static PMETHOD hb_clsFindMsg( PCLASS pClass, PHB_DYNS pMsg ) HB_TRACE(HB_TR_DEBUG, ("hb_clsFindMsg(%p,%p)", pClass, pMsg)); - pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey - 1 ); + pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey ); uiBucket = BUCKETSIZE; do @@ -431,6 +433,8 @@ static void hb_clsCopyClass( PCLASS pClsDst, PCLASS pClsSrc ) /* CLASS DATA Not Shared ( new array, new value ) */ pClsDst->pClassDatas = hb_arrayClone( pClsSrc->pClassDatas ); + /* do not copy shared data array - just simply create new one */ + pClsDst->pSharedDatas = hb_itemArrayNew( 0 ); pClsDst->pInlines = hb_arrayClone( pClsSrc->pInlines ); pClsDst->uiDatas = pClsSrc->uiDatas; pClsDst->ulOpFlags = pClsSrc->ulOpFlags; @@ -474,7 +478,7 @@ static PMETHOD hb_clsAllocMsg( PCLASS pClass, PHB_DYNS pMsg ) do { - PMETHOD pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey - 1 ); + PMETHOD pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey ); USHORT uiBucket = BUCKETSIZE; do @@ -507,7 +511,7 @@ static void hb_clsFreeMsg( PCLASS pClass, PHB_DYNS pMsg ) HB_TRACE(HB_TR_DEBUG, ("hb_clsFreeMsg(%p,%p)", pClass, pMsg)); - pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey - 1 ); + pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey ); uiBucket = BUCKETSIZE; do @@ -636,10 +640,16 @@ static void hb_clsRelease( PCLASS pClass ) hb_xfree( pClass->pInitData ); } - hb_xfree( pClass->szName ); - hb_xfree( pClass->pMethods ); - hb_itemRelease( pClass->pClassDatas ); - hb_itemRelease( pClass->pInlines ); + if( pClass->szName ) + hb_xfree( pClass->szName ); + if( pClass->pMethods ) + hb_xfree( pClass->pMethods ); + if( pClass->pClassDatas ) + hb_itemRelease( pClass->pClassDatas ); + if( pClass->pSharedDatas ) + hb_itemRelease( pClass->pSharedDatas ); + if( pClass->pInlines ) + hb_itemRelease( pClass->pInlines ); } @@ -688,16 +698,13 @@ void hb_clsIsClassRef( void ) while( uiClass-- ) { if( pClass->pInlines ) - { - if( HB_IS_GCITEM( pClass->pInlines ) ) - hb_gcItemRef( pClass->pInlines ); - } + hb_gcItemRef( pClass->pInlines ); if( pClass->pClassDatas ) - { - if( HB_IS_GCITEM( pClass->pClassDatas ) ) - hb_gcItemRef( pClass->pClassDatas ); - } + hb_gcItemRef( pClass->pClassDatas ); + + if( pClass->pSharedDatas ) + hb_gcItemRef( pClass->pSharedDatas ); if( pClass->uiInitDatas ) { @@ -1823,24 +1830,31 @@ HB_FUNC( __CLSADDMSG ) pNewMeth->uiScope = hb_clsUpdateScope( uiScope, TRUE ); pNewMeth->uiData = uiIndex; - if( hb_arrayLen( pClass->pClassDatas ) < ( ULONG ) pNewMeth->uiData ) - hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); if( pNewMeth->uiScope & HB_OO_CLSTP_SHARED ) + { + if( hb_arrayLen( pClass->pSharedDatas ) < ( ULONG ) pNewMeth->uiData ) + hb_arraySize( pClass->pSharedDatas, pNewMeth->uiData ); pNewMeth->pFuncSym = &s___msgSetShrData; + } else + { + if( hb_arrayLen( pClass->pClassDatas ) < ( ULONG ) pNewMeth->uiData ) + hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); pNewMeth->pFuncSym = &s___msgSetClsData; + } break; case HB_OO_MSG_CLSACCESS: pNewMeth->uiScope = hb_clsUpdateScope( uiScope, FALSE ); pNewMeth->uiData = uiIndex; - if( hb_arrayLen( pClass->pClassDatas ) < ( ULONG ) pNewMeth->uiData ) - hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); if( pNewMeth->uiScope & HB_OO_CLSTP_SHARED ) { PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); + if( hb_arrayLen( pClass->pSharedDatas ) < ( ULONG ) pNewMeth->uiData ) + hb_arraySize( pClass->pSharedDatas, pNewMeth->uiData ); + if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ { /* Shared Classdata need to be initialized only once @@ -1849,13 +1863,15 @@ HB_FUNC( __CLSADDMSG ) * to keep the init value. [druzus] */ pInit = hb_itemClone( pInit ); - hb_arraySet( pClass->pClassDatas, pNewMeth->uiData, pInit ); + hb_arraySet( pClass->pSharedDatas, pNewMeth->uiData, pInit ); hb_itemRelease( pInit ); } pNewMeth->pFuncSym = &s___msgGetShrData; } else { + if( hb_arrayLen( pClass->pClassDatas ) < ( ULONG ) pNewMeth->uiData ) + hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); pNewMeth->uiOffset = hb_clsAddInitValue( pClass, hb_param( 5, HB_IT_ANY ), HB_OO_MSG_CLASSDATA, pNewMeth->uiData, 0, uiClass ); @@ -2102,6 +2118,7 @@ HB_FUNC( __CLSNEW ) { hb_clsDictInit( pNewCls, HASH_KEY ); pNewCls->pClassDatas = hb_itemArrayNew( 0 ); + pNewCls->pSharedDatas = hb_itemArrayNew( 0 ); pNewCls->pInlines = hb_itemArrayNew( 0 ); } @@ -2440,6 +2457,20 @@ HB_FUNC( __CLS_CNTCLSDATA ) } +/* + * = __cls_CntShrData( ) + * + * Return number of class datas + */ +HB_FUNC( __CLS_CNTSHRDATA ) +{ + USHORT uiClass = ( USHORT ) hb_parni( 1 ); + + hb_retni( uiClass && uiClass <= s_uiClasses ? + hb_arrayLen( s_pClasses[ uiClass - 1 ].pSharedDatas ) : 0 ); +} + + /* * = __cls_CntData( ) * @@ -2960,7 +2991,7 @@ static HARBOUR hb___msgGetShrData( void ) if( uiSprCls && uiSprCls <= s_uiClasses ) { - hb_arrayGet( s_pClasses[ uiSprCls - 1 ].pClassDatas, + hb_arrayGet( s_pClasses[ uiSprCls - 1 ].pSharedDatas, pMethod->uiData, hb_stackReturnItem() ); } } @@ -2982,7 +3013,7 @@ static HARBOUR hb___msgSetShrData( void ) if( uiSprCls && uiSprCls <= s_uiClasses ) { - hb_arraySet( s_pClasses[ uiSprCls - 1 ].pClassDatas, + hb_arraySet( s_pClasses[ uiSprCls - 1 ].pSharedDatas, pMethod->uiData, pReturn ); } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 637cbf016d..eef6bcdb96 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -3033,25 +3033,17 @@ static HB_GARBAGE_FUNC( hb_enumHolderRelease ) static void hb_vmEnumStart( BYTE nVars, BYTE nDescend ) { HB_ITEM_PTR pItem; - ULONG ulMax; + BOOL fStart = TRUE; int i; pItem = hb_itemUnRef( hb_stackItemFromTop( -( ( int ) nVars << 1 ) ) ); - if( HB_IS_ARRAY( pItem ) ) - { - ulMax = pItem->item.asArray.value->ulLen; - } - else if( HB_IS_STRING( pItem ) ) - { - ulMax = pItem->item.asString.length; - } - else + if( !HB_IS_ARRAY( pItem ) && ! HB_IS_STRING( pItem ) ) { hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 1, pItem ); return; } - - for( i = ( int ) nVars << 1; i > 0; i -= 2 ) + + for( i = ( int ) nVars << 1; i > 0 && fStart; i -= 2 ) { HB_ITEM_PTR pValue, pOldValue, pEnum, pEnumRef; PHB_ENUMHOLDER pHolder; @@ -3093,25 +3085,45 @@ static void hb_vmEnumStart( BYTE nVars, BYTE nDescend ) pEnum->item.asEnum.basePtr = pItem; pEnum->item.asEnum.valuePtr = NULL; + if( HB_IS_OBJECT( pItem ) && hb_objHasOperator( pItem, HB_OO_OP_ENUMSTART ) ) + { + pEnum->item.asEnum.offset = 0; + pEnum->item.asEnum.valuePtr = hb_itemNew( NULL ); + hb_vmPushNil(); + hb_vmPushLogical( nDescend == 0 ); + hb_objOperatorCall( HB_OO_OP_ENUMSTART, hb_stackItemFromTop( -2 ), + pItem, pEnumRef, hb_stackItemFromTop( -1 ) ); + hb_stackPop(); + if( ! hb_vmPopLogical() ) + { + fStart = FALSE; + break; + } + else if( hb_objHasOperator( pItem, HB_OO_OP_ENUMSKIP ) ) + continue; + hb_itemRelease( pEnum->item.asEnum.valuePtr ); + pEnum->item.asEnum.valuePtr = NULL; + } + if( HB_IS_ARRAY( pItem ) ) { /* the index into an array */ pEnum->item.asEnum.offset = ( nDescend > 0 ) ? 1 : pItem->item.asArray.value->ulLen; - if( ulMax > pItem->item.asArray.value->ulLen ) - ulMax = pItem->item.asArray.value->ulLen; + if( pItem->item.asArray.value->ulLen == 0 ) + fStart = FALSE; } else if( HB_IS_STRING( pItem ) ) { /* storage item for single characters */ pEnum->item.asEnum.offset = ( nDescend > 0 ) ? 1 : pItem->item.asString.length; - if( pItem->item.asString.length ) /* TODO: RT error if not? */ + if( pItem->item.asString.length ) pEnum->item.asEnum.valuePtr = hb_itemPutCL( NULL, pItem->item.asString.value + pEnum->item.asEnum.offset - 1, 1 ); - if( ulMax > pItem->item.asString.length ) - ulMax = pItem->item.asString.length; + else + fStart = FALSE; } else { @@ -3122,7 +3134,7 @@ static void hb_vmEnumStart( BYTE nVars, BYTE nDescend ) hb_vmPushInteger( nVars ); /* number of iterators */ /* empty array/string - do not start enumerations loop */ - hb_vmPushLogical( ulMax != 0 ); + hb_vmPushLogical( fStart ); } @@ -3134,16 +3146,30 @@ static void hb_vmEnumStart( BYTE nVars, BYTE nDescend ) */ static void hb_vmEnumNext( void ) { - HB_ITEM_PTR pEnum; + HB_ITEM_PTR pEnumRef, pEnum; int i; for( i = ( int ) hb_stackItemFromTop( -1 )->item.asInteger.value; i > 0; --i ) { - pEnum = hb_itemUnRefOnce( hb_stackItemFromTop( -( i << 1 ) ) ); + pEnumRef = hb_stackItemFromTop( -( i << 1 ) ); + pEnum = hb_itemUnRefOnce( pEnumRef ); if( HB_IS_ARRAY( pEnum->item.asEnum.basePtr ) ) { - if( ( ULONG ) ++pEnum->item.asEnum.offset > - pEnum->item.asEnum.basePtr->item.asArray.value->ulLen ) + if( HB_IS_OBJECT( pEnum->item.asEnum.basePtr ) && + hb_objHasOperator( pEnum->item.asEnum.basePtr, HB_OO_OP_ENUMSKIP ) ) + { + ++pEnum->item.asEnum.offset; + hb_vmPushNil(); + hb_vmPushLogical( FALSE ); + hb_objOperatorCall( HB_OO_OP_ENUMSKIP, hb_stackItemFromTop( -2 ), + pEnum->item.asEnum.basePtr, pEnumRef, + hb_stackItemFromTop( -1 ) ); + hb_stackPop(); + if( ! hb_vmPopLogical() ) + break; + } + else if( ( ULONG ) ++pEnum->item.asEnum.offset > + pEnum->item.asEnum.basePtr->item.asArray.value->ulLen ) break; } else if( HB_IS_STRING( pEnum->item.asEnum.basePtr ) ) @@ -3172,15 +3198,29 @@ static void hb_vmEnumNext( void ) */ static void hb_vmEnumPrev( void ) { - HB_ITEM_PTR pEnum; + HB_ITEM_PTR pEnumRef, pEnum; int i; for( i = hb_stackItemFromTop( -1 )->item.asInteger.value; i > 0; --i ) { - pEnum = hb_itemUnRefOnce( hb_stackItemFromTop( -( i << 1 ) ) ); + pEnumRef = hb_stackItemFromTop( -( i << 1 ) ); + pEnum = hb_itemUnRefOnce( pEnumRef ); if( HB_IS_ARRAY( pEnum->item.asEnum.basePtr ) ) { - if( --pEnum->item.asEnum.offset == 0 ) + if( HB_IS_OBJECT( pEnum->item.asEnum.basePtr ) && + hb_objHasOperator( pEnum->item.asEnum.basePtr, HB_OO_OP_ENUMSKIP ) ) + { + --pEnum->item.asEnum.offset; + hb_vmPushNil(); + hb_vmPushLogical( TRUE ); + hb_objOperatorCall( HB_OO_OP_ENUMSKIP, hb_stackItemFromTop( -2 ), + pEnum->item.asEnum.basePtr, pEnumRef, + hb_stackItemFromTop( -1 ) ); + hb_stackPop(); + if( ! hb_vmPopLogical() ) + break; + } + else if( --pEnum->item.asEnum.offset == 0 ) break; } else if( HB_IS_STRING( pEnum->item.asEnum.basePtr ) ) diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 408b52f2a0..a71cc5d7ae 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -1433,28 +1433,23 @@ PHB_ITEM hb_itemUnRefOnce( PHB_ITEM pItem ) else if( HB_IS_ENUM( pItem ) ) /* FOR EACH control variable */ { /* enumerator variable */ - if( HB_IS_ARRAY( pItem->item.asEnum.basePtr ) ) + if( pItem->item.asEnum.valuePtr ) + return pItem->item.asEnum.valuePtr; + else if( HB_IS_ARRAY( pItem->item.asEnum.basePtr ) ) { PHB_ITEM pResult = hb_arrayGetItemPtr( pItem->item.asEnum.basePtr, pItem->item.asEnum.offset ); if( pResult ) return pResult; } - else if( pItem->item.asEnum.valuePtr ) - return pItem->item.asEnum.valuePtr; - /* to avoid recursive RT error generation */ - if( pItem->item.asEnum.offset >= 0 ) - { - hb_itemPutNInt( hb_stackAllocItem(), pItem->item.asEnum.offset ); - pItem->item.asEnum.offset = -1; - if( !pItem->item.asEnum.valuePtr ) - pItem->item.asEnum.valuePtr = hb_itemNew( NULL ); + /* put it here to avoid recursive RT error generation */ + pItem->item.asEnum.valuePtr = hb_itemNew( NULL ); + hb_itemPutNInt( hb_stackAllocItem(), pItem->item.asEnum.offset ); + + hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), + 2, pItem->item.asEnum.basePtr, hb_stackItemFromTop( -1 ) ); - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 2, pItem->item.asEnum.basePtr, hb_stackItemFromTop( -1 ) ); - /* break() was executed by error block */ - } return pItem->item.asEnum.valuePtr; } else diff --git a/harbour/tests/clsscast.prg b/harbour/tests/clsscast.prg new file mode 100644 index 0000000000..a893d23d43 --- /dev/null +++ b/harbour/tests/clsscast.prg @@ -0,0 +1,374 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * demonstration/test code for shared class variables casting and allocating + * in multiinherited classes + * + * Copyright 2006 Przemyslaw Czerpak + * www - http://www.harbour-project.org + * + */ + +#define EOL chr(10) +#xtranslate QQOUT([]) => [OUTSTD()] +#xtranslate QOUT([]) => OUTSTD(EOL)[;OUTSTD()] + +#ifdef __HARBOUR__ +#include "hbclass.ch" +#translate MESSAGE INLINE <*expr*> ; + => ; + METHOD INLINE +#else +#include "class(y).ch" +#xtranslate __SENDER( => SENDER( +#endif + +proc main() +local o:=myclass4():new(), i, cbErr + +? DATE(), TIME(), VERSION(), OS() +? + +? "myclass1 class vars:", str( __CLS_CNTCLSDATA(o:myclass1:classH), 3), " => should be: 3" +? "myclass2 class vars:", str( __CLS_CNTCLSDATA(o:myclass2:classH), 3), " => should be: 3" +? "myclass3 class vars:", str( __CLS_CNTCLSDATA(o:myclass3:classH), 3), " => should be: 3" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "myclass4 class vars:", str( __CLS_CNTCLSDATA(o:myclass4:classH), 3), " => should be: 3" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? "myclass4 class vars:", str( __CLS_CNTCLSDATA(o:classH), 3), " => should be: 3" +? + +/* direct assignment, possible because the variables have differ names */ +? "instance variables ["+ltrim(str(len(o)))+"]:"; ? +for i:=1 to len(o); ?? "",o[i]; next +? " => shoule be [0]:" +? +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: (x1) (y1) (z1)" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: (x1) (y1) (z1)" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: (x2) (y2) (z2)" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: (x1) (y1) (z1)" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: (x2) (y2) (z2)" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: (x3) (y3) (z3)" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: (x1) (y1) (z1)" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: (x2) (y2) (z2)" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: (x3) (y3) (z3)" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: (x4) (y4) (z4)" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: (x1) (y1) (z1)" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: (x2) (y2) (z2)" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: (x3) (y3) (z3)" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: (x4) (y4) (z4)" +? +? "initialization..." +o:x1:=" X1 "; o:y1:=" Y1 "; o:z1:=" Z1 " +o:x2:=" X2 "; o:y2:=" Y2 "; o:z2:=" Z2 " +o:x3:=" X3 "; o:y3:=" Y3 "; o:z3:=" Z3 " +o:x4:=" X4 "; o:y4:=" Y4 "; o:z4:=" Z4 " + +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: X1 Y1 Z1" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: X1 Y1 Z1" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: X2 Y2 Z2" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: X1 Y1 Z1" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: X2 Y2 Z2" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: X3 Y3 Z3" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: X1 Y1 Z1" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: X2 Y2 Z2" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: X3 Y3 Z3" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: X4 Y4 Z4" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: X1 Y1 Z1" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: X2 Y2 Z2" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: X3 Y3 Z3" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: X4 Y4 Z4" +? + +? "instance variables ["+ltrim(str(len(o)))+"]:"; ? +for i:=1 to len(o); ?? "",o[i]; next +? " => shoule be [0]:" +? + +? "Setting MYCLASS1 class variables..." +o:myclass1:x1:="[X1]" +o:myclass1:y1:="[Y1]" +o:myclass1:z1:="[Z1]" +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: [X1] [Y1] [Z1]" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: [X1] [Y1] [Z1]" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: X2 Y2 Z2" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: [X1] [Y1] [Z1]" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: X2 Y2 Z2" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: X3 Y3 Z3" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: [X1] [Y1] [Z1]" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: X2 Y2 Z2" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: X3 Y3 Z3" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: X4 Y4 Z4" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: [X1] [Y1] [Z1]" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: X2 Y2 Z2" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: X3 Y3 Z3" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: X4 Y4 Z4" +? + +? "Setting MYCLASS2 class variables..." +o:myclass2:x1:="{X1}" +o:myclass2:y1:="{Y1}" +o:myclass2:z1:="{Z1}" +o:myclass2:x2:="{X2}" +o:myclass2:y2:="{Y2}" +o:myclass2:z2:="{Z2}" +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: {X1} {Y1} {Z1}" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: {X1} {Y1} {Z1}" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: {X2} {Y2} {Z2}" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: {X1} {Y1} {Z1}" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: {X2} {Y2} {Z2}" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: X3 Y3 Z3" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: {X1} {Y1} {Z1}" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: {X2} {Y2} {Z2}" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: X3 Y3 Z3" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: X4 Y4 Z4" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: {X1} {Y1} {Z1}" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: {X2} {Y2} {Z2}" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: X3 Y3 Z3" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: X4 Y4 Z4" +? + +? "Setting MYCLASS3 class variables..." +o:myclass3:x1:="" +o:myclass3:y1:="" +o:myclass3:z1:="" +o:myclass3:x2:="" +o:myclass3:y2:="" +o:myclass3:z2:="" +o:myclass3:x3:="" +o:myclass3:y3:="" +o:myclass3:z3:="" +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: " +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: " +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: " +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: " +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: " +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: " +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: " + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: " + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: " + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: X4 Y4 Z4" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: " +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: " +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: " +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: X4 Y4 Z4" +? + + + + +? "Setting MYCLASS4 class variables..." +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + o:myclass4:x1:="|X1|" + o:myclass4:y1:="|Y1|" + o:myclass4:z1:="|Z1|" + o:myclass4:x2:="|X2|" + o:myclass4:y2:="|Y2|" + o:myclass4:z2:="|Z2|" + o:myclass4:x3:="|X3|" + o:myclass4:y3:="|Y3|" + o:myclass4:z3:="|Z3|" + o:myclass4:x4:="|X4|" + o:myclass4:y4:="|Y4|" + o:myclass4:z4:="|Z4|" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: |X1| |Y1| |Z1|" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: |X1| |Y1| |Z1|" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: |X2| |Y2| |Z2|" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: |X1| |Y1| |Z1|" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: |X2| |Y2| |Z2|" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: |X3| |Y3| |Z3|" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: |X1| |Y1| |Z1|" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: |X2| |Y2| |Z2|" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: |X3| |Y3| |Z3|" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: |X4| |Y4| |Z4|" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: |X1| |Y1| |Z1|" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: |X2| |Y2| |Z2|" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: |X3| |Y3| |Z3|" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: |X4| |Y4| |Z4|" +? + + +? "Setting MYCLASS3:MYCLASS1 class variables..." +o:myclass3:myclass1:x1:="^X1^" +o:myclass3:myclass1:y1:="^Y1^" +o:myclass3:myclass1:z1:="^Z1^" +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: ^X1^ ^Y1^ ^Z1^" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: ^X1^ ^Y1^ ^Z1^" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: |X2| |Y2| |Z2|" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: ^X1^ ^Y1^ ^Z1^" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: |X2| |Y2| |Z2|" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: |X3| |Y3| |Z3|" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: ^X1^ ^Y1^ ^Z1^" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: |X2| |Y2| |Z2|" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: |X3| |Y3| |Z3|" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: |X4| |Y4| |Z4|" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: ^X1^ ^Y1^ ^Z1^" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: |X2| |Y2| |Z2|" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: |X3| |Y3| |Z3|" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: |X4| |Y4| |Z4|" +? + +? "Setting MYCLASS3:MYCLASS2 class variables..." +o:myclass3:myclass2:x1:="=X1=" +o:myclass3:myclass2:y1:="=Y1=" +o:myclass3:myclass2:z1:="=Z1=" +o:myclass3:myclass2:x2:="=X2=" +o:myclass3:myclass2:y2:="=Y2=" +o:myclass3:myclass2:z2:="=Z2=" +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: =X1= =Y1= =Z1=" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: =X1= =Y1= =Z1=" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: =X2= =Y2= =Z2=" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: =X1= =Y1= =Z1=" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: =X2= =Y2= =Z2=" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: |X3| |Y3| |Z3|" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: =X1= =Y1= =Z1=" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: =X2= =Y2= =Z2=" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: |X3| |Y3| |Z3|" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: |X4| |Y4| |Z4|" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: =X1= =Y1= =Z1=" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: =X2= =Y2= =Z2=" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: |X3| |Y3| |Z3|" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: |X4| |Y4| |Z4|" +? + +? "Setting SUPER class variables..." +o:super:x1:="*X1*" +o:super:y1:="*Y1*" +o:super:z1:="*Z1*" +o:super:x2:="*X2*" +o:super:y2:="*Y2*" +o:super:z2:="*Z2*" +o:super:x3:="*X3*" +o:super:y3:="*Y3*" +o:super:z3:="*Z3*" +? "[1] MYCLASS1 VARS:", o:myclass1:x1, o:myclass1:y1, o:myclass1:z1, " => should be: *X1* *Y1* *Z1*" +? "[2] MYCLASS1 VARS:", o:myclass2:x1, o:myclass2:y1, o:myclass2:z1, " => should be: *X1* *Y1* *Z1*" +? "[2] MYCLASS2 VARS:", o:myclass2:x2, o:myclass2:y2, o:myclass2:z2, " => should be: *X2* *Y2* *Z2*" +? "[3] MYCLASS1 VARS:", o:myclass3:x1, o:myclass3:y1, o:myclass3:z1, " => should be: *X1* *Y1* *Z1*" +? "[3] MYCLASS2 VARS:", o:myclass3:x2, o:myclass3:y2, o:myclass3:z2, " => should be: *X2* *Y2* *Z2*" +? "[3] MYCLASS3 VARS:", o:myclass3:x3, o:myclass3:y3, o:myclass3:z3, " => should be: *X3* *Y3* *Z3*" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "[4] MYCLASS1 VARS:", o:myclass4:x1, o:myclass4:y1, o:myclass4:z1, " => should be: *X1* *Y1* *Z1*" + ? "[4] MYCLASS2 VARS:", o:myclass4:x2, o:myclass4:y2, o:myclass4:z2, " => should be: *X2* *Y2* *Z2*" + ? "[4] MYCLASS3 VARS:", o:myclass4:x3, o:myclass4:y3, o:myclass4:z3, " => should be: *X3* *Y3* *Z3*" + ? "[4] MYCLASS4 VARS:", o:myclass4:x4, o:myclass4:y4, o:myclass4:z4, " => should be: |X4| |Y4| |Z4|" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? " MYCLASS1 VARS:", o:x1, o:y1, o:z1, " => should be: *X1* *Y1* *Z1*" +? " MYCLASS2 VARS:", o:x2, o:y2, o:z2, " => should be: *X2* *Y2* *Z2*" +? " MYCLASS3 VARS:", o:x3, o:y3, o:z3, " => should be: *X3* *Y3* *Z3*" +? " MYCLASS4 VARS:", o:x4, o:y4, o:z4, " => should be: |X4| |Y4| |Z4|" +? + + +? "instance variables ["+ltrim(str(len(o)))+"]:"; ? +for i:=1 to len(o); ?? "",o[i]; next +? " => shoule be [0]:" +? +? "myclass1 class vars:", str( __CLS_CNTCLSDATA(o:myclass1:classH), 3), " => should be: 3" +? "myclass2 class vars:", str( __CLS_CNTCLSDATA(o:myclass2:classH), 3), " => should be: 3" +? "myclass3 class vars:", str( __CLS_CNTCLSDATA(o:myclass3:classH), 3), " => should be: 3" +cbErr:=errorBlock({|oErr|break(oErr)}) +begin sequence + ? "myclass4 class vars:", str( __CLS_CNTCLSDATA(o:myclass4:classH), 3), " => should be: 3" +recover + ? "ERROR: no selfclass casting" +end +errorBlock(cbErr) +? "myclass4 class vars:", str( __CLS_CNTCLSDATA(o:classH), 3), " => should be: 3" +? + + +return + + +create class myclass1 +export: + class var x1 init "(x1)" shared + class var y1 init "(y1)" shared + class var z1 init "(z1)" shared +endclass + +create class myclass2 from myclass1 +export: + class var x2 init "(x2)" shared + class var y2 init "(y2)" shared + class var z2 init "(z2)" shared +endclass + +create class myclass3 from myclass1, myclass2 +export: + class var x3 init "(x3)" shared + class var y3 init "(y3)" shared + class var z3 init "(z3)" shared +endclass + +create class myclass4 from myclass3, myclass2 +export: + class var x4 init "(x4)" shared + class var y4 init "(y4)" shared + class var z4 init "(z4)" shared +endclass