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

20000403-04:47 GMT+1 Victor Szakats <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
2000-04-03 02:45:48 +00:00
parent 83c6681014
commit 0279d0eb0e
7 changed files with 156 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
harbour/ChangeLog
View File

@@ -1,3 +1,25 @@
20000403-04:47 GMT+1 Victor Szakats <info@szelvesz.hu>
* 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 <info@szelvesz.hu>
* contrib/runjava/runjava.c

2
harbour/include/hbapi.h
View File

@@ -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 )

1
harbour/include/hbapiitm.h
View File

@@ -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 );

2
harbour/source/rdd/dbf1.c
View File

@@ -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;

19
harbour/source/vm/hvm.c
View File

@@ -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();
}

8
harbour/source/vm/itemapi.c
View File

@@ -54,6 +54,7 @@
* hb_itemPutNDLen()
* hb_itemPutNILen()
* hb_itemPutNLLen()
* hb_itemSetCMemo()
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* 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;

105
harbour/utils/hbtest/rt_hvm.prg
View File

@@ -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"