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

2009-05-08 14:35 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/source/vm/Makefile
    * respect HB_HVM_ALL user settings
    ! export HB_HVM_ALL value set automatically - otherwise it's not seen
      when HBVMMT is compiled

  * harbour/source/vm/classes.c
    * exteneded :classsel() build in method to repsect scope given as
      2-nd parameter and return extended information compatible with
      :ClassFullSel() implemented in xHarbour by Francesco Saverio Giudice.
      This extended info is returned when 3-rd parameter is .T.

  * harbour/source/rtl/dateshb.c
    * do not generate RTE on wrong params in HB_STOT() function

  * harbour/contrib/xhb/xhbfunc.c
    + added hacked function which allows to send messages without respecting
      scope. It works only for the most visible data and does not support
      any automatic casting.

  * harbour/contrib/xhb/dumpvar.prg
    ! fixed HB_DumpVar() results on platforms where CRLF has different
       length then 2
    % small improve in hash item presentation
    + added __objGetMsgFullList() and __objGetValueFullList() as static
      functions. Code borrowed form xHarbour by Francesco Saverio Giudice.
    * make HB_DumpVar() working with object values.
This commit is contained in:
Przemyslaw Czerpak
2009-05-08 12:27:40 +00:00
parent 146eeda68b
commit 4fe32a0a79
6 changed files with 209 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
harbour/ChangeLog
View File

@@ -17,6 +17,34 @@
past entries belonging to these authors: Viktor Szakats.
*/
2009-05-08 14:35 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/vm/Makefile
* respect HB_HVM_ALL user settings
! export HB_HVM_ALL value set automatically - otherwise it's not seen
when HBVMMT is compiled
* harbour/source/vm/classes.c
* exteneded :classsel() build in method to repsect scope given as
2-nd parameter and return extended information compatible with
:ClassFullSel() implemented in xHarbour by Francesco Saverio Giudice.
This extended info is returned when 3-rd parameter is .T.
* harbour/source/rtl/dateshb.c
* do not generate RTE on wrong params in HB_STOT() function
* harbour/contrib/xhb/xhbfunc.c
+ added hacked function which allows to send messages without respecting
scope. It works only for the most visible data and does not support
any automatic casting.
* harbour/contrib/xhb/dumpvar.prg
! fixed HB_DumpVar() results on platforms where CRLF has different
length then 2
% small improve in hash item presentation
+ added __objGetMsgFullList() and __objGetValueFullList() as static
functions. Code borrowed form xHarbour by Francesco Saverio Giudice.
* make HB_DumpVar() working with object values.
2009-05-08 10:14 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* source/rtl/tclass.prg
! Fix to prev commit.

130
harbour/contrib/xhb/dumpvar.prg
View File

