diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 05f7a62c83..ed27774fd9 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,16 @@ +2001-05-20 23:15 UTC+1 JFL (mafact) + * harbour/source/vm/classes.c + + hb_objGetRealClsName(object, szmsg ) + Return the real class name regarding the Message called + So as an inherited method will return it's real class parent + * harbour/source/vm/proc.c + * modified PROCNAME() to call the new classes function + * harbour/include/hbapi.h + + added hb_objGetRealClsName + * harbour/include/hbclass.ch + + added xtranslate to allow MethodName as the same as ProcName + (a la class(y) ) + 2001-05-20 13:35 GMT -3 Luiz Rafael Culik *contrib/hbzlib/zip.c diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 311d5b32fa..9547c76a90 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -419,6 +419,7 @@ extern void hb_clsReleaseAll( void ); /* releases all defined classes */ /* object management */ extern char * hb_objGetClsName( PHB_ITEM pObject ); /* retrieves an object class name */ +extern char * hb_objGetRealClsName( PHB_ITEM pObject, char * szString ); /* retrieves an object class name for a specific message */ extern PHB_FUNC hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pSymMsg ); /* returns the method pointer of a object class */ extern ULONG hb_objHasMsg( PHB_ITEM pObject, char * szString ); /* returns TRUE/FALSE whether szString is an existing message for object */ @@ -535,7 +536,7 @@ extern void hb_macroPushAliasedValue( HB_ITEM_PTR pAlias, HB_ITEM_PTR pVar ); extern char * hb_macroGetType( HB_ITEM_PTR pItem ); /* determine the type of an expression */ /* garbage collector */ -#define HB_GARBAGE_FUNC( hbfunc ) void hbfunc( void * Cargo ) /* callback function for cleaning garbage memory pointer */ +#define HB_GARBAGE_FUNC( hbfunc ) void hbfunc( void * Cargo ) /* callback function for cleaning garbage memory pointer */ typedef HB_GARBAGE_FUNC( HB_GARBAGE_FUNC_ ); typedef HB_GARBAGE_FUNC_ *HB_GARBAGE_FUNC_PTR; diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index 40c4eb1a90..802e8831f8 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -144,6 +144,7 @@ DECLARE TClass ; /* CLASSY SYNTAX */ #IFDEF HB_CLS_CSY #xtranslate CREATE CLASS => CLASS +#xtranslate METHODNAME => PROCNAME #endif #ifndef HB_SHORTNAMES diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 5cf4c90d36..78f2962cb1 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -601,6 +601,103 @@ char * hb_objGetClsName( PHB_ITEM pObject ) return szClassName; } +/* + * = ( pObject ) + * + * Get the real class name of an object message + * Will return the class name from wich the message is inherited in case + * of inheritance. + * + */ +char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName ) +{ + char * szClassName; + + HB_TRACE(HB_TR_DEBUG, ("hb_objGetrealClsName(%p)", pObject)); + + if( HB_IS_ARRAY( pObject ) ) + { + if( ! pObject->item.asArray.value->uiClass ) + szClassName = "ARRAY"; + else + { + PHB_DYNS pMsg = hb_dynsymFindName( szName ); + USHORT uiClass; + + /* default value to current class object */ + uiClass = pObject->item.asArray.value->uiClass; + + if( uiClass && uiClass <= s_uiClasses ) + { + PCLASS pClass = s_pClasses + ( uiClass - 1 ); + USHORT uiAt = ( USHORT ) ( ( ( hb_cls_MsgToNum( pMsg ) ) % pClass->uiHashKey ) * BUCKET ); + USHORT uiMask = ( USHORT ) ( pClass->uiHashKey * BUCKET ); + USHORT uiLimit = ( USHORT ) ( uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ) ); + + s_pMethod = NULL; /* Current method pointer */ + + while( uiAt != uiLimit ) + { + if( pClass->pMethods[ uiAt ].pMessage == pMsg ) + { + s_pMethod = pClass->pMethods + uiAt; + uiClass = s_pMethod->uiSprClass; + break; + } + uiAt++; + if( uiAt == uiMask ) + uiAt = 0; + } + } + + szClassName = + ( s_pClasses + uiClass - 1 )->szName; + + } + } + else /* built in types */ + { + switch( pObject->type ) + { + case HB_IT_NIL: + szClassName = "NIL"; + break; + + case HB_IT_STRING: + szClassName = "CHARACTER"; + break; + + case HB_IT_BLOCK: + szClassName = "BLOCK"; + break; + + case HB_IT_SYMBOL: + szClassName = "SYMBOL"; + break; + + case HB_IT_DATE: + szClassName = "DATE"; + break; + + case HB_IT_INTEGER: + case HB_IT_LONG: + case HB_IT_DOUBLE: + szClassName = "NUMERIC"; + break; + + case HB_IT_LOGICAL: + szClassName = "LOGICAL"; + break; + + default: + szClassName = "UNKNOWN"; + break; + } + } + + return szClassName; +} + /* * = hb_objGetMethod( , ) diff --git a/harbour/source/vm/proc.c b/harbour/source/vm/proc.c index c57620914d..59e76ef488 100644 --- a/harbour/source/vm/proc.c +++ b/harbour/source/vm/proc.c @@ -111,7 +111,7 @@ char * hb_procname( int iLevel, char * szName ) { if( ( *( pBase + 1 ) )->type == HB_IT_ARRAY ) /* it is a method name */ { - strcpy( szName, hb_objGetClsName( *( pBase + 1 ) ) ); + strcpy( szName, hb_objGetRealClsName( *( pBase + 1 ), ( *pBase )->item.asSymbol.value->szName ) ); strcat( szName, ":" ); strcat( szName, ( *pBase )->item.asSymbol.value->szName ); }