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

19990907-17:00 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-07 15:18:27 +00:00
parent 4fff28aae7
commit 35cb4e4d1b
16 changed files with 1081 additions and 706 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
harbour/ChangeLog
View File

@@ -1,3 +1,76 @@
19990907-17:00 GMT+1 Victor Szel <info@szelvesz.hu>
* source/vm/hvm.c
! hb_vmEqual() is now Clipper compatible for ARRAY and BLOCK types.
! hb_vmMinus() is now generating the result as LONG (instead of DOUBLE)
when the two operands are DATEs.
! hb_vmDivide() fixed the decimal handling for integer operands with an
integer result.
! hb_vmNegate() now handles the number width in a Clipper compatible way.
! hb_vmEqual(), hb_vmNotEqual(), hb_vmLess*(), hb_vmGreater*(), hb_vmDo(),
hb_arrayAt() error handling now support value substitution.
hb_vmDo() and hb_vmArrayAt() should be tested, since I'm not exactly sure
if they are correctly pushing the result.
* source/rtl/strings.c
! VAL() fixed to return INTEGER/LONG if applicable, not always a DOUBLE.
Similar logic can be found in hb_vmPushNumber().
+ REPLICATE() STROVERFLOW error now supports value substitution.
* hb_itemPadConv() now uses less internal, type checks reordered with the
most probable moved to the top. Some Extend API calls changed to Item API
ones, to make it faster.
! hb_itemPadConv() was casting back DOUBLE value without decimals to LONG
to convert it to string. Corrected. There may be other places where
DOUBLE is converted to LONG, these should be revised, since a DOUBLE is
also used when there are *no* decimal places, but the value is too big
to fit in a LONG (like: 5000000000), for example INT() is buggy because
of that right now.
* tests/working/rtl_test.prg
+ Some new decimal handling and ABS() tests added.
+ Some divide and date subtracion tests added to decimal handling section.
+ Some negate tests added to the decimal handling section.
+ INT() tests added.
* LOCAL test values converted to STATIC, PRIVATE test values converted
to PUBLIC.
* Split the tests into smaller functions, since the 64K function limit
has been reached.
! Expected results changed where we consider Clipper to be buggy, mainly
for cases when the parameters is passed by reference.
+ SQRT() tests added.
* source/rdd/dbf1.c
! Fixed the passed parameters to hb_itemPutNDLen()
* tests/working/testdbf.prg
+ Numeric value put/get tests added.
* source/rtl/itemapi.c
! hb_itemType() now checks for NULL parameters, like in Clipper.
! hb_itemPutNDLen() was handling the wDec parameter in a wrong way by
mistake. I assumed that the wDec value means the decimal places within
the full length, but that was wrong.
! hb_itemStrCmp() two LONGs changed to ULONG.
* source/rtl/math.c
% MOD() one Extend API call changed to Item API to make it faster.
+ MIN()/MAX() now uses Item API instead of accessing internals.
+ ABS() uses Item API instead of internals.
! ABS() now keeps the width of the positive integers.
! hb_numRound() now uses a much larger buffer (like in hb_itemStr()), this
seem to have fixed the random GPFs in Cygwin when running RTL_TEST.
Same type of dangerous code can be found in RDD/DBF1.C, too. (Bruno!)
+ ABS(), INT(), ROUND(), EXP(), LOG(), SQRT(), MIN(), MAX() value
substitution added.
* source/rtl/descend.c
* Now using Item API only, internals totally eliminated. Simpler code,
some variables eliminated, some small optimalizations.
* source/rtl/do.c
* Value substitution added to EVAL(), DO()
* source/rtl/classes.c
* Value substitution added to :EVAL
* tests/working/descend.prg
tests/working/Makefile
- Removed since an automated version is already included in RTL_TEST.
* source/rtl/classes.c
source/rtl/arrays.c
+ Copyright info added.
* source/rtl/set.c
! Some minor formatting corrections.
19990907-02:30 GMT+1 Victor Szel <info@szelvesz.hu>
* include/external.ch
source/runner/stdalone/external.prg

2
harbour/include/extend.h
View File

@@ -311,7 +311,7 @@ extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray );
#define HB_STRGREATER_RIGHT 2
extern int hb_stricmp( const char * s1, const char * s2 );
extern int hb_strgreater( char * sz1, char * sz2 );
extern int hb_strgreater( char * szText1, char * szText2 );
extern void hb_strupr( char * szText );
extern BOOL hb_strMatchRegExp( char * szString, char * szMask );
extern BOOL hb_strEmpty( char * szText, ULONG ulLen );

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

@@ -815,7 +815,7 @@ static ERRCODE GetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
szEndChar = * ( szText + pField->uiLen );
* ( szText + pField->uiLen ) = '\0';
if( pField->uiDec )
hb_itemPutNDLen( pItem, atof( ( char * ) szText ), ( WORD ) pField->uiLen, ( WORD ) pField->uiDec );
hb_itemPutNDLen( pItem, atof( ( char * ) szText ), ( WORD ) pField->uiLen - ( ( WORD ) pField->uiDec + 1 ), ( WORD ) pField->uiDec );
else
hb_itemPutNLLen( pItem, atol( ( char * ) szText ), ( WORD ) pField->uiLen );
* ( szText + pField->uiLen ) = szEndChar;

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

