diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3f5ea894a5..60e50e36ea 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,25 @@ +20000403-04:47 GMT+1 Victor Szakats + + * source/rdd/dbf1.c + ! Now the MEMO fields are marked as MEMO. + (Two HBTEST failures gone) + + * source/vm/itemapi.c + * include/hbapi.h + + Added hb_itemSetCMemo() Item API call, to mark a string as MEMO. + ! hb_itemString() made MEMO aware. + ! HB_IS_STRING() made MEMO aware. + + * utils/hbtest/rt_hvm.prg + + A bunch (~100) of number width handling tests added, many of them fail. + + * source/vm/hvm.c + ! hb_vmNegate() fixed handling of number width for doubles + ! hb_vmPushDouble() fixed handling of number widths. + + TOFIX added for hb_vmPushDouble(), because in Clipper the exact width + is extracted from the pcode, the problem is that Harbour doesn't have + this info stored there. + 20000403-02:11 GMT+1 Victor Szakats * contrib/runjava/runjava.c diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 9b65e29611..883916d9ec 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -81,7 +81,7 @@ extern "C" { #define HB_IS_LONG( p ) HB_IS_OF_TYPE( p, HB_IT_LONG ) #define HB_IS_NUMERIC( p ) ( ( p )->type & HB_IT_NUMERIC ) #define HB_IS_OBJECT( p ) HB_IS_OF_TYPE( p, HB_IT_OBJECT ) -#define HB_IS_STRING( p ) HB_IS_OF_TYPE( p, HB_IT_STRING ) +#define HB_IS_STRING( p ) ( ( ( p )->type & ~( HB_IT_BYREF | HB_IT_MEMOFLAG ) ) == HB_IT_STRING ) #define HB_IS_MEMO( p ) HB_IS_OF_TYPE( p, HB_IT_MEMO ) #define HB_IS_SYMBOL( p ) HB_IS_OF_TYPE( p, HB_IT_SYMBOL ) #define HB_IS_MEMVAR( p ) HB_IS_OF_TYPE( p, HB_IT_MEMVAR ) diff --git a/harbour/include/hbapiitm.h b/harbour/include/hbapiitm.h index 5d37690cc7..fc15e147fe 100644 --- a/harbour/include/hbapiitm.h +++ b/harbour/include/hbapiitm.h @@ -80,6 +80,7 @@ extern PHB_ITEM hb_itemParam ( USHORT uiParam ); extern PHB_ITEM hb_itemPutC ( PHB_ITEM pItem, char * szText ); extern PHB_ITEM hb_itemPutCPtr ( PHB_ITEM pItem, char * szText, ULONG ulLen ); extern PHB_ITEM hb_itemPutCL ( PHB_ITEM pItem, char * szText, ULONG ulLen ); +extern void hb_itemSetCMemo ( PHB_ITEM pItem ); extern PHB_ITEM hb_itemPutDS ( PHB_ITEM pItem, char * szDate ); extern PHB_ITEM hb_itemPutDL ( PHB_ITEM pItem, long lJulian ); extern PHB_ITEM hb_itemPutL ( PHB_ITEM pItem, BOOL bValue ); diff --git a/harbour/source/rdd/dbf1.c b/harbour/source/rdd/dbf1.c index 5fa2dd5ecc..8c3d2c9e98 100644 --- a/harbour/source/rdd/dbf1.c +++ b/harbour/source/rdd/dbf1.c @@ -1010,6 +1010,8 @@ static ERRCODE dbfGetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem ) ( ( LPDBFMEMO ) pField->memo )->uiLen ); else hb_itemPutC( pItem, "" ); + + hb_itemSetCMemo( pItem ); break; } return SUCCESS; diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index b55076aecf..25e06334f4 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -1189,7 +1189,8 @@ static void hb_vmNegate( void ) else if( HB_IS_DOUBLE( pItem ) ) { pItem->item.asDouble.value = -pItem->item.asDouble.value; - pItem->item.asDouble.length = ( pItem->item.asDouble.value >= 10000000000.0 || pItem->item.asDouble.value <= -10000000000.0 ) ? 20 : 10; + pItem->item.asDouble.length = ( pItem->item.asDouble.value >= 10000000000.0 + || pItem->item.asDouble.value <= -10000000000.0 ) ? 20 : 10; } else { @@ -2820,11 +2821,25 @@ void hb_vmPushDouble( double dNumber, int iDec ) hb_stack.pPos->type = HB_IT_DOUBLE; hb_stack.pPos->item.asDouble.value = dNumber; - hb_stack.pPos->item.asDouble.length = ( dNumber > 10000000000.0 || dNumber <= -10000000000.0 ) ? 20 : 10; + if( iDec == HB_DEFAULT_DECIMALS ) hb_stack.pPos->item.asDouble.decimal = hb_set.HB_SET_DECIMALS; else hb_stack.pPos->item.asDouble.decimal = iDec; + + if( dNumber >= 1000000000.0 ) + { + /* TOFIX: This is wrong, the actual width should be extracted from the pcode. */ + hb_stack.pPos->item.asDouble.length = 20; + + if( iDec ) + hb_stack.pPos->item.asDouble.length--; + } + else if( dNumber <= -1000000000.0 ) + hb_stack.pPos->item.asDouble.length = 20; + else + hb_stack.pPos->item.asDouble.length = 10; + hb_stackPush(); } diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 0393db49a3..bb246ec0fd 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -54,6 +54,7 @@ * hb_itemPutNDLen() * hb_itemPutNILen() * hb_itemPutNLLen() + * hb_itemSetCMemo() * * Copyright 1999 Eddie Runia * hb_itemStrCmp() @@ -469,6 +470,12 @@ PHB_ITEM hb_itemPutCPtr( PHB_ITEM pItem, char * szText, ULONG ulLen ) return pItem; } +void hb_itemSetCMemo( PHB_ITEM pItem ) +{ + if( pItem && HB_IS_STRING( pItem ) ) + pItem->type |= HB_IT_MEMOFLAG; +} + /* NOTE: The caller should free the pointer if it's not NULL. [vszakats] */ char * hb_itemGetC( PHB_ITEM pItem ) @@ -1288,6 +1295,7 @@ char * hb_itemString( PHB_ITEM pItem, ULONG * ulLen, BOOL * bFreeReq ) switch( pItem->type ) { case HB_IT_STRING: + case HB_IT_MEMO: buffer = hb_itemGetCPtr( pItem ); * ulLen = hb_itemGetCLen( pItem ); * bFreeReq = FALSE; diff --git a/harbour/utils/hbtest/rt_hvm.prg b/harbour/utils/hbtest/rt_hvm.prg index e2d5e063b3..d009f18df7 100644 --- a/harbour/utils/hbtest/rt_hvm.prg +++ b/harbour/utils/hbtest/rt_hvm.prg @@ -947,7 +947,112 @@ FUNCTION Main_HVM() TEST_LINE( Empty( {|x|x+x} ) , .F. ) TEST_LINE( Empty( ErrorNew() ) , .F. ) + /* Some number width handling tests */ + + TEST_LINE( RTSTR( 50000000 ) , " 10 50000000" ) + TEST_LINE( RTSTR( 99999999 ) , " 10 99999999" ) + TEST_LINE( RTSTR( 100000000 ) , " 10 100000000" ) + TEST_LINE( RTSTR( 500000000 ) , " 10 500000000" ) + TEST_LINE( RTSTR( 999999999 ) , " 10 999999999" ) + TEST_LINE( RTSTR( 999999999.99 ) , " 13 999999999.99" ) + TEST_LINE( RTSTR( 1000000000 ) , " 11 1000000000" ) + TEST_LINE( RTSTR( 1000000000.0 ) , " 12 1000000000.0" ) + TEST_LINE( RTSTR( 1000000000.00 ) , " 13 1000000000.00" ) + TEST_LINE( RTSTR( 1000000000.99 ) , " 13 1000000000.99" ) + TEST_LINE( RTSTR( 4000000000 ) , " 11 4000000000" ) + TEST_LINE( RTSTR( 5000000000 ) , " 11 5000000000" ) + TEST_LINE( RTSTR( 50000000000 ) , " 12 50000000000" ) + TEST_LINE( RTSTR( 500000000000 ) , " 13 500000000000" ) + TEST_LINE( RTSTR( 5000000000000 ) , " 14 5000000000000" ) + TEST_LINE( RTSTR( 50000000000000 ) , " 15 50000000000000" ) + TEST_LINE( RTSTR( 500000000000000 ) , " 16 500000000000000" ) + TEST_LINE( RTSTR( 5000000000000000 ) , " 17 5000000000000000" ) + TEST_LINE( RTSTR( 50000000000000000 ) , " 18 50000000000000000" ) + TEST_LINE( RTSTR( 500000000000000000 ) , " 19 500000000000000000" ) + TEST_LINE( RTSTR( 5000000000000000000 ) , " 20 5000000000000000000" ) + TEST_LINE( RTSTR( 50000000000000000000 ) , " 21 50000000000000000000" ) + TEST_LINE( RTSTR( 500000000000000000000 ) , " 22 500000000000000000000" ) + TEST_LINE( RTSTR( 5000000000000000000000 ) , " 23 5000000000000000000000" ) + TEST_LINE( RTSTR( 50000000000000000000000 ) , " 24 50000000000000000000000" ) + TEST_LINE( RTSTR( 500000000000000000000000 ) , " 25 500000000000000000000000" ) + TEST_LINE( RTSTR( 5000000000000000000000000 ) , " 26 5000000000000000000000000" ) + TEST_LINE( RTSTR( 5000000000000000000000000.0 ) , " 27 5000000000000000000000000.0" ) + TEST_LINE( RTSTR( -50000000 ) , " 10 -50000000" ) + TEST_LINE( RTSTR( -500000000 ) , " 10 -500000000" ) + TEST_LINE( RTSTR( -999999999 ) , " 10 -999999999" ) + TEST_LINE( RTSTR( -1000000000 ) , " 20 -1000000000" ) + TEST_LINE( RTSTR( -4000000000 ) , " 20 -4000000000" ) + TEST_LINE( RTSTR( -5000000000 ) , " 20 -5000000000" ) + TEST_LINE( RTSTR( -50000000000 ) , " 20 -50000000000" ) + TEST_LINE( RTSTR( -500000000000 ) , " 20 -500000000000" ) + TEST_LINE( RTSTR( -5000000000000 ) , " 20 -5000000000000" ) + TEST_LINE( RTSTR( -50000000000000 ) , " 20 -50000000000000" ) + TEST_LINE( RTSTR( -500000000000000 ) , " 20 -500000000000000" ) + TEST_LINE( RTSTR( -5000000000000000 ) , " 20 -5000000000000000" ) + TEST_LINE( RTSTR( -50000000000000000 ) , " 20 -50000000000000000" ) + TEST_LINE( RTSTR( -500000000000000000 ) , " 20 -500000000000000000" ) + TEST_LINE( RTSTR( -5000000000000000000 ) , " 20 -5000000000000000000" ) + TEST_LINE( RTSTR( -50000000000000000000 ) , " 20 ********************" ) + TEST_LINE( RTSTR( -500000000000000000000 ) , " 20 ********************" ) + TEST_LINE( RTSTR( -5000000000000000000000 ) , " 20 ********************" ) + TEST_LINE( RTSTR( -50000000000000000000000 ) , " 20 ********************" ) + TEST_LINE( RTSTR( -500000000000000000000000 ) , " 20 ********************" ) + TEST_LINE( RTSTR( -5000000000000000000000000 ) , " 20 ********************" ) + + TEST_LINE( RTSTR(-( 50000000 )) , " 10 -50000000" ) + TEST_LINE( RTSTR(-( 99999999 )) , " 10 -99999999" ) + TEST_LINE( RTSTR(-( 100000000 )) , " 10 -100000000" ) + TEST_LINE( RTSTR(-( 500000000 )) , " 10 -500000000" ) + TEST_LINE( RTSTR(-( 999999999 )) , " 10 -999999999" ) + TEST_LINE( RTSTR(-( 999999999.99 )) , " 23 -999999999.99" ) + TEST_LINE( RTSTR(-( 1000000000 )) , " 20 -1000000000" ) + TEST_LINE( RTSTR(-( 1000000000.0 )) , " 22 -1000000000.0" ) + TEST_LINE( RTSTR(-( 1000000000.00 )) , " 23 -1000000000.00" ) + TEST_LINE( RTSTR(-( 1000000000.99 )) , " 23 -1000000000.99" ) + TEST_LINE( RTSTR(-( 4000000000 )) , " 20 -4000000000" ) + TEST_LINE( RTSTR(-( 5000000000 )) , " 20 -5000000000" ) + TEST_LINE( RTSTR(-( 50000000000 )) , " 20 -50000000000" ) + TEST_LINE( RTSTR(-( 500000000000 )) , " 20 -500000000000" ) + TEST_LINE( RTSTR(-( 5000000000000 )) , " 20 -5000000000000" ) + TEST_LINE( RTSTR(-( 50000000000000 )) , " 20 -50000000000000" ) + TEST_LINE( RTSTR(-( 500000000000000 )) , " 20 -500000000000000" ) + TEST_LINE( RTSTR(-( 5000000000000000 )) , " 20 -5000000000000000" ) + TEST_LINE( RTSTR(-( 50000000000000000 )) , " 20 -50000000000000000" ) + TEST_LINE( RTSTR(-( 500000000000000000 )) , " 20 -500000000000000000" ) + TEST_LINE( RTSTR(-( 5000000000000000000 )) , " 20 -5000000000000000000" ) + TEST_LINE( RTSTR(-( 50000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( 500000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( 5000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( 50000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( 500000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( 5000000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( 5000000000000000000000000.0 )) , " 22 **********************" ) + TEST_LINE( RTSTR(-( -50000000 )) , " 10 50000000" ) + TEST_LINE( RTSTR(-( -500000000 )) , " 10 500000000" ) + TEST_LINE( RTSTR(-( -999999999 )) , " 10 999999999" ) + TEST_LINE( RTSTR(-( -1000000000 )) , " 10 1000000000" ) + TEST_LINE( RTSTR(-( -4000000000 )) , " 10 4000000000" ) + TEST_LINE( RTSTR(-( -5000000000 )) , " 10 5000000000" ) + TEST_LINE( RTSTR(-( -50000000000 )) , " 20 50000000000" ) + TEST_LINE( RTSTR(-( -500000000000 )) , " 20 500000000000" ) + TEST_LINE( RTSTR(-( -5000000000000 )) , " 20 5000000000000" ) + TEST_LINE( RTSTR(-( -50000000000000 )) , " 20 50000000000000" ) + TEST_LINE( RTSTR(-( -500000000000000 )) , " 20 500000000000000" ) + TEST_LINE( RTSTR(-( -5000000000000000 )) , " 20 5000000000000000" ) + TEST_LINE( RTSTR(-( -50000000000000000 )) , " 20 50000000000000000" ) + TEST_LINE( RTSTR(-( -500000000000000000 )) , " 20 500000000000000000" ) + TEST_LINE( RTSTR(-( -5000000000000000000 )) , " 20 5000000000000000000" ) + TEST_LINE( RTSTR(-( -50000000000000000000 )) , " 20 50000000000000000000" ) + TEST_LINE( RTSTR(-( -500000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( -5000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( -50000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( -500000000000000000000000 )) , " 20 ********************" ) + TEST_LINE( RTSTR(-( -5000000000000000000000000 )) , " 20 ********************" ) + RETURN NIL +FUNCTION RTSTR( nValue ) + RETURN Str( Len( Str( nValue ) ), 3 ) + " " + Str( nValue ) + /* Don't change the position of this #include. */ #include "rt_init.ch"