fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2008-04-22 04:50 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/include/hbapicls.h
  * harbour/source/vm/classes.c
    + added new function hb_dbgObjSendMessage() which allows to
      call messages with given given execution context for proper
      scope checking

  * harbour/source/debug/dbgentry.c
    + added HB_DBG_SENDMSG() for calling messages with given execution
      context

  * harbour/source/debug/dbgtobj.prg
    * removed all __obj*() function calls
    * use HB_DBG_SENDMSG() to access/assign object variables
    ! fixed default value in GET operation called from object
      inspector to always show current object variable value
    ! fixed set for object variables which hold value: "Method"
      they were recognized as method
      Now object variables can be inspected by debugger.
      If object has multiple private messages with the same name
      inherited from parent classes then their context will be
      dynamically changed depending on position in currently
      debugged code.
This commit is contained in:
Przemyslaw Czerpak
2008-04-22 02:51:18 +00:00
parent b5760b4350
commit 05dd30df9b
5 changed files with 193 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
harbour/ChangeLog
View File

@@ -8,6 +8,30 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-04-22 04:50 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbapicls.h
* harbour/source/vm/classes.c
+ added new function hb_dbgObjSendMessage() which allows to
call messages with given given execution context for proper
scope checking
* harbour/source/debug/dbgentry.c
+ added HB_DBG_SENDMSG() for calling messages with given execution
context
* harbour/source/debug/dbgtobj.prg
* removed all __obj*() function calls
* use HB_DBG_SENDMSG() to access/assign object variables
! fixed default value in GET operation called from object
inspector to always show current object variable value
! fixed set for object variables which hold value: "Method"
they were recognized as method
Now object variables can be inspected by debugger.
If object has multiple private messages with the same name
inherited from parent classes then their context will be
dynamically changed depending on position in currently
debugged code.
2008-04-21 15:54 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* source/rtl/tbrowse.prg
! Added some new lines to XPP methods.

2
harbour/include/hbapicls.h
View File

@@ -126,6 +126,8 @@ HB_EXPORT extern BOOL hb_objHasMessage( PHB_ITEM pObject, PHB_DYNS pMessag
HB_EXPORT extern PHB_ITEM hb_objSendMsg( PHB_ITEM pObj, const char *sMsg, ULONG ulArg, ... );
HB_EXPORT extern PHB_ITEM hb_objSendMessage( PHB_ITEM pObj, PHB_DYNS pMessage, ULONG ulArg, ... );
/* send message which allows to set execution context for debugger */
HB_EXPORT extern void hb_dbgObjSendMessage( int iProcLevel, PHB_ITEM pObject, PHB_ITEM pMessage, int iParamOffset );
/* Harbour equivalent for Clipper internal __mdCreate() */
USHORT hb_clsCreate( USHORT usSize, const char * szClassName );

7
harbour/source/debug/dbgentry.c
View File

@@ -54,6 +54,7 @@
#include "hbvmopt.h"
#include "hbapidbg.h"
#include "hbapiitm.h"
#include "hbapicls.h"
#include "hbapirdd.h"
#include "hbstack.h"
#include "hbvm.h"
@@ -1749,3 +1750,9 @@ HB_FUNC( HB_DBG_SETWATCH )
if( ptr )
hb_dbgSetWatch( ptr, hb_parni( 2 ), hb_parc( 3 ), hb_parl( 4 ) );
}
HB_FUNC( HB_DBG_SENDMSG )
{
hb_dbgObjSendMessage( hb_parnl( 1 ), hb_param( 2, HB_IT_ANY ),
hb_param( 3, HB_IT_ANY ), 4 );
}

92
harbour/source/debug/dbgtobj.prg
View File

@@ -77,21 +77,29 @@ ENDCLASS
METHOD New( oObject, cVarName, lEditable ) CLASS HBDbObject
LOCAL aTemp
LOCAL cMsg, cMsgAcc
LOCAL aMessages, aMethods
LOCAL xValue
DEFAULT lEditable TO .T.
FOR EACH aTemp IN __objGetValueList( oObject )
AAdd( ::pItems, { aTemp[ 1 ], aTemp[ 2 ] } )
AAdd( ::AllNames, aTemp[ 1 ] )
NEXT
FOR EACH aTemp IN __objGetMethodList( oObject )
IF !Empty( aTemp )
AAdd( ::pItems, { aTemp, "Method" } )
AAdd( ::AllNames, aTemp )
/* create list of object messages */
aMessages := oObject:classSel()
aMethods := {}
FOR EACH cMsg IN aMessages
IF Left( cMsg, 1 ) == "_" .AND. ;
HB_AScan( aMessages, cMsgAcc := Substr( cMsg, 2 ),,, .T. ) != 0
xValue := __dbgObjGetValue( oObject, cMsgAcc )
AAdd( ::pItems, { cMsgAcc, xValue, .T. } )
AAdd( ::AllNames, cMsgAcc )
ELSEIF HB_AScan( aMessages, "_" + cMsg,,, .T. ) == 0
AAdd( aMethods, cMsg )
ENDIF
NEXT
FOR EACH cMsg IN aMethods
AAdd( ::pItems, { cMsg, "Method", .F. } )
AAdd( ::AllNames, cMsg )
NEXT
::objname := cVarName
::TheObj := oObject
@@ -133,7 +141,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject
oBrwSets:GoTopBlock := { || ::Arrayindex := 1 }
oBrwSets:GoBottomBlock := { || ::arrayindex := Len( ::ArrayReference ) }
oBrwSets:SkipBlock := { | nSkip, nPos | nPos := ::arrayindex,;
::arrayindex := iif( nSkip > 0, Min( ::arrayindex + nSkip, Len( ::arrayreference ) ),;
::arrayindex := iif( nSkip > 0, Min( ::arrayindex + nSkip, Len( ::arrayReference ) ),;
Max( 1, ::arrayindex + nSkip ) ), ::arrayindex - nPos }
nMaxLen := ArrayMaxLen( ::AllNames )
@@ -143,16 +151,16 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject
oCol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 2, 1 ), 2 } }
oBrwSets:Freeze := 1
oBrwSets:AddColumn( oCol := TBColumnNew( "", { || iif( ISCHARACTER( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. ::ArrayReference[ ::ArrayIndex, 2 ] == "Method",;
"Method",;
PadR( __dbgValToStr( __objSendMsg( ::TheObj, ::ArrayReference[ ::arrayindex, 1 ] ) ), nWidth - 12 ) ) } ) )
oBrwSets:AddColumn( oCol := TBColumnNew( "", { || iif( ISCHARACTER( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. !::ArrayReference[ ::ArrayIndex, 3 ],;
::ArrayReference[ ::ArrayIndex, 2 ],;
PadR( __dbgValToStr( __dbgObjGetValue( ::TheObj, ::ArrayReference[ ::arrayindex, 1 ] ) ), nWidth - 12 ) ) } ) )
oBrwSets:Cargo := 1 // Actual highlighted row
oCol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 3, 1 ), 3 } }
oCol:width := MaxCol() - 14 - nMaxLen
oBrwSets:colPos := 2
::aWindows[ ::nCurWindow ]:bPainted := { || oBrwSets:ForceStable() }
::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ), ::Arrayreference ) }
::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ), ::ArrayReference ) }
::aWindows[ ::nCurwindow ]:cCaption := ::objname + " is of class: " +::TheObj:ClassName()
SetCursor( SC_NONE )
@@ -172,6 +180,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject
LOCAL lExitSave := Set( _SET_EXIT, .T. )
LOCAL bInsSave := SetKey( K_INS )
LOCAL cValue
LOCAL lCanAcc
// make sure browse is stable
oBrowse:forceStable()
@@ -190,7 +199,12 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject
column := oBrowse:getColumn( oBrowse:colPos )
// create a corresponding GET
cValue := PadR( __dbgValToStr( pitem[ nSet, 2 ] ), column:Width )
cValue := __dbgObjGetValue( ::TheObj, pitem[ nSet, 1 ], @lCanAcc )
IF !lCanAcc
Alert( cValue )
RETURN NIL
ENDIF
cValue := PadR( __dbgValToStr( cValue ), column:Width )
@ Row(), Col() GET cValue ;
VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. )
@@ -202,7 +216,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject
SetKey( K_INS, bInsSave )
IF LastKey() == K_ENTER
__objSendMsg( ::TheObj, "_" + pitem[ nSet, 1 ], &cValue )
__dbgObjSetValue( ::TheObj, pitem[ nSet, 1 ], &cValue )
ENDIF
// check exit key from get
@@ -289,14 +303,14 @@ METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) CLASS HBDbObject
ELSEIF ISOBJECT( aArray[ nSet, 2 ] )
HBDbObject():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] )
ELSEIF ( ISCHARACTER( aArray[ nSet, 2 ] ) .AND. ;
aArray[ nSet, 2 ] == "Method" ) .OR. ;
!aArray[ nSet, 3 ] ) .OR. ;
ISBLOCK( aArray[ nSet, 2 ] ) .OR. ;
ValType( aArray[ nSet, 2 ] ) == "P"
Alert( "Value cannot be edited" )
ELSE
IF ::lEditable
oBrwSets:RefreshCurrent()
::doGet( oBrwSets, ::arrayreference, nSet )
::doGet( oBrwSets, ::arrayReference, nSet )
oBrwSets:RefreshCurrent()
oBrwSets:ForceStable()
else
@@ -326,3 +340,43 @@ STATIC FUNCTION ArrayMaxLen( aArray )
NEXT
RETURN nMaxLen
STATIC FUNCTION __dbgObjGetValue( oObject, cVar, lCanAcc )
LOCAL nProcLevel := __Dbg():nProcLevel
LOCAL xResult
LOCAL oErr
BEGIN SEQUENCE WITH {|| break() }
xResult := HB_DBG_SENDMSG( nProcLevel, oObject, cVar )
lCanAcc := .T.
RECOVER
BEGIN SEQUENCE WITH {|oErr| break( oErr ) }
/* Try to access variables using class code level */
xResult := HB_DBG_SENDMSG( 0, oObject, cVar )
lCanAcc := .T.
RECOVER USING oErr
xResult := oErr:description
lCanAcc := .F.
END SEQUENCE
END SEQUENCE
RETURN xResult
STATIC FUNCTION __dbgObjSetValue( oObject, cVar, xValue )
LOCAL nProcLevel := __Dbg():nProcLevel
LOCAL oErr
BEGIN SEQUENCE WITH {|| break() }
HB_DBG_SENDMSG( nProcLevel, oObject, "_" + cVar, xValue )
RECOVER
BEGIN SEQUENCE WITH {|oErr| break( oErr ) }
/* Try to access variables using class code level */
HB_DBG_SENDMSG( 0, oObject, "_" + cVar, xValue )
RECOVER USING oErr
Alert( oErr:description )
END SEQUENCE
END SEQUENCE
RETURN xValue

100
harbour/source/vm/classes.c
View File

@@ -1520,7 +1520,7 @@ static PHB_SYMB hb_clsScalarMethod( PCLASS pClass, PHB_DYNS pMsg,
if( pStack )
{
pStack->uiClass = pClass - s_pClasses;
pStack->uiClass = ( USHORT ) ( pClass - s_pClasses );
if( pMethod )
{
pStack->uiMethod = ( USHORT ) ( pMethod - pClass->pMethods );
@@ -2264,6 +2264,74 @@ static PHB_SYMB hb_objGetFuncSym( PHB_ITEM pItem )
return NULL;
}
/* send message which allows to set execution context for debugger */
HB_EXPORT void hb_dbgObjSendMessage( int iProcLevel, PHB_ITEM pObject, PHB_ITEM pMessage, int iParamOffset )
{
PHB_DYNS pMsgSym;
pMsgSym = hb_objGetMsgSym( pMessage );
if( pObject && pMsgSym )
{
USHORT uiParams = 0;
/* set requested sender class and method id for scope verification */
if( iProcLevel > 0 )
{
int iLevel = hb_stackCallDepth();
if( iProcLevel < iLevel )
{
LONG lOffset = hb_stackBaseProcOffset( iLevel - iProcLevel );
if( lOffset > 0 )
{
PHB_ITEM pItem = hb_stackItem( lOffset );
PHB_ITEM pBase = hb_stackBaseItem();
pBase->item.asSymbol.stackstate->uiClass =
pItem->item.asSymbol.stackstate->uiClass;
pBase->item.asSymbol.stackstate->uiMethod =
pItem->item.asSymbol.stackstate->uiMethod;
}
}
}
else if( iProcLevel == 0 )
{
/* set scope like for internal object messages to any visible
method without respecting overloaded methods */
USHORT uiClass = hb_objGetClassH( pObject );
if( uiClass && uiClass <= s_uiClasses )
{
PMETHOD pMethod = hb_clsFindMsg( &s_pClasses[ uiClass ], pMsgSym );
if( pMethod )
{
PHB_ITEM pBase = hb_stackBaseItem();
pBase->item.asSymbol.stackstate->uiClass = uiClass;
pBase->item.asSymbol.stackstate->uiMethod =
( USHORT ) ( pMethod - s_pClasses[ uiClass ].pMethods );
}
}
}
hb_vmPushSymbol( pMsgSym->pSymbol );
hb_vmPush( pObject );
if( iParamOffset > 0 )
{
int iPCount = hb_pcount();
while( iParamOffset <= iPCount )
{
hb_vmPush( hb_stackItemFromBase( iParamOffset ) );
++uiParams;
++iParamOffset;
}
}
hb_vmSend( uiParams );
}
else
hb_errRT_BASE( EG_ARG, 3000, NULL, "hb_dbgObjSendMessage()", 2, pObject, pMsgSym );
}
static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign )
{
if( !fAssign )
@@ -4332,25 +4400,32 @@ HB_FUNC( __CLSGETPROPERTIES )
if( uiClass && uiClass <= s_uiClasses )
{
PCLASS pClass = &s_pClasses[ uiClass ];
PMETHOD pMethod = pClass->pMethods;
ULONG ulLimit = hb_clsMthNum( pClass );
PHB_ITEM pItem = NULL;
hb_arrayNew( pReturn, 0 );
PMETHOD pMethod;
ULONG ulLimit, ulCount;
ulCount = 0;
ulLimit = hb_clsMthNum( pClass );
pMethod = pClass->pMethods;
do
{
if( pMethod->pMessage && ( pMethod->uiScope & HB_OO_CLSTP_PERSIST ) )
{
pItem = hb_itemPutC( pItem, pMethod->pMessage->pSymbol->szName );
hb_arrayAdd( pReturn, pItem );
}
++ulCount;
++pMethod;
}
while( --ulLimit );
if( pItem )
hb_itemRelease( pItem );
hb_arrayNew( pReturn, ulCount );
ulCount = 0;
ulLimit = hb_clsMthNum( pClass );
pMethod = pClass->pMethods;
do
{
if( pMethod->pMessage && ( pMethod->uiScope & HB_OO_CLSTP_PERSIST ) )
hb_arraySetC( pReturn, ++ulCount, pMethod->pMessage->pSymbol->szName );
++pMethod;
}
while( --ulLimit );
}
hb_itemReturnRelease( pReturn );
@@ -4413,7 +4488,6 @@ void hb_clsAssociate( USHORT usClassH )
hb_itemReturnRelease( pSelf );
}
#if 1
/*
* __CLS_PARAM() and __CLS_PAR00() functions are only for backward binary