@@ -27,6 +27,8 @@
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_arrayIsObject()
hb_arrayError()
hb_arrayCopyC()
hb_arrayGetC()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/

17
harbour/source/rtl/classes.c
View File

@@ -41,6 +41,13 @@
* __objSendMsg()
*/
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb___msgEval()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#include "extend.h"
#include "errorapi.h"
#include "itemapi.h"
@@ -922,7 +929,15 @@ static HARBOUR hb___msgEval( void )
hb_vmDo( hb_pcount() ); /* Self is also an argument */
}
else
hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, "EVAL" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

27
harbour/source/rtl/descend.c
View File

@@ -84,30 +84,17 @@ HARBOUR HB_DESCEND( void )
{
if( IS_STRING( pItem ) )
{
char * szBuffer = ( char * ) hb_xgrab( pItem->item.asString.length );
hb_strDescend( szBuffer, pItem->item.asString.value, pItem->item.asString.length );
hb_retclen( szBuffer, pItem->item.asString.length );
ULONG ulLen = hb_itemGetCLen( pItem );
char * szBuffer = ( char * ) hb_xgrab( ulLen );
hb_strDescend( szBuffer, hb_itemGetCPtr( pItem ), ulLen );
hb_retclen( szBuffer, ulLen );
hb_xfree( szBuffer );
}
else if( IS_DATE( pItem ) )
hb_retnl( 5231808 - pItem->item.asDate.value );
hb_retnl( 5231808 - hb_itemGetNL( pItem ) );
else if( IS_NUMERIC( pItem ) )
{
PHB_ITEM pReturn;
double dValue;
if( IS_DOUBLE( pItem ) )
dValue = pItem->item.asDouble.value;
else if( IS_INTEGER( pItem ) )
dValue = ( double ) pItem->item.asInteger.value;
else if( IS_LONG( pItem ) )
dValue = ( double ) pItem->item.asLong.value;
pReturn = hb_itemPutND( NULL, -1 * dValue );
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
}
hb_retnd( -1 * hb_itemGetND( pItem ) );
else if( IS_LOGICAL( pItem ) )
hb_retl( ! pItem->item.asLogical.value );
hb_retl( ! hb_itemGetL( pItem ) );
}
}

20
harbour/source/rtl/do.c
View File

@@ -128,7 +128,15 @@ HARBOUR HB_DO( void )
hb_vmDo( uiPCount - 1 );
}
else
hb_errRT_BASE( EG_ARG, 3012, NULL, "DO" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 3012, NULL, "DO" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "DO" );
@@ -153,7 +161,15 @@ HARBOUR HB_EVAL( void )
hb_vmDo( uiPCount - 1 );
}
else
hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, "EVAL" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EVAL" ); /* NOTE: Clipper catches this at compile time! */

42
harbour/source/rtl/itemapi.c
View File