@@ -94,6 +94,7 @@ FUNCTION HB_DumpVar( xVar, lRecursive, nMaxRecursionLevel )
STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL cType := ValType( xVar )
LOCAL cString := "", cKey
LOCAL nEolLen
DEFAULT lAssocAsObj TO FALSE
DEFAULT lRecursive TO FALSE
@@ -113,16 +114,17 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion
cString += Space( nIndent ) + "Type='Associative' -> " + CRLF
// Keys extraction.
IF Len( xVar:Keys ) > 0
nEolLen := Len( CRLF )
cString += Space( nIndent ) + "{" + CRLF
FOR EACH cKey IN xVar:Keys
cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + CRLF
IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + CRLF
cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + CRLF
ENDIF
NEXT
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + CRLF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
ELSE
@@ -170,16 +172,15 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion
STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL xProp, aProps
LOCAL aMethods, aMth
LOCAL lOldScope
LOCAL cString := ""
DEFAULT nIndent TO 0
IF ValType( oVar ) == "O"
lOldScope := __SetClassScope( .F. )
// lOldScope := __SetClassScope( .F. )
aMethods := __objGetMsgFullList( oVar, .F., HB_MSGLISTALL, nScope )
aProps := __objGetValueFullList( oVar, NIL, nScope )
__SetClassScope( lOldScope )
// __SetClassScope( lOldScope )
IF Len( aProps ) > 0
cString += Space( nIndent ) + " | +- >> Begin Data ------" + CRLF
@@ -207,7 +208,7 @@ STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLe
RETURN cString
STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL xVal, nChar
LOCAL xVal, nChar, nEolLen
LOCAL cString := ""
DEFAULT nIndent TO 0
@@ -215,19 +216,20 @@ STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecu
//TraceLog( "DShowArray: aVar, lRecursive", aVar, lRecursive )
IF ValType( aVar ) == "A"
nEolLen := Len( CRLF )
nChar := Len( LTrim( Str( Len( aVar ) ) ) ) // return number of chars to display that value
// i.e. if Len( aVar ) == 99, then nChar := 2
cString += Space( nIndent ) + "{" + CRLF
FOR EACH xVal IN aVar
cString += Space( nIndent ) + " ["+ LTrim( StrZero( xVal:__EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + CRLF
ENDIF
NEXT
IF Len( aVar ) > 0
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + CRLF
ENDIF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
@@ -235,7 +237,8 @@ STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecu
RETURN cString
STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL xVal, xKey, aKeys
LOCAL xVal
LOCAL nEolLen
LOCAL cString := ""
DEFAULT nIndent TO 0
@@ -243,19 +246,18 @@ STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecur
//TraceLog( "DShowHash: hVar, ValType( hVar ), lRecursive", hVar, ValType( hVar ), ValToPrg( hVar ), lRecursive )
IF ValType( hVar ) == "H"
aKeys := hb_HKeys( hVar )
nEolLen := Len( CRLF )
cString += Space( nIndent ) + "{" + CRLF
FOR EACH xKey IN aKeys
xVal := hVar[ xKey ]
cString += Space( nIndent ) + " ["+ LTrim( AsString( xKey ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
FOR EACH xVal IN hVar
cString += Space( nIndent ) + " ["+ LTrim( AsString( xVal:__enumKey() ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + CRLF
ENDIF
NEXT
IF Len( aKeys ) > 0
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
IF Len( hVar ) > 0
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + CRLF
ENDIF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
@@ -327,6 +329,12 @@ STATIC FUNCTION DecodeType( nType AS NUMERIC )
cString += "MsgPrp"
CASE nType == HB_OO_MSG_CLASSPROPERTY // 10
cString += "ClsPrp"
CASE nType == HB_OO_MSG_REALCLASS
cString += "RealCls"
CASE nType == HB_OO_MSG_DELEGATE
cString += "Delegate"
CASE nType == HB_OO_MSG_PERFORM
cString += "Perform"
ENDCASE
RETURN PadR( cString, 7 )
@@ -338,7 +346,83 @@ STATIC FUNCTION asString( x )
CASE v == "C"
RETURN '"' + x + '"'
OTHERWISE
RETURN cStr( x )
RETURN hb_cStr( x )
ENDCASE
RETURN x
#include "error.ch"
/*
* (C) 2003 - Francesco Saverio Giudice
*
* return all informations about classes, included type and scope
*/
STATIC FUNCTION __objGetMsgFullList( oObject, lData, nRange, nScope, nNoScope )
LOCAL aMessages
LOCAL aReturn
LOCAL nFirstProperty, aMsg
IF ValType( oObject ) != 'O'
__errRT_BASE( EG_ARG, 3101, NIL, ProcName() )
ENDIF
IF ValType( lData ) != 'L'
lData := .T.
ENDIF
IF ValType( nNoScope ) != 'N'
nNoScope := 0
ENDIF
// nRange is already defaulted in ClassFullSel in classes.c
aMessages := ASort( oObject:ClassSel( nRange, nScope, .T. ),,, {|x,y| x[HB_OO_DATA_SYMBOL] < y[HB_OO_DATA_SYMBOL] } )
aReturn := {}
nFirstProperty := aScan( aMessages, { | aElement | Left( aElement[HB_OO_DATA_SYMBOL], 1 ) == '_' } )
FOR EACH aMsg IN aMessages
IF Left( aMsg[HB_OO_DATA_SYMBOL], 1 ) == '_'
LOOP
ENDIF
IF ( AScan( aMessages, { | aElement | aElement[HB_OO_DATA_SYMBOL] == "_" + aMsg[HB_OO_DATA_SYMBOL] }, nFirstProperty ) != 0 ) == lData
IF nNoScope == 0 .OR. HB_BITAND( aMsg[HB_OO_DATA_SCOPE], nNoScope ) == 0
AAdd( aReturn, aMsg )
ENDIF
ENDIF
NEXT
RETURN aReturn
/*
* (C) 2003 - Francesco Saverio Giudice
*
* return all values from classes, included type and scope
*/
STATIC FUNCTION __objGetValueFullList( oObject, aExcept, nScope, nNoScope )
LOCAL aVars
LOCAL aReturn
LOCAL aVar
IF ValType( oObject ) != 'O'
__errRT_BASE( EG_ARG, 3101, NIL, ProcName( 0 ) )
ENDIF
IF ValType( aExcept ) != 'A'
aExcept := {}
ENDIF
aVars := __objGetMsgFullList( oObject, .T., HB_MSGLISTALL, nScope, nNoScope )
aReturn := {}
FOR EACH aVar IN aVars
IF hb_aScan( aExcept, aVar[HB_OO_DATA_SYMBOL],,, .T. ) == 0
//TraceLog( "__objGetValueFullList(): aVar[HB_OO_DATA_SYMBOL]", aVar[HB_OO_DATA_SYMBOL] )
AAdd( aReturn, { aVar[HB_OO_DATA_SYMBOL], __SendRawMsg( oObject, aVar[HB_OO_DATA_SYMBOL] ), aVar[HB_OO_DATA_TYPE], aVar[HB_OO_DATA_SCOPE] } )
ENDIF
NEXT
RETURN aReturn

7
harbour/contrib/xhb/xhbfunc.c
View File

@@ -54,6 +54,7 @@
#include "hbapigt.h"
#include "hbapiitm.h"
#include "hbapigt.h"
#include "hbapicls.h"
#if 0
@@ -212,6 +213,12 @@ HB_FUNC( HB_ARRAYID ) /* for debugging: returns the array's "address" so dual r
hb_retptr( pArray ? hb_arrayId( pArray ) : NULL );
}
HB_FUNC( __SENDRAWMSG )
{
hb_dbg_objSendMessage( 0, hb_param( 1, HB_IT_ANY ),
hb_param( 2, HB_IT_ANY ), 3 );
}
/* Hash utem functions */
HB_FUNC_EXTERN( HB_HASH );
HB_FUNC_EXTERN( HB_HHASKEY );

2
harbour/source/rtl/dateshb.c
View File

@@ -319,7 +319,7 @@ HB_FUNC( HB_STOT )
hb_rettdt( lDate, lTime );
}
else
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
hb_rettdt( 0, 0 );
}
HB_FUNC( HB_HOUR )

4
harbour/source/vm/Makefile
View File

@@ -4,6 +4,8 @@
ROOT = ../../
ifeq ($(HB_HVM_ALL),)
HB_HVM_ALL = yes
ifeq ($(HB_COMPILER),owatcom)
ifeq ($(HB_ARCHITECTURE),win)
@@ -28,6 +30,8 @@ endif
ifeq ($(HB_COMPILER),dmc)
HB_HVM_ALL = no
endif
export HB_HVM_ALL
endif
ifeq ($(HB_ARCHITECTURE),win)
ifeq ($(HB_COMPILER),mingw)

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

@@ -4133,6 +4133,46 @@ static HARBOUR hb___msgClassName( void )
}
static int hb_methodType( PMETHOD pMethod )
{
if ( pMethod->pFuncSym == &s___msgSetClsData ||
pMethod->pFuncSym == &s___msgGetClsData ||
pMethod->pFuncSym == &s___msgSetShrData ||
pMethod->pFuncSym == &s___msgGetShrData )
return HB_OO_MSG_CLASSDATA;
else if( pMethod->pFuncSym == &s___msgSetData ||
pMethod->pFuncSym == &s___msgGetData )
return HB_OO_MSG_DATA;
else if( pMethod->pFuncSym == &s___msgEvalInline )
return HB_OO_MSG_INLINE;
else if( pMethod->pFuncSym == &s___msgVirtual )
return HB_OO_MSG_VIRTUAL;
else if( pMethod->pFuncSym == &s___msgSuper )
return HB_OO_MSG_SUPER;
else if( pMethod->pFuncSym == &s___msgRealClass )
return HB_OO_MSG_REALCLASS;
else if( pMethod->pFuncSym == &s___msgDelegate )
return HB_OO_MSG_DELEGATE;
else if( pMethod->pFuncSym == &s___msgPerform )
return HB_OO_MSG_PERFORM;
else if( pMethod->pMessage == s___msgOnError.pDynSym )
return HB_OO_MSG_ONERROR;
else if( pMethod->pMessage == s___msgDestructor.pDynSym )
return HB_OO_MSG_DESTRUCTOR;
else
return HB_OO_MSG_METHOD;
}
/*
* <aMessages> := <obj>:ClassSel()
*
@@ -4145,20 +4185,23 @@ static HARBOUR hb___msgClassSel( void )
if( uiClass && uiClass <= s_uiClasses )
{
PHB_ITEM pReturn = hb_itemNew( NULL );
PHB_ITEM pReturn, pItem;
PCLASS pClass = s_pClasses[ uiClass ];
PMETHOD pMethod = pClass->pMethods;
ULONG ulLimit = hb_clsMthNum( pClass ), ulPos = 0;
USHORT nParam;
USHORT nParam, nScope;
BOOL lFull;
nParam = hb_pcount() > 0 ? ( USHORT ) hb_parni( 1 ) : HB_MSGLISTALL;
hb_arrayNew( pReturn, pClass->uiMethods );
nScope = hb_pcount() > 1 ? ( USHORT ) hb_parni( 2 ) : 0;
lFull = hb_pcount() > 2 && ISLOG( 3 ) && hb_parl( 3 );
pReturn = hb_itemArrayNew( pClass->uiMethods );
do
{
if( pMethod->pMessage ) /* Hash Entry used ? */
{
if( ( nParam == HB_MSGLISTALL ) ||
if( ( nParam == HB_MSGLISTALL ) ||
( nParam == HB_MSGLISTCLASS &&
(
( pMethod->pFuncSym == &s___msgSetClsData ) ||
@@ -4177,8 +4220,21 @@ static HARBOUR hb___msgClassSel( void )
)
)
{
hb_arraySetC( pReturn, ++ulPos,
pMethod->pMessage->pSymbol->szName );
if( nScope == 0 || ( pMethod->uiScope & nScope ) != 0 )
{
if( lFull )
{
pItem = hb_arrayGetItemPtr( pReturn, ++ulPos );
hb_arrayNew( pItem, 4 );
hb_arraySetC( pItem, HB_OO_DATA_SYMBOL,
pMethod->pMessage->pSymbol->szName );
hb_arraySetNI( pItem, HB_OO_DATA_TYPE, hb_methodType( pMethod) );
hb_arraySetNI( pItem, HB_OO_DATA_SCOPE, pMethod->uiScope );
}
else
hb_arraySetC( pReturn, ++ulPos,
pMethod->pMessage->pSymbol->szName );
}
}
}
++pMethod;