2001-06-09 09:35 UTC+1 JFL (mafact) <jfl@mafact.com>

This commit is contained in:
Jean-Francois Lefebvre
2001-06-09 07:51:00 +00:00
parent 8a3b3dc3f2
commit e3d1d9c674
2 changed files with 178 additions and 37 deletions

View File

@@ -1,3 +1,7 @@
2001-06-09 09:35 UTC+1 JFL (mafact) <jfl@mafact.com>
* harbour/source/vm/Classe.c
* New scoping for rel. 0.37 !
2001-06-07 18:40 UTC-0800 Ron Pinkas <ron@profit-master.com>
* source/vm/hvm.c
! Fixed HB_P_MPOPFIELD was poping assgined value pre-maturely, causing "data type error" from RDD when replacing a field using macro.

View File

@@ -159,6 +159,8 @@
* 1.37 minor syntax correction
* 1.38 __ObjHasMsg() could return true when false
*
* 1.61 added hb_objGetpMethod and rewrite hb_clsScope()
*
* See doc/license.txt for licensing terms.
*
*/
@@ -230,6 +232,7 @@ static void hb_clsRelease( PCLASS );
char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName );
PHB_FUNC hb_objGetMethod( PHB_ITEM, PHB_SYMB );
PHB_FUNC hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL lAllowErrFunc );
PMETHOD hb_objGetpMethod( PHB_ITEM, PHB_SYMB );
ULONG hb_objHasMsg( PHB_ITEM pObject, char * szString );
static HARBOUR hb___msgClsH( void );
@@ -400,12 +403,131 @@ void hb_clsIsClassRef( void )
}
}
void hb_clsScope( PHB_ITEM pObject, PMETHOD pMethod )
{
/* Will be re-Enabled after rel 0.37 (JFL) */
PHB_ITEM * pBase = hb_stack.pBase;
PHB_ITEM pCaller;
LONG iLevel = 1;
BOOL bRetVal = FALSE ;
USHORT uiScope = pMethod->uiScope;
PHB_DYNS pMessage = pMethod->pMessage;
PMETHOD pCallerMethod ;
char szName[ HB_SYMBOL_NAME_LEN + HB_SYMBOL_NAME_LEN + 32 ];
char * szCallerNameMsg;
char * szCallerNameObject;
char * szSelfNameMsg;
char * szSelfNameObject;
char * szSelfNameRealClass;
szSelfNameObject = hb_objGetClsName( pObject );
szSelfNameMsg = pMessage->pSymbol->szName ;
szSelfNameRealClass = hb_objGetRealClsName( pObject, pMessage->pSymbol->szName );
if ( (( uiScope & HB_OO_CLSTP_PROTECTED ) ) ||
(( uiScope & HB_OO_CLSTP_HIDDEN ) ) ||
(( uiScope & HB_OO_CLSTP_READONLY ) )
)
{
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
pBase = hb_stack.pItems + ( *pBase )->item.asSymbol.stackbase;
szCallerNameMsg = ( *pBase )->item.asSymbol.value->szName ;
/* Is it an inline ? if so back one more ... */
if ( ( strcmp( szCallerNameMsg, "__EVAL" ) == 0 ) && pBase != hb_stack.pItems)
{
pBase = hb_stack.pItems + ( *pBase )->item.asSymbol.stackbase;
}
/* Now get the callers ... */
pCaller = * (pBase+1 ) ;
szCallerNameObject = hb_objGetClsName( pCaller ) ;
szCallerNameMsg = ( *pBase )->item.asSymbol.value->szName ;
if( iLevel == -1 )
{
strcpy( szName, szSelfNameObject );
strcat( szName, ":" );
strcat( szName, szSelfNameMsg );
if ( uiScope & HB_OO_CLSTP_PROTECTED )
if( ( *( pBase+1 ) )->type == HB_IT_ARRAY ) /* is the sender an object */
{
/* Trying to access a protected Msg from outside the object ... */
if (! (pCaller == pObject) )
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (protected)", szName, 0 );
}
else
{
/* If called from a function ... protected violation ! */
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (protected)", szName, 0 );
}
if ( uiScope & HB_OO_CLSTP_HIDDEN )
if( ( *( pBase+1 ) )->type == HB_IT_ARRAY ) /* is the sender an object */
{
/* Trying to access a protected Msg from outside the object ... */
if (! (pCaller == pObject) )
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (Hidden)", szName, 0 );
else
{
/* Now as it is an hidden Msg, it can only be called from */
/* a method of its original class */
if (! (hb_objGetRealClsName( pCaller, szCallerNameMsg) == szSelfNameRealClass) )
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (Hidden)", szName, 0 );
}
}
else
{
/* If called from a function ... Hidden violation ! */
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (Hidden)", szName, 0 );
}
if ( uiScope & HB_OO_CLSTP_READONLY )
{
if(
( pMethod->pFunction == hb___msgSetData ) ||
( pMethod->pFunction == hb___msgSetClsData ) ||
( pMethod->pFunction == hb___msgSetShrData )
)
bRetVal = TRUE;
if (bRetVal)
if( ( *( pBase+1 ) )->type == HB_IT_ARRAY ) /* is the sender an object */
{
/* Trying to assign a RO Msg from outside the object ... */
if (! (pCaller == pObject) )
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (ReadOnly)", szName, 0 );
else
{
/* can only be called from a Constructor */
#ifdef HB_CLS_ENFORCERO /* Not enabled by default */
/* ok Now is it a CTOR ? */
PHB_DYNS pCallerMsg = hb_dynsymGet( szCallerNameMsg );
pCallerMethod = hb_objGetpMethod( pCaller, pCallerMsg->pSymbol );
if ( pCallerMethod )
{
if ( ! (pCallerMethod->uiScope & HB_OO_CLSTP_CTOR) )
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (ReadOnly)", szName, 0 );
}
#endif
}
}
else
{
/* If called from a function ... ReadOnly violation ! */
hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (ReadOnly)", szName, 0 );
}
}
}
}
}
ULONG hb_cls_MsgToNum( PHB_DYNS pMsg )
{
USHORT i;
@@ -533,14 +655,11 @@ char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName )
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;
uiClass = (pClass->pMethods + uiAt)->uiSprClass;
break;
}
uiAt++;
@@ -612,46 +731,30 @@ PHB_FUNC hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL lAllowErrFunc
{
USHORT uiClass;
PHB_DYNS pMsg = pMessage->pDynSym;
PHB_FUNC pFunction;
PMETHOD pMethod;
HB_TRACE(HB_TR_DEBUG, ("hb_objGetMthd(%p, %p)", pObject, pMessage));
if( pObject->type == HB_IT_ARRAY )
uiClass = pObject->item.asArray.value->uiClass;
else
uiClass = 0;
pMethod = hb_objGetpMethod( pObject, pMessage );
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;
hb_clsScope( pObject, s_pMethod );
return s_pMethod->pFunction;
}
uiAt++;
if( uiAt == uiMask )
uiAt = 0;
}
}
if ( pMethod )
{
pFunction = pMethod->pFunction;
hb_clsScope( pObject, pMethod );
s_pMethod = pMethod ;
return pFunction;
}
/* Default message here */
if( s_msgClassName == NULL )
{
s_msgClassName = hb_dynsymGet( "CLASSNAME" ); /* Standard messages */
s_msgClassH = hb_dynsymGet( "CLASSH" ); /* Not present in classdef. */
s_msgClassSel = hb_dynsymGet( "CLASSSEL" );
s_msgEval = hb_dynsymGet( "EVAL" );
s_msgClsParent = hb_dynsymGet( "ISDERIVEDFROM" );
s_msgClassName = hb_dynsymGet( "CLASSNAME" ); /* Standard messages */
s_msgClassH = hb_dynsymGet( "CLASSH" ); /* Not present in classdef. */
s_msgClassSel = hb_dynsymGet( "CLASSSEL" );
s_msgEval = hb_dynsymGet( "EVAL" );
s_msgClsParent = hb_dynsymGet( "ISDERIVEDFROM" );
/*s_msgClass = hb_dynsymGet( "CLASS" );*/
}
@@ -684,6 +787,40 @@ PHB_FUNC hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL lAllowErrFunc
return NULL;
}
PMETHOD hb_objGetpMethod( PHB_ITEM pObject, PHB_SYMB pMessage )
{
USHORT uiClass;
PHB_DYNS pMsg = pMessage->pDynSym;
HB_TRACE(HB_TR_DEBUG, ("hb_objGetpMethod(%p, %p)", pObject, pMessage));
if( pObject->type == HB_IT_ARRAY )
uiClass = pObject->item.asArray.value->uiClass;
else
uiClass = 0;
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 ) );
while( uiAt != uiLimit )
{
if( pClass->pMethods[ uiAt ].pMessage == pMsg )
return (pClass->pMethods + uiAt) ;
uiAt++;
if( uiAt == uiMask )
uiAt = 0;
}
}
return NULL;
}
/*
* <uPtr> = hb_objHasMsg( <pObject>, <szString> )
*