@@ -605,7 +605,7 @@ PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, WORD wWidth, WORD wDec
if( wWidth == 0 || wWidth > 99 )
wWidth = ( dNumber > 10000000000.0 ) ? 20 : 10;
if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) )
if( wDecimal == ( ( WORD ) -1 ) )
wDecimal = hb_set.HB_SET_DECIMALS;
pItem->type = IT_DOUBLE;
@@ -674,7 +674,6 @@ void hb_itemGetNLen( PHB_ITEM pItem, WORD * pwWidth, WORD * pwDecimal )
default:
if( pwWidth ) *pwWidth = 0;
if( pwDecimal ) *pwDecimal = 0;
break;
}
}
}
@@ -698,7 +697,10 @@ ULONG hb_itemSize( PHB_ITEM pItem )
WORD hb_itemType( PHB_ITEM pItem )
{
return pItem->type;
if( pItem )
return pItem->type;
else
return IT_NIL;
}
/* Internal API, not standard Clipper */
@@ -801,28 +803,28 @@ PHB_ITEM hb_itemUnRef( PHB_ITEM pItem )
/* Check whether two strings are equal (0), smaller (-1), or greater (1) */
int hb_itemStrCmp( PHB_ITEM pFirst, PHB_ITEM pSecond, BOOL bForceExact )
{
char * szFirst = pFirst->item.asString.value;
char * szSecond = pSecond->item.asString.value;
ULONG lLenFirst = pFirst->item.asString.length;
ULONG lLenSecond = pSecond->item.asString.length;
LONG lMinLen;
LONG lCounter;
char * szFirst = pFirst->item.asString.value;
char * szSecond = pSecond->item.asString.value;
ULONG ulLenFirst = pFirst->item.asString.length;
ULONG ulLenSecond = pSecond->item.asString.length;
ULONG ulMinLen;
ULONG ulCounter;
int iRet = 0; /* Current status */
if( hb_set.HB_SET_EXACT && !bForceExact )
{
/* SET EXACT ON and not using == */
/* Don't include trailing spaces */
while( lLenFirst > 0 && szFirst[ lLenFirst - 1 ] == ' ' ) lLenFirst--;
while( lLenSecond > 0 && szSecond[ lLenSecond - 1 ] == ' ' ) lLenSecond--;
while( ulLenFirst > 0 && szFirst[ ulLenFirst - 1 ] == ' ' ) ulLenFirst--;
while( ulLenSecond > 0 && szSecond[ ulLenSecond - 1 ] == ' ' ) ulLenSecond--;
}
lMinLen = lLenFirst < lLenSecond ? lLenFirst : lLenSecond;
ulMinLen = ulLenFirst < ulLenSecond ? ulLenFirst : ulLenSecond;
/* One of the strings is empty */
if( lMinLen )
if( ulMinLen )
{
for( lCounter = 0; lCounter < lMinLen && !iRet; lCounter++ )
for( ulCounter = 0; ulCounter < ulMinLen && !iRet; ulCounter++ )
{
/* Difference found */
if( *szFirst != *szSecond )
@@ -833,23 +835,23 @@ int hb_itemStrCmp( PHB_ITEM pFirst, PHB_ITEM pSecond, BOOL bForceExact )
szSecond++;
}
}
if( hb_set.HB_SET_EXACT || bForceExact || lLenSecond > lCounter )
if( hb_set.HB_SET_EXACT || bForceExact || ulLenSecond > ulCounter )
{
/* Force an exact comparison */
if( !iRet && lLenFirst != lLenSecond )
if( !iRet && ulLenFirst != ulLenSecond )
/* If length is different ! */
iRet = ( lLenFirst < lLenSecond ) ? -1 : 1;
iRet = ( ulLenFirst < ulLenSecond ) ? -1 : 1;
}
}
else
{
/* Both empty ? */
if( lLenFirst != lLenSecond )
if( ulLenFirst != ulLenSecond )
{
if( hb_set.HB_SET_EXACT || bForceExact )
iRet = ( lLenFirst < lLenSecond ) ? -1 : 1;
iRet = ( ulLenFirst < ulLenSecond ) ? -1 : 1;
else
iRet = ( lLenSecond == 0 ) ? 0 : -1;
iRet = ( ulLenSecond == 0 ) ? 0 : -1;
}
else
/* Both empty => Equal ! */

202
harbour/source/rtl/math.c
View File

@@ -10,7 +10,6 @@
#include <math.h>
#include "extend.h"
#include "set.h"
#include "itemapi.h"
#include "errorapi.h"
@@ -20,30 +19,48 @@ HARBOUR HB_ABS( void )
{
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber ) switch( pNumber->type )
if( pNumber )
{
case IT_INTEGER:
if( pNumber->item.asInteger.value >= 0 )
hb_retni( pNumber->item.asInteger.value );
else
hb_retni( -pNumber->item.asInteger.value );
break;
WORD wWidth;
WORD wDec;
case IT_LONG:
if( pNumber->item.asLong.value >= 0 )
hb_retnl( pNumber->item.asLong.value );
else
hb_retnl( -pNumber->item.asLong.value );
break;
hb_itemGetNLen( pNumber, &wWidth, &wDec );
case IT_DOUBLE:
if( pNumber->item.asDouble.value >= 0.0 )
hb_retndlen( pNumber->item.asDouble.value, 0, pNumber->item.asDouble.decimal );
if( IS_INTEGER( pNumber ) )
{
int iNumber = hb_itemGetNI( pNumber );
if( iNumber >= 0 )
hb_retnilen( iNumber, wWidth );
else
hb_retndlen( -pNumber->item.asDouble.value, 0, pNumber->item.asDouble.decimal );
hb_retni( -iNumber );
}
else if( IS_LONG( pNumber ) )
{
long lNumber = hb_itemGetNL( pNumber );
if( lNumber >= 0 )
hb_retnllen( lNumber, wWidth );
else
hb_retnl( -lNumber );
}
else if( IS_DOUBLE( pNumber ) )
{
double dNumber = hb_itemGetND( pNumber );
hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, wDec );
}
}
else
hb_errRT_BASE( EG_ARG, 1089, NULL, "ABS" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ABS" ); /* NOTE: Clipper catches this at compile time! */
@@ -56,7 +73,15 @@ HARBOUR HB_EXP( void )
if( ISNUM( 1 ) )
hb_retnd( exp( hb_parnd( 1 ) ) );
else
hb_errRT_BASE( EG_ARG, 1096, NULL, "EXP" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1096, NULL, "EXP" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "EXP" ); /* NOTE: Clipper catches this at compile time! */
@@ -66,10 +91,26 @@ HARBOUR HB_INT( void )
{
if( hb_pcount() == 1 )
{
if( ISNUM( 1 ) )
hb_retnl( hb_parnd( 1 ) );
PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC );
if( pNumber )
{
WORD wWidth;
hb_itemGetNLen( pNumber, &wWidth, NULL );
hb_retndlen( ( long ) hb_parnd( 1 ), wWidth, 0 );
}
else
hb_errRT_BASE( EG_ARG, 1090, NULL, "INT" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "INT" ); /* NOTE: Clipper catches this at compile time! */
@@ -90,7 +131,15 @@ HARBOUR HB_LOG( void )
hb_retnd( log( dNumber ) );
}
else
hb_errRT_BASE( EG_ARG, 1095, NULL, "LOG" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1095, NULL, "LOG" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LOG" ); /* NOTE: Clipper catches this at compile time! */
@@ -106,16 +155,13 @@ HARBOUR HB_MAX( void )
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
WORD wType1 = p1->type;
WORD wType2 = p1->type;
/* NOTE: The order of these if() branches is significant, */
/* Don't change it */
/* Please, don't change it. */
if( wType1 == IT_DOUBLE || wType2 == IT_DOUBLE )
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_parnd( 1 );
double d2 = hb_parnd( 2 );
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
WORD wDec1;
WORD wDec2;
@@ -125,30 +171,34 @@ HARBOUR HB_MAX( void )
hb_retndlen( d1 >= d2 ? d1 : d2, 0, ( d1 >= d2 ? wDec1 : wDec2 ) );
}
else if( wType1 == IT_LONG || wType2 == IT_LONG )
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_parnl( 1 );
long l2 = hb_parnl( 2 );
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 >= l2 ? l1 : l2 );
}
else
{
int i1 = hb_parni( 1 );
int i2 = hb_parni( 2 );
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 >= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
long l1 = p1->item.asDate.value;
long l2 = p2->item.asDate.value;
hb_retds( hb_itemGetNL( p1 ) >= hb_itemGetNL( p2 ) ? hb_pards( 1 ) : hb_pards( 2 ) );
hb_retds( l1 >= l2 ? hb_pards( 1 ) : hb_pards( 2 ) );
}
else
hb_errRT_BASE( EG_ARG, 1093, NULL, "MAX" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MAX" ); /* NOTE: Clipper catches this at compile time! */
@@ -164,16 +214,13 @@ HARBOUR HB_MIN( void )
if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) )
{
WORD wType1 = p1->type;
WORD wType2 = p1->type;
/* NOTE: The order of these if() branches is significant, */
/* Don't change it */
/* Please, don't change it. */
if( wType1 == IT_DOUBLE || wType2 == IT_DOUBLE )
if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) )
{
double d1 = hb_parnd( 1 );
double d2 = hb_parnd( 2 );
double d1 = hb_itemGetND( p1 );
double d2 = hb_itemGetND( p2 );
WORD wDec1;
WORD wDec2;
@@ -183,30 +230,34 @@ HARBOUR HB_MIN( void )
hb_retndlen( d1 <= d2 ? d1 : d2, 0, ( d1 <= d2 ? wDec1 : wDec2 ) );
}
else if( wType1 == IT_LONG || wType2 == IT_LONG )
else if( IS_LONG( p1 ) || IS_LONG( p2 ) )
{
long l1 = hb_parnl( 1 );
long l2 = hb_parnl( 2 );
long l1 = hb_itemGetNL( p1 );
long l2 = hb_itemGetNL( p2 );
hb_retnl( l1 <= l2 ? l1 : l2 );
}
else
{
int i1 = hb_parni( 1 );
int i2 = hb_parni( 2 );
int i1 = hb_itemGetNI( p1 );
int i2 = hb_itemGetNI( p2 );
hb_retni( i1 <= i2 ? i1 : i2 );
}
}
else if( IS_DATE( p1 ) && IS_DATE( p2 ) )
{
long l1 = p1->item.asDate.value;
long l2 = p2->item.asDate.value;
hb_retds( hb_itemGetNL( p1 ) <= hb_itemGetNL( p2 ) ? hb_pards( 1 ) : hb_pards( 2 ) );
hb_retds( l1 <= l2 ? hb_pards( 1 ) : hb_pards( 2 ) );
}
else
hb_errRT_BASE( EG_ARG, 1092, NULL, "MIN" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "MIN" ); /* NOTE: Clipper catches this at compile time! */
@@ -232,7 +283,7 @@ FUNCTION MOD(cl_num, cl_base)
if( pNumber && ISNUM( 2 ) )
{
double dNumber = hb_parnd( 1 );
double dNumber = hb_itemGetND( pNumber );
double dBase = hb_parnd( 2 ); /* dBase! Cool! */
if( dBase )
@@ -257,6 +308,9 @@ FUNCTION MOD(cl_num, cl_base)
hb_errRT_BASE( EG_ARG, 1085, NULL, "%" );
}
/* DJGPP can sprintf a float that is almost 320 digits long */
#define HB_MAX_DOUBLE_LENGTH 320
double hb_numRound( double dResult, int iDec )
{
int iSize = 64;
@@ -284,7 +338,11 @@ double hb_numRound( double dResult, int iDec )
}
}
szResult = ( char * ) hb_xgrab( iSize + iDec + 1 );
/* Be paranoid and use a large amount of padding */
/* NOTE: In Cygwin allocating a buffer with the size: iSize + iDec + 1
often caused random GPFs. I'm not exactly sure about this, but
it seems that enlarging the buffer seemed to solve to problem. */
szResult = ( char * ) hb_xgrab( HB_MAX_DOUBLE_LENGTH );
if( szResult )
{
@@ -307,7 +365,15 @@ HARBOUR HB_ROUND( void )
hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, iDec );
}
else
hb_errRT_BASE( EG_ARG, 1094, NULL, "ROUND" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "ROUND" ); /* NOTE: Clipper catches this at compile time! */
@@ -327,7 +393,15 @@ HARBOUR HB_SQRT( void )
hb_retnd( 0 ); /* Clipper doesn't error! */
}
else
hb_errRT_BASE( EG_ARG, 1097, NULL, "SQRT" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1097, NULL, "SQRT" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "SQRT" ); /* NOTE: Clipper catches this at compile time! */

12
harbour/source/rtl/set.c
View File

@@ -250,7 +250,7 @@ static void close_text( FHANDLE handle )
user file error value */
int user_ferror = hb_fsError();
#if ! defined(OS_UNIX_COMPATIBLE)
hb_fsWrite( handle, (BYTE *)"\x1A", 1 );
hb_fsWrite( handle, ( BYTE * ) "\x1A", 1 );
#endif
hb_fsClose( handle );
hb_fsSetError( user_ferror );
@@ -289,10 +289,10 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s
if( bAppend )
{ /* Append mode */
if( hb_fsFile( (BYTE *)path ) )
if( hb_fsFile( ( BYTE * ) path ) )
{ /* If the file already exists, open it (in read-write mode, in
case of non-Unix and text modes). */
handle = hb_fsOpen( (BYTE *)path, FO_READWRITE | FO_DENYWRITE );
handle = hb_fsOpen( ( BYTE * ) path, FO_READWRITE | FO_DENYWRITE );
if( handle != FS_ERROR )
{ /* Position to EOF */
#if ! defined(HB_OS_UNIX_COMPATIBLE)
@@ -308,11 +308,11 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s
('\x1A') character at the end (non-UNIX only). */
char cEOF = '\0';
hb_fsSeek( handle, -1, FS_END ); /* Position to last char. */
hb_fsRead( handle, (BYTE *)&cEOF, 1 ); /* Read the last char. */
hb_fsRead( handle, ( BYTE * ) &cEOF, 1 ); /* Read the last char. */
if( cEOF == '\x1A' ) /* If it's an EOF, */
hb_fsSeek( handle, -1, FS_END ); /* Then write over it. */
}
#endif
#endif
}
}
else bCreate = TRUE; /* Otherwise create a new file. */
@@ -320,7 +320,7 @@ static FHANDLE open_handle( char * file_name, BOOL bAppend, char * def_ext, HB_s
else bCreate = TRUE; /* Always create a new file for overwrite mode. */
if( bCreate )
handle = hb_fsCreate( (BYTE *)path, FC_NORMAL );
handle = hb_fsCreate( ( BYTE * ) path, FC_NORMAL );
if( handle == FS_ERROR )
{

101
harbour/source/rtl/strings.c
View File

@@ -324,41 +324,43 @@ HARBOUR HB_ALLTRIM( void )
convert to unpadded string. Return pointer to string and set string length */
static char * hb_itemPadConv( PHB_ITEM pItem, char * buffer, ULONG * pulSize )
{
char * szText = NULL;
char * szText;
if( pItem ) switch( pItem->type )
if( pItem )
{
case IT_DATE:
if( IS_STRING( pItem ) )
{
szText = hb_itemGetCPtr( pItem );
*pulSize = hb_itemGetCLen( pItem );
}
else if( IS_DATE( pItem ) )
{
szText = hb_dtoc( hb_pards( 1 ), buffer, hb_set.HB_SET_DATEFORMAT );
*pulSize = strlen( szText );
break;
case IT_INTEGER:
sprintf( buffer, "%d", hb_parni( 1 ) );
}
else if( IS_INTEGER( pItem ) )
{
sprintf( buffer, "%d", hb_itemGetNI( pItem ) );
szText = buffer;
*pulSize = strlen( szText );
break;
case IT_LONG:
sprintf( buffer, "%ld", hb_parnl( 1 ) );
}
else if( IS_LONG( pItem ) )
{
sprintf( buffer, "%ld", hb_itemGetNL( pItem ) );
szText = buffer;
*pulSize = strlen( szText );
break;
case IT_DOUBLE:
if( pItem->item.asDouble.decimal )
sprintf( buffer, "%.*f", pItem->item.asDouble.decimal, hb_parnd( 1 ) );
else
sprintf( buffer, "%ld", hb_parnl( 1 ) );
}
else if( IS_DOUBLE( pItem ) )
{
sprintf( buffer, "%.*f", pItem->item.asDouble.decimal, hb_itemGetND( pItem ) );
szText = buffer;
*pulSize = strlen( szText );
break;
case IT_STRING:
szText = hb_parc( 1 );
*pulSize = hb_parclen( 1 );
break;
}
else
szText = NULL;
}
else
szText = NULL;
return szText;
}
@@ -822,7 +824,15 @@ HARBOUR HB_REPLICATE( void )
hb_xfree( szResult );
}
else
hb_errRT_BASE( EG_STROVERFLOW, 1234, NULL, "REPLICATE" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else
hb_retc( "" );
@@ -1062,18 +1072,33 @@ HARBOUR HB_VAL( void )
if( pText )
{
int nWidth, nDec = 0;
int iWidth;
int iDec;
double dNumber = hb_strVal( pText->item.asString.value );
char * ptr = strchr( pText->item.asString.value, '.' );
if( ptr )
{
nWidth = ptr - pText->item.asString.value;
nDec = strlen( ptr + 1 );
iWidth = ptr - pText->item.asString.value;
iDec = strlen( ptr + 1 );
}
else
nWidth = strlen( pText->item.asString.value );
{
iWidth = strlen( pText->item.asString.value );
iDec = 0;
}
hb_retndlen( hb_strVal( pText->item.asString.value ), nWidth, nDec );
if( iDec )
hb_retndlen( dNumber, iWidth, iDec );
else if( SHRT_MIN <= dNumber && dNumber <= SHRT_MAX )
hb_retnilen( ( int ) dNumber, iWidth );
else if( LONG_MIN <= dNumber && dNumber <= LONG_MAX )
hb_retnllen( ( long ) dNumber, iWidth );
else
hb_retndlen( dNumber, iWidth, ( WORD ) -1 );
}
else
hb_errRT_BASE( EG_ARG, 1098, NULL, "VAL" );
@@ -1460,19 +1485,19 @@ HARBOUR HB_STRZERO( void )
/* Values returned : HB_STRGREATER_EQUAL, HB_STRGREATER_LEFT, HB_STRGREATER_RIGHT */
int hb_strgreater( char * sz1, char * sz2 )
int hb_strgreater( char * szText1, char * szText2 )
{
while( *( sz1 ) && *( sz2 ) && *( sz1 ) == *( sz2 ) )
while( *( szText1 ) && *( szText2 ) && *( szText1 ) == *( szText2 ) )
{
sz1++;
sz2++;
szText1++;
szText2++;
}
if( ( *( sz1 ) == 0 && *( sz2 ) != 0 ) ||
( *( sz2 ) > *( sz1 ) ) )
if( ( *( szText1 ) == '\0' && *( szText2 ) != '\0' ) ||
( *( szText2 ) > *( szText1 ) ) )
return HB_STRGREATER_RIGHT;
if( ( *( sz1 ) != 0 && *( sz2 ) == 0 ) ||
( *( sz1 ) > *( sz2 ) ) )
if( ( *( szText1 ) != '\0' && *( szText2 ) == '\0' ) ||
( *( szText1 ) > *( szText2 ) ) )
return HB_STRGREATER_LEFT;
return HB_STRGREATER_EQUAL;

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

@@ -205,7 +205,8 @@ void hb_vmQuit( void )
void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
{
BYTE bCode;
WORD w = 0, wParams;
WORD w = 0;
WORD wParams;
BOOL bCanRecover = FALSE;
ULONG ulPrivateBase = hb_memvarGetPrivatesBase();
@@ -421,7 +422,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
case HB_P_PARAMETER:
wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
hb_vmPopParameter( pSymbols + wParams, pCode[ w+3 ] );
hb_vmPopParameter( pSymbols + wParams, pCode[ w + 3 ] );
w += 4;
break;
@@ -788,7 +789,16 @@ void hb_vmArrayAt( void )
else
{
hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) );
if( pResult )
{
hb_stackPop();
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
return;
}
@@ -916,6 +926,7 @@ void hb_vmDivide( void )
{
if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) )
{
BOOL bIntegerOperands = !IS_DOUBLE( stack.pPos - 1 ) && !IS_DOUBLE( stack.pPos - 2 );
WORD wDec1, wDec2;
double d2 = hb_vmPopDouble( &wDec2 );
double d1 = hb_vmPopDouble( &wDec1 );
@@ -931,7 +942,14 @@ void hb_vmDivide( void )
}
}
else
hb_vmPushNumber( d1 / d2, hb_set.HB_SET_DECIMALS );
{
/* If all both operand was integer and the result is an integer, too,
push the number without decimals. Clipper compatible. */
if( bIntegerOperands && fmod( d1, d2 ) == 0.0 )
hb_vmPushNumber( d1 / d2, 0 );
else
hb_vmPushNumber( d1 / d2, hb_set.HB_SET_DECIMALS );
}
}
else
{
@@ -994,10 +1012,18 @@ void hb_vmDo( WORD wParams )
pFunc();
else
{
PHB_ITEM pResult;
if( pSym->szName[ 0 ] == '_' )
hb_errRT_BASE( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1 );
pResult = hb_errRT_BASE_Subst( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1 );
else
hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, pSym->szName );
pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, pSym->szName );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
else /* it is a function */
@@ -1119,12 +1145,32 @@ void hb_vmEqual( BOOL bExact )
hb_stackPop();
hb_vmOperatorCall( pItem1, pItem2, "==" );
}
else if( pItem1->type != pItem2->type )
else if( bExact && IS_ARRAY( pItem1 ) && IS_ARRAY( pItem2 ) )
{
BOOL bResult = pItem1->item.asArray.value->pItems && pItem2->item.asArray.value->pItems &&
pItem1->item.asArray.value->pItems == pItem2->item.asArray.value->pItems;
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( bResult );
}
else if( ( pItem1->type != pItem2->type ) ||
( IS_BLOCK( pItem1 ) && IS_BLOCK( pItem2 ) ) ||
( ! bExact && IS_ARRAY( pItem1 ) && IS_ARRAY( pItem2 ) ) )
{
PHB_ITEM pResult;
if( bExact )
hb_errRT_BASE( EG_ARG, 1070, NULL, "==" );
pResult = hb_errRT_BASE_Subst( EG_ARG, 1070, NULL, "==" );
else
hb_errRT_BASE( EG_ARG, 1071, NULL, "=" );
pResult = hb_errRT_BASE_Subst( EG_ARG, 1071, NULL, "=" );
if( pResult )
{
hb_stackPop();
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
}
else
{
@@ -1245,8 +1291,7 @@ void hb_vmGreater( void )
hb_vmPushLogical( bLogical1 > bLogical2 );
}
else if( IS_OBJECT( stack.pPos - 2 ) &&
hb_objHasMsg( stack.pPos - 2, ">" ) )
else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, ">" ) )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
@@ -1256,7 +1301,16 @@ void hb_vmGreater( void )
}
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
hb_errRT_BASE( EG_ARG, 1075, NULL, ">" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1075, NULL, ">" );
if( pResult )
{
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
}
}
void hb_vmGreaterEqual( void )
@@ -1290,8 +1344,7 @@ void hb_vmGreaterEqual( void )
hb_vmPushLogical( bLogical1 >= bLogical2 );
}
else if( IS_OBJECT( stack.pPos - 2 ) &&
hb_objHasMsg( stack.pPos - 2, ">=" ) )
else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, ">=" ) )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
@@ -1301,7 +1354,16 @@ void hb_vmGreaterEqual( void )
}
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
hb_errRT_BASE( EG_ARG, 1076, NULL, ">=" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1076, NULL, ">=" );
if( pResult )
{
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
}
}
void hb_vmInc( void )
@@ -1386,8 +1448,7 @@ void hb_vmLess( void )
hb_vmPushLogical( bLogical1 < bLogical2 );
}
else if( IS_OBJECT( stack.pPos - 2 ) &&
hb_objHasMsg( stack.pPos - 2, "<" ) )
else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, "<" ) )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
@@ -1397,7 +1458,16 @@ void hb_vmLess( void )
}
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
hb_errRT_BASE( EG_ARG, 1073, NULL, "<" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<" );
if( pResult )
{
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
}
}
void hb_vmLessEqual( void )
@@ -1431,8 +1501,7 @@ void hb_vmLessEqual( void )
hb_vmPushLogical( bLogical1 <= bLogical2 );
}
else if( IS_OBJECT( stack.pPos - 2 ) &&
hb_objHasMsg( stack.pPos - 2, "<=" ) )
else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, "<=" ) )
{
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
@@ -1442,7 +1511,16 @@ void hb_vmLessEqual( void )
}
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
hb_errRT_BASE( EG_ARG, 1074, NULL, "<=" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1074, NULL, "<=" );
if( pResult )
{
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
}
}
void hb_vmLocalName( WORD wLocal, char * szLocalName ) /* locals and parameters index and name information for the debugger */
@@ -1463,17 +1541,25 @@ void hb_vmMessage( PHB_SYMB pSymMsg ) /* sends a message to an object */
HB_DEBUG2( "Message: %s\n", pSymMsg->szName );
}
/* NOTE: Clipper is resetting the number width on a negate. */
void hb_vmNegate( void )
{
if( IS_INTEGER( stack.pPos - 1 ) )
{
( stack.pPos - 1 )->item.asInteger.value = -( stack.pPos - 1 )->item.asInteger.value;
( stack.pPos - 1 )->item.asInteger.length = 10;
}
else if( IS_LONG( stack.pPos - 1 ) )
{
( stack.pPos - 1 )->item.asLong.value = -( stack.pPos - 1 )->item.asLong.value;
( stack.pPos - 1 )->item.asLong.length = 10;
}
else if( IS_DOUBLE( stack.pPos - 1 ) )
{
( stack.pPos - 1 )->item.asDouble.value = -( stack.pPos - 1 )->item.asDouble.value;
( stack.pPos - 1 )->item.asDouble.length = ( stack.pPos - 1 )->item.asDouble.value >= 10000000000.0 ? 20 : 10;
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1080, NULL, "-" );
@@ -1553,7 +1639,17 @@ void hb_vmNotEqual( void )
}
else if( pItem1->type != pItem2->type )
hb_errRT_BASE( EG_ARG, 1072, NULL, "<>" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1072, NULL, "<>" );
if( pResult )
{
hb_stackPop();
hb_stackPop();
hb_vmPush( pResult );
hb_itemRelease( pResult );
}
}
else
{
@@ -1581,7 +1677,7 @@ void hb_vmMinus( void )
long lDate2 = hb_vmPopDate();
long lDate1 = hb_vmPopDate();
hb_vmPushNumber( lDate1 - lDate2, hb_set.HB_SET_DECIMALS );
hb_vmPushLong( lDate1 - lDate2 );
}
else if( IS_NUMERIC( pItem2 ) && IS_DATE( pItem1 ) )
{
@@ -2801,16 +2897,23 @@ HARBOUR HB_LEN( void )
switch( pItem->type )
{
case IT_ARRAY:
hb_retnl( hb_arrayLen( pItem ) );
break;
hb_retnl( hb_arrayLen( pItem ) );
break;
case IT_STRING:
hb_retnl( hb_itemGetCLen( pItem ) );
break;
hb_retnl( hb_itemGetCLen( pItem ) );
break;
default:
hb_errRT_BASE( EG_ARG, 1111, NULL, "LEN" );
break;
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1111, NULL, "LEN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
}
else
@@ -2828,41 +2931,41 @@ HARBOUR HB_EMPTY( void )
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
case IT_STRING:
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
case IT_INTEGER:
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
case IT_LONG:
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_DOUBLE:
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
case IT_DATE:
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_LOGICAL:
hb_retl( ! hb_itemGetL( pItem ) );
break;
hb_retl( ! hb_itemGetL( pItem ) );
break;
case IT_BLOCK:
hb_retl( FALSE );
break;
hb_retl( FALSE );
break;
default:
hb_retl( TRUE );
break;
hb_retl( TRUE );
break;
}
}
else
@@ -2880,35 +2983,35 @@ HARBOUR HB_VALTYPE( void )
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
case IT_BLOCK:
hb_retc( "B" );
break;
hb_retc( "B" );
break;
case IT_DATE:
hb_retc( "D" );
break;
hb_retc( "D" );
break;
case IT_LOGICAL:
hb_retc( "L" );
break;
hb_retc( "L" );
break;
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
hb_retc( "N" );
break;
hb_retc( "N" );
break;
case IT_STRING:
hb_retc( "C" );
break;
hb_retc( "C" );
break;
case IT_NIL:
default:
hb_retc( "U" );
break;
hb_retc( "U" );
break;
}
}
else

1
harbour/tests/working/Makefile
View File

@@ -52,7 +52,6 @@ PRG_SOURCES=\
dates3.prg \
dates4.prg \
debugtst.prg \
descend.prg \
dirtest.prg \
docase.prg \
dosshell.prg \

64
harbour/tests/working/descend.prg
View File

@@ -1,64 +0,0 @@
//
// $Id$
//
#include "set.ch"
function main()
LOCAL dDate
LOCAL cString
cString := "HARBOUR POWER & MAGIC"
OutSpec( Descend( cString ) )
OutSpec( Descend( &cString ) )
OutSpec( Descend( "HARBOUR POWER & MAGIC" ) )
OutSpec( Descend( Descend( "HARBOUR POWER & MAGIC" ) ) )
OutSpec( Descend( .f. ) )
OutSpec( Descend( .t. ) )
OutSpec( Descend( 1 ) )
OutSpec( Descend( -1 ) )
OutSpec( Descend( Descend( 256 ) ) )
OutSpec( Descend( 2.0 ) )
OutSpec( Descend( 2.5 ) )
OutSpec( Descend( -100.35 ) )
OutSpec( Descend( -740.354 ) )
OutSpec( Descend( -740.359 ) )
SET( _SET_DATEFORMAT, "dd/mm/yyyy" )
dDate := cToD( "31/12/2999" )
OutSpec( dDate, dtos( dDate ), Descend( dDate ) )
dDate := cToD( "1/1/0100" )
OutSpec( dDate, dtos( dDate ), Descend( dDate ) )
OutSpec( date(), dtos( date() ), Descend( date() ) )
OutSpec( date(), dtos( date() ), Descend( Descend( date() ) ) )
OutSpec( date()+1, dtos( date()+1 ), Descend( date()+1 ) )
OutSpec( date()+2, dtos( date()+2 ), Descend( date()+2 ) )
OutSpec( Asc( Descend( "" ) ) )
OutSpec( Descend( "" ) )
OutSpec( Asc( Descend( chr(0) ) ) )
OutSpec( Asc( Descend( chr(0) + "Hello" ) ) )
OutSpec( Descend( chr(0) + "Hello" ) )
OutSpec( Asc( Descend( "Hello" + Chr(0) + "world" ) ) )
OutSpec( Descend( "Hello" + Chr(0) + "world" ) )
OutSpec( Descend( { "A", "B" } ) )
OutSpec( ValType( Descend( { "A", "B" } ) ))
OutSpec( Descend( nil ) )
OutSpec( ValType( Descend( nil ) ))
OutSpec( Descend() )
OutSpec( ValType( Descend() ) )
return nil
STATIC FUNCTION OutSpec( cString )
OutStd( cString )
OutStd( Chr(13) + Chr(10) )
RETURN NIL

983
harbour/tests/working/rtl_test.prg
View File

File diff suppressed because it is too large Load Diff

6
harbour/tests/working/testdbf.prg
View File

@@ -27,4 +27,10 @@ function main()
? "[" + FIELD->MEMO1 + "]"
? "[" + FIELD->MEMO2 + "]"
FIELD->NUMERIC := 90
FIELD->DOUBLE := 120.138
? "[" + Str(FIELD->DOUBLE) + "]"
? "[" + Str(FIELD->NUMERIC) + "]"
return nil