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

19990901-17:20 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-01 18:29:17 +00:00
parent abf7ca521b
commit 948b27dcb4
13 changed files with 383 additions and 323 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
harbour/ChangeLog
View File

@@ -1,3 +1,55 @@
19990901-17:20 GMT+1 Victor Szel <info@szelvesz.hu>
* tests/working/rtl_test.prg
+ Added tests for decimals handling. (NUMPAR.PRG)
* source/rtl/strings.c
+ VAL() now using hb_retndlen() instead of internalling (wow!).
+ hb_itemStr() is now using hb_itemGetNLen()
* source/rtl/math.c
+ No functions (except ABS()) are now accessing the internals. They
are using hb_retndlen() and hb_itemGetNLen() instead.
ABS(), MAX(), MIN(), MOD(), ROUND()
! HB_MOD() accessed item.asDouble even if the item was not a DOUBLE.
- There were places were the decimals places were explicitly set to the
default SET_DECIMAL setting, even though the hb_retnd() call already set
this. I've removed these assigments. (David, is this OK ?)
* source/rtl/itemapi.c
* hb_itemGetNLen() is now optionally returning the parameters, so passing
a NULL is now valid.
! hb_itemGetNLen() now returns zeros for non-numeric values.
; hb_itemSetNLen() tested.
* source/rtl/extend.c
include/extend.h
+ hb_retndlen(), hb_retnilen(), hb_retnllen() added, which are the same
as the standard hb_retn*() functions, but the width and decimals can be
specified.
* source/rtl/dates.c
+ DAY(), MONTH(), YEAR(), DOW() now using the new hb_itemSetNLen() API call
instead of dealing with the internals.
* source/rtl/console.c
+ Changed to call hb_fsSetMode().
* source/rtl/filesys.c
include/filesys.h
include/fileio.ch
+ Added hb_fsSetMode() function, and the constants.
* Changes by Jose Lalin implemented.
19990901-15:00 GMT+1 Jose Lalin <dezac@corevia.com>
* filesys.c
+ Added hb_fsChDrv()
+ Added hb_fsCurDrv()
+ Added hb_fsIsDrv()
! BC4.5 docs: setdisk/getdisk are for DOS, WIN16, WIN32 and OS/2
I don't know if they work under Unix/Linux too.
* hb_fsCurDir()
* hb_fsExtOpen
+ some HB_SYMBOL_UNUSED added.
NOTE [vszel]:
1.) I've #ifdef-ed out the new stuff for __CYGWIN__ since
setdisk()/getdisk() were neither declared nor in any libraries.
2.) I've added some new header files to FILESYS.C. Please check them
on your system, if they are correct.
19990901-14:05 EDT Paul Tucker <ptucker@sympatico.ca>
* source/rtl/filesys.c
* hb_fsread() -> account for the possibility that num read is less

5
harbour/include/extend.h
View File

@@ -223,9 +223,12 @@ extern void hb_retc( char * szText ); /* returns a string */
extern void hb_retclen( char * szText, ULONG ulLen ); /* returns a string with a specific length */
extern void hb_retds( char * szDate ); /* returns a date, must use yyyymmdd format */
extern void hb_retl( int iTrueFalse ); /* returns a logical integer */
extern void hb_retnd( double dNumber ); /* returns a double */
extern void hb_retni( int iNumber ); /* returns a integer number */
extern void hb_retnl( long lNumber ); /* returns a long number */
extern void hb_retnd( double dNumber ); /* returns a double */
extern void hb_retndlen( double dNumber, WORD wWidth, WORD wDecimal ); /* returns a double, with specific width and decimals */
extern void hb_retnilen( int iNumber, WORD wWidth ); /* returns a integer number, with specific width */
extern void hb_retnllen( long lNumber, WORD wWidth ); /* returns a long number, with specific width */
extern void hb_reta( ULONG ulLen ); /* returns an array with a specific length */
extern void hb_storc( char * szText, int iParam, ... ); /* stores a szString on a variable by reference */

8
harbour/include/fileio.ch
View File

@@ -74,13 +74,17 @@
#define FO_INHERITED 0x0000 /* Spawned processes can inherit this file handle */
#define FO_PRIVATE 0x0080 /* Spawned processes can not inherit this file handle */
/* File mode flags */
/* File seek mode flags */
#define FS_SET 0x0000 /* Seek from beginning of file */
#define FS_RELATIVE 0x0001 /* Seek from current file poitner */
#define FS_END 0x0002 /* Seek from end of file */
/* File mode flags */
#define FM_BINARY 1 /* Binary mode (raw) */
#define FM_TEXT 2 /* Test mode (cooked) */
/* File system error codes */
#define FS_ERROR (-1) /* Unspecified error */
#define FS_ERROR ( -1 ) /* Unspecified error */
/* Extended file open mode flags */
#define FXO_TRUNCATE 0x0100 /* Create (truncate if exists) */

1
harbour/include/filesys.h
View File

@@ -81,6 +81,7 @@ extern ULONG hb_fsRead ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCou
extern BOOL hb_fsRmDir ( BYTE * pDirName );
extern int hb_fsRename ( BYTE * pOldName, BYTE * pNewName );
extern ULONG hb_fsSeek ( FHANDLE hFileHandle, LONG lOffset, USHORT uiMode );
extern void hb_fsSetMode ( FHANDLE hFileHandle, USHORT uiMode );
extern ULONG hb_fsWrite ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount );
extern PHB_FNAME hb_fsFNameSplit ( char * szFilename ); /* Split given filename into path, name and extension */

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

@@ -54,6 +54,7 @@
#include "extend.h"
#include "itemapi.h"
#include "errorapi.h"
#include "filesys.h"
#include "dates.h"
#include "set.h"
#include "inkey.h"
@@ -68,7 +69,6 @@
#else
#include <io.h>
#endif
#include <fcntl.h>
#define ACCEPT_BUFFER_LEN 256 /*length of input buffer for ACCEPT command */
@@ -106,13 +106,9 @@ void hb_consoleInitialize( void )
/* Some compilers open stdout and stderr in text mode, but
Harbour needs them to be open in binary mode. */
#if defined(__BORLANDC__) || defined(__IBMCPP__) || defined(__DJGPP__) || defined(__CYGWIN__)
setmode( fileno( stdout ), O_BINARY );
setmode( fileno( stderr ), O_BINARY );
#elif defined(_MSC_VER)
_setmode( _fileno( stdout ), _O_BINARY );
_setmode( _fileno( stderr ), _O_BINARY );
#endif
hb_fsSetMode( fileno( stdout ), FM_BINARY );
hb_fsSetMode( fileno( stderr ), FM_BINARY );
#ifdef HARBOUR_USE_GTAPI
hb_gtInit();

56
harbour/source/rtl/dates.c
View File

@@ -494,21 +494,11 @@ HARBOUR HB_DAY( void )
if( pDate )
{
PHB_ITEM pReturn = hb_itemNew( NULL );
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->type = IT_LONG;
pReturn->item.asLong.value = lDay;
pReturn->item.asLong.length = 3;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
hb_retni( lDay );
* It is dangerous to manipulate the stack return value directly!
stack.Return.item.asInteger.length = 3;
*/
hb_retnllen( lDay, 3 );
}
else
hb_errRT_BASE( EG_ARG, 1114, NULL, "DAY" );
@@ -525,21 +515,11 @@ HARBOUR HB_MONTH( void )
if( pDate )
{
PHB_ITEM pReturn = hb_itemNew( NULL );
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->type = IT_LONG;
pReturn->item.asLong.value = lMonth;
pReturn->item.asLong.length = 3;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
hb_retni( lMonth );
* It is dangerous to manipulate the stack return value directly!
stack.Return.item.asInteger.length = 3;
*/
hb_retnllen( lMonth, 3 );
}
else
hb_errRT_BASE( EG_ARG, 1113, NULL, "MONTH" );
@@ -556,21 +536,11 @@ HARBOUR HB_YEAR( void )
if( pDate )
{
PHB_ITEM pReturn = hb_itemNew( NULL );
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->type = IT_LONG;
pReturn->item.asLong.value = lYear;
pReturn->item.asLong.length = 5;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
hb_retni( lYear );
* It is dangerous to manipulate the stack return value directly!
stack.Return.item.asInteger.length = 5;
*/
hb_retnllen( lYear, 5 );
}
else
hb_errRT_BASE( EG_ARG, 1112, NULL, "YEAR" );
@@ -634,30 +604,16 @@ HARBOUR HB_DOW( void )
if( pDate )
{
PHB_ITEM pReturn = hb_itemNew( NULL );
pReturn->type = IT_LONG;
if( pDate->item.asDate.value )
{
long lDay, lMonth, lYear;
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->item.asLong.value = hb_dow( lDay, lMonth, lYear );
/* hb_retni( hb_dow( lDay, lMonth, lYear ) );
*/
hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 );
}
else
pReturn->item.asLong.value = 0;
/* hb_retni( 0 );
*/
pReturn->item.asLong.length = 3;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
stack.Return.item.asInteger.length = 3;
*/
hb_retnllen( 0, 3 );
}
else
hb_errRT_BASE( EG_ARG, 1115, NULL, "DOW" );

77
harbour/source/rtl/extend.c
View File

@@ -22,6 +22,15 @@
You can contact me at: alinares@fivetech.com
*/
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_retnilen()
hb_retnllen()
hb_retndlen()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#include "extend.h"
#include "itemapi.h"
#include "set.h"
@@ -209,7 +218,7 @@ char * hb_pards( int iParam, ... )
}
}
}
return " "; /* 8 spaces */
}
@@ -477,6 +486,13 @@ void hb_retds( char * szDate ) /* szDate must have yyyymmdd format */
stack.Return.item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
}
void hb_retl( int iLogical )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_LOGICAL;
stack.Return.item.asLogical.value = iLogical ? TRUE : FALSE;
}
void hb_retnd( double dNumber )
{
hb_itemClear( &stack.Return );
@@ -485,8 +501,8 @@ void hb_retnd( double dNumber )
stack.Return.item.asDouble.length = 20;
else
stack.Return.item.asDouble.length = 10;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.value = dNumber;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.value = dNumber;
}
void hb_retni( int iNumber )
@@ -497,19 +513,54 @@ void hb_retni( int iNumber )
stack.Return.item.asInteger.value = iNumber;
}
void hb_retl( int iLogical )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_LOGICAL;
stack.Return.item.asLogical.value = iLogical ? TRUE : FALSE;
}
void hb_retnl( long lNumber )
{
hb_itemClear( &stack.Return );
stack.Return.type = IT_LONG;
stack.Return.item.asLong.length = 10;
stack.Return.item.asLong.value = lNumber;
stack.Return.type = IT_LONG;
stack.Return.item.asLong.length = 10;
stack.Return.item.asLong.value = lNumber;
}
void hb_retndlen( double dNumber, WORD wWidth, WORD wDecimal )
{
if( wWidth == 0 || wWidth > 99 )
{
if( dNumber > 10000000000.0 )
wWidth = 20;
else
wWidth = 10;
}
if( wDecimal == ( ( WORD ) -1 ) || ( wDecimal != 0 && wDecimal >= ( wWidth - 1 ) ) )
wDecimal = hb_set.HB_SET_DECIMALS;
hb_itemClear( &stack.Return );
stack.Return.type = IT_DOUBLE;
stack.Return.item.asDouble.value = dNumber;
stack.Return.item.asDouble.length = wWidth;
stack.Return.item.asDouble.decimal = wDecimal;
}
void hb_retnilen( int iNumber, WORD wWidth )
{
if( wWidth == 0 || wWidth > 99 )
wWidth = 10;
hb_itemClear( &stack.Return );
stack.Return.type = IT_INTEGER;
stack.Return.item.asInteger.value = iNumber;
stack.Return.item.asInteger.length = wWidth;
}
void hb_retnllen( long lNumber, WORD wWidth )
{
if( wWidth == 0 || wWidth > 99 )
wWidth = 10;
hb_itemClear( &stack.Return );
stack.Return.type = IT_LONG;
stack.Return.item.asLong.value = lNumber;
stack.Return.item.asLong.length = wWidth;
}
void hb_storc( char * szText, int iParam, ... )

161
harbour/source/rtl/filesys.c
View File

@@ -15,6 +15,15 @@
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
/* Harbour Project source code
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Jose Lalin <dezac@corevia.com>:
hb_fsChDrv()
hb_fsCurDrv()
hb_fsIsDrv()
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
/* NOTE: In DOS/DJGPP under WinNT4 hb_fsSeek( fhnd, offset < 0, FS_SET) will
set the file pointer to the passed negative value, and the subsequent
hb_fsWrite() call will fail. In CA-Clipper hb_fsSeek() will fail,
@@ -31,6 +40,8 @@
#if defined(__CYGWIN__)
#include <mingw32/share.h>
#include <fcntl.h>
#include <io.h>
#endif
#if defined(__GNUC__)
@@ -40,6 +51,13 @@
#include <fcntl.h>
#include <errno.h>
#if defined(__DJGPP__) || defined(__CYGWIN__) || defined(HARBOUR_GCC_OS2)
#include <io.h>
#endif
#if defined(__DJGPP__)
#include <dir.h>
#endif
#if !defined(HAVE_POSIX_IO)
#define HAVE_POSIX_IO
#endif
@@ -233,7 +251,7 @@ static void convert_create_flags( USHORT uiFlags, int * result_flags, unsigned *
* FILESYS.API FUNCTIONS --
*/
FHANDLE hb_fsOpen ( BYTE * pFilename, USHORT uiFlags )
FHANDLE hb_fsOpen( BYTE * pFilename, USHORT uiFlags )
{
FHANDLE hFileHandle;
@@ -277,7 +295,7 @@ FHANDLE hb_fsOpen ( BYTE * pFilename, USHORT uiFlags )
return hFileHandle;
}
FHANDLE hb_fsCreate ( BYTE * pFilename, USHORT uiFlags )
FHANDLE hb_fsCreate( BYTE * pFilename, USHORT uiFlags )
{
FHANDLE hFileHandle;
int oflag;
@@ -308,7 +326,7 @@ FHANDLE hb_fsCreate ( BYTE * pFilename, USHORT uiFlags )
return hFileHandle;
}
void hb_fsClose ( FHANDLE hFileHandle )
void hb_fsClose( FHANDLE hFileHandle )
{
#if defined(HAVE_POSIX_IO) || defined(_MSC_VER)
@@ -328,9 +346,49 @@ void hb_fsClose ( FHANDLE hFileHandle )
}
void hb_fsSetMode( FHANDLE hFileHandle, USHORT uiMode )
{
#if defined(__BORLANDC__) || defined(__IBMCPP__) || defined(__DJGPP__) || defined(__CYGWIN__)
errno = 0;
switch( uiMode )
{
case FM_BINARY:
setmode( hFileHandle, O_BINARY );
break;
case FM_TEXT:
setmode( hFileHandle, O_TEXT );
break;
}
s_uiErrorLast = errno;
#elif defined(_MSC_VER)
errno = 0;
switch( uiMode )
{
case FM_BINARY:
_setmode( hFileHandle, _O_BINARY );
case FM_TEXT:
_setmode( hFileHandle, _O_TEXT );
break;
}
s_uiErrorLast = errno;
#else
s_uiErrorLast = FS_ERROR;
#endif
}
/* NOTE: CA-Clipper uses USHORT instead of ULONG here. */
ULONG hb_fsRead ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount )
ULONG hb_fsRead( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount )
{
ULONG ulReadTotal = 0;
@@ -363,7 +421,7 @@ ULONG hb_fsRead ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount )
/* NOTE: CA-Clipper uses USHORT instead of ULONG here. */
ULONG hb_fsWrite ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount )
ULONG hb_fsWrite( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount )
{
ULONG ulWrittenTotal = 0;
@@ -390,7 +448,7 @@ ULONG hb_fsWrite ( FHANDLE hFileHandle, BYTE * pBuff, ULONG ulCount )
return ulWrittenTotal;
}
ULONG hb_fsSeek ( FHANDLE hFileHandle, LONG lOffset, USHORT uiFlags )
ULONG hb_fsSeek( FHANDLE hFileHandle, LONG lOffset, USHORT uiFlags )
{
ULONG ulPos = -1;
USHORT Flags = convert_seek_flags( uiFlags );
@@ -435,7 +493,7 @@ ULONG hb_fsSeek ( FHANDLE hFileHandle, LONG lOffset, USHORT uiFlags )
return ulPos;
}
USHORT hb_fsError ( void )
USHORT hb_fsError( void )
{
return s_uiErrorLast;
}
@@ -468,7 +526,7 @@ int hb_fsDelete ( BYTE * pFilename )
return retval;
}
int hb_fsRename ( BYTE * pOldName, BYTE * pNewName )
int hb_fsRename( BYTE * pOldName, BYTE * pNewName )
{
int retval = -1;
@@ -507,6 +565,7 @@ BOOL hb_fsLock ( FHANDLE hFileHandle, ULONG ulStart,
case FL_UNLOCK:
iResult = unlock( hFileHandle, ulStart, ulLength );
break;
}
s_uiErrorLast = errno;
@@ -524,6 +583,7 @@ BOOL hb_fsLock ( FHANDLE hFileHandle, ULONG ulStart,
case FL_UNLOCK:
iResult = locking( hFileHandle, _LK_UNLCK, ulLength );
break;
}
hb_fsSeek( hFileHandle, ulOldPos, FS_SET );
@@ -540,7 +600,7 @@ BOOL hb_fsLock ( FHANDLE hFileHandle, ULONG ulStart,
return ( iResult ? FALSE : TRUE );
}
void hb_fsCommit ( FHANDLE hFileHandle )
void hb_fsCommit( FHANDLE hFileHandle )
{
#if defined(HAVE_POSIX_IO) || defined(_MSC_VER)
@@ -563,7 +623,7 @@ void hb_fsCommit ( FHANDLE hFileHandle )
#endif
}
BOOL hb_fsMkDir ( BYTE * pDirname )
BOOL hb_fsMkDir( BYTE * pDirname )
{
int iResult;
@@ -589,7 +649,7 @@ BOOL hb_fsMkDir ( BYTE * pDirname )
return ( iResult ? FALSE : TRUE );
}
BOOL hb_fsChDir ( BYTE * pDirname )
BOOL hb_fsChDir( BYTE * pDirname )
{
int iResult;
@@ -609,7 +669,7 @@ BOOL hb_fsChDir ( BYTE * pDirname )
return ( iResult ? FALSE : TRUE );
}
BOOL hb_fsRmDir ( BYTE * pDirname )
BOOL hb_fsRmDir( BYTE * pDirname )
{
int iResult;
@@ -631,10 +691,12 @@ BOOL hb_fsRmDir ( BYTE * pDirname )
/* TODO: Make it thread safe */
BYTE * hb_fsCurDir ( USHORT uiDrive )
BYTE * hb_fsCurDir( USHORT uiDrive )
{
static char cwd_buff[ PATH_MAX + 1 ];
HB_SYMBOL_UNUSED( uiDrive );
#if defined(HAVE_POSIX_IO)
errno = 0;
@@ -651,69 +713,86 @@ BYTE * hb_fsCurDir ( USHORT uiDrive )
return ( BYTE * ) cwd_buff;
}
/* TODO: Implement nDrive */
USHORT hb_fsChDrv ( BYTE nDrive )
USHORT hb_fsChDrv( BYTE nDrive )
{
USHORT iResult;
USHORT uiResult;
#if defined(HAVE_POSIX_IO)
#if defined(HAVE_POSIX_IO) && ! defined(__CYGWIN__)
USHORT uiSave = getdisk();
errno = 0;
iResult = 0;
s_uiErrorLast = errno;
s_uiErrorLast = FS_ERROR; /* TODO: Remove when function implemented */
uiResult = setdisk( nDrive );
if( nDrive == getdisk() )
{
s_uiErrorLast = errno;
}
else
{
setdisk( uiSave );
s_uiErrorLast = FS_ERROR;
}
#else
iResult = 0;
uiResult = 0;
s_uiErrorLast = FS_ERROR;
#endif
return iResult;
return uiResult;
}
BYTE hb_fsCurDrv ( void )
BYTE hb_fsCurDrv( void )
{
USHORT iResult;
USHORT uiResult;
#if defined(HAVE_POSIX_IO)
#if defined(HAVE_POSIX_IO) && ! defined(__CYGWIN__)
errno = 0;
iResult = 0;
uiResult = getdisk();
s_uiErrorLast = errno;
s_uiErrorLast = FS_ERROR; /* TODO: Remove when function implemented */
#else
iResult = 0;
uiResult = 0;
s_uiErrorLast = FS_ERROR;
#endif
return iResult;
return uiResult;
}
USHORT hb_fsIsDrv ( BYTE nDrive )
USHORT hb_fsIsDrv( BYTE nDrive )
{
USHORT iResult;
USHORT uiResult;
#if defined(HAVE_POSIX_IO)
#if defined(HAVE_POSIX_IO) && ! defined(__CYGWIN__)
USHORT uiSave = getdisk();
errno = 0;
iResult = 0;
s_uiErrorLast = errno;
s_uiErrorLast = FS_ERROR; /* TODO: Remove when function implemented */
setdisk( nDrive );
if( nDrive == getdisk() )
{
uiResult = 1;
s_uiErrorLast = errno;
}
else
{
uiResult = 0;
setdisk( uiSave );
s_uiErrorLast = FS_ERROR;
}
#else
iResult = 0;
uiResult = 0;
s_uiErrorLast = FS_ERROR;
#endif
return iResult;
return uiResult;
}
/* TODO: Implement hb_fsExtOpen */
@@ -724,6 +803,12 @@ FHANDLE hb_fsExtOpen( BYTE * pFilename, BYTE * pDefExt,
s_uiErrorLast = FS_ERROR;
HB_SYMBOL_UNUSED( pFilename );
HB_SYMBOL_UNUSED( pDefExt );
HB_SYMBOL_UNUSED( uiFlags );
HB_SYMBOL_UNUSED( pPaths );
HB_SYMBOL_UNUSED( pError );
return FS_ERROR;
}

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

@@ -401,18 +401,23 @@ void hb_itemGetNLen( PHB_ITEM pItem, WORD * pwWidth, WORD * pwDecimal )
switch( pItem->type )
{
case IT_DOUBLE:
* pwWidth = pItem->item.asDouble.length;
* pwDecimal = pItem->item.asDouble.decimal;
if( pwWidth ) * pwWidth = pItem->item.asDouble.length;
if( pwDecimal ) * pwDecimal = pItem->item.asDouble.decimal;
break;
case IT_LONG:
* pwWidth = pItem->item.asLong.length;
* pwDecimal = 0;
if( pwWidth ) * pwWidth = pItem->item.asLong.length;
if( pwDecimal ) * pwDecimal = 0;
break;
case IT_INTEGER:
* pwWidth = pItem->item.asInteger.length;
* pwDecimal = 0;
if( pwWidth ) * pwWidth = pItem->item.asInteger.length;
if( pwDecimal ) * pwDecimal = 0;
break;
default:
if( pwWidth ) * pwWidth = 0;
if( pwDecimal ) * pwDecimal = 0;
break;
}
}

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

@@ -11,6 +11,7 @@
#include <math.h>
#include "extend.h"
#include "set.h"
#include "itemapi.h"
#include "errorapi.h"
HARBOUR HB_ABS( void )
@@ -37,10 +38,9 @@ HARBOUR HB_ABS( void )
case IT_DOUBLE:
if( pNumber->item.asDouble.value >= 0.0 )
hb_retnd( pNumber->item.asDouble.value );
hb_retndlen( pNumber->item.asDouble.value, 0, pNumber->item.asDouble.decimal );
else
hb_retnd( -pNumber->item.asDouble.value );
stack.Return.item.asDouble.decimal = pNumber->item.asDouble.decimal;
hb_retndlen( -pNumber->item.asDouble.value, 0, pNumber->item.asDouble.decimal );
}
else
hb_errRT_BASE( EG_ARG, 1089, NULL, "ABS" );
@@ -54,11 +54,7 @@ HARBOUR HB_EXP( void )
if( hb_pcount() == 1 )
{
if( ISNUM( 1 ) )
{
hb_retnd( exp( hb_parnd( 1 ) ) );
/* Always set default number of decimals after EXP() */
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
}
else
hb_errRT_BASE( EG_ARG, 1096, NULL, "EXP" );
}
@@ -86,12 +82,12 @@ HARBOUR HB_LOG( void )
if( ISNUM( 1 ) )
{
double dNumber = hb_parnd( 1 );
hb_retnd( log( dNumber ) );
/* Always set default number of decimals after LOG() */
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
if( dNumber <= 0.0 )
/* Indicate overflow if called with an invalid argument */
stack.Return.item.asDouble.length = 99;
hb_retndlen( log( dNumber ), 99, ( WORD ) -1 );
else
hb_retnd( log( dNumber ) );
}
else
hb_errRT_BASE( EG_ARG, 1095, NULL, "LOG" );
@@ -121,12 +117,13 @@ HARBOUR HB_MAX( void )
double d1 = hb_parnd( 1 );
double d2 = hb_parnd( 2 );
int iDec1 = ( wType1 == IT_DOUBLE ) ? p1->item.asDouble.decimal : 0;
int iDec2 = ( wType2 == IT_DOUBLE ) ? p2->item.asDouble.decimal : 0;
WORD wDec1;
WORD wDec2;
hb_retnd( d1 >= d2 ? d1 : d2 );
hb_itemGetNLen( p1, NULL, &wDec1 );
hb_itemGetNLen( p2, NULL, &wDec2 );
stack.Return.item.asDouble.decimal = ( d1 >= d2 ? iDec1 : iDec2 );
hb_retndlen( d1 >= d2 ? d1 : d2, 0, ( d1 >= d2 ? wDec1 : wDec2 ) );
}
else if( wType1 == IT_LONG || wType2 == IT_LONG )
{
@@ -178,12 +175,13 @@ HARBOUR HB_MIN( void )
double d1 = hb_parnd( 1 );
double d2 = hb_parnd( 2 );
int iDec1 = ( wType1 == IT_DOUBLE ) ? p1->item.asDouble.decimal : 0;
int iDec2 = ( wType2 == IT_DOUBLE ) ? p2->item.asDouble.decimal : 0;
WORD wDec1;
WORD wDec2;
hb_retnd( d1 <= d2 ? d1 : d2 );
hb_itemGetNLen( p1, NULL, &wDec1 );
hb_itemGetNLen( p2, NULL, &wDec2 );
stack.Return.item.asDouble.decimal = ( d1 <= d2 ? iDec1 : iDec2 );
hb_retndlen( d1 <= d2 ? d1 : d2, 0, ( d1 <= d2 ? wDec1 : wDec2 ) );
}
else if( wType1 == IT_LONG || wType2 == IT_LONG )
{
@@ -245,14 +243,14 @@ FUNCTION MOD(cl_num, cl_base)
hb_retnd( dResult + dBase );
else
hb_retnd( dResult );
/* Always set default number of decimals after computing mod */
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
}
else
{
hb_retnd( dNumber );
/* Set the correct number of decimals */
stack.Return.item.asDouble.decimal = pNumber->item.asDouble.decimal;
WORD wDec;
hb_itemGetNLen( pNumber, NULL, &wDec );
hb_retndlen( dNumber, 0, wDec );
}
}
else
@@ -306,8 +304,7 @@ HARBOUR HB_ROUND( void )
{
int iDec = hb_parni( 2 );
hb_retnd( hb_numRound( hb_parnd( 1 ), iDec ) );
stack.Return.item.asDouble.decimal = iDec;
hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, iDec );
}
else
hb_errRT_BASE( EG_ARG, 1094, NULL, "ROUND" );
@@ -325,14 +322,9 @@ HARBOUR HB_SQRT( void )
double dNumber = hb_parnd( 1 );
if( dNumber > 0 )
{
hb_retnd( sqrt( dNumber ) );
}
else
/* Clipper doesn't error! */
hb_retnd( 0 );
/* Always set default number of decimals after SQRT() */
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
hb_retnd( 0 ); /* Clipper doesn't error! */
}
else
hb_errRT_BASE( EG_ARG, 1097, NULL, "SQRT" );

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

@@ -909,7 +909,7 @@ HARBOUR HB_STUFF( void )
}
/* TODO: Check for string overflow, Clipper can crash if the resulting
string is too large. Example:
string is too large. Example:
StrTran( "...", ".", Replicate( "A", 32000 ) ) */
/* replaces lots of characters in a string */
@@ -1073,9 +1073,7 @@ HARBOUR HB_VAL( void )
else
nWidth = strlen( pText->item.asString.value );
hb_retnd( hb_strVal( pText->item.asString.value ) );
stack.Return.item.asDouble.length = nWidth;
stack.Return.item.asDouble.decimal = nDec;
hb_retndlen( hb_strVal( pText->item.asString.value ), nWidth, nDec );
}
else
hb_errRT_BASE( EG_ARG, 1098, NULL, "VAL" );
@@ -1100,46 +1098,30 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
{
/* Default to the width and number of decimals specified by the item,
with a limit of 20 integer places and 9 decimal places */
int iWidth;
int iDec;
WORD wWidth;
WORD wDec;
if( IS_DOUBLE( pNumber ) )
{
iWidth = pNumber->item.asDouble.length;
iDec = pNumber->item.asDouble.decimal;
}
else if( IS_INTEGER( pNumber ) )
{
iWidth = pNumber->item.asInteger.length;
iDec = 0;
}
else if( IS_LONG( pNumber ) )
{
iWidth = pNumber->item.asLong.length;
iDec = 0;
}
else
{
iWidth = 0;
iDec = 0;
}
hb_itemGetNLen( pNumber, &wWidth, &wDec );
if( iWidth > 20 )
iWidth = 20;
if( iDec > 9 )
iDec = 9;
if( wWidth > 20 )
wWidth = 20;
if( wDec > 9 )
wDec = 9;
if( hb_set.HB_SET_FIXED )
iDec = hb_set.HB_SET_DECIMALS;
wDec = hb_set.HB_SET_DECIMALS;
if( pWidth )
{
/* If the width parameter is specified, override the default value
and set the number of decimals to zero */
iWidth = ( int ) hb_itemGetNL( pWidth );
int iWidth = ( int ) hb_itemGetNL( pWidth );
if( iWidth < 1 )
iWidth = 10; /* If 0 or negative, use default */
iDec = 0;
wWidth = 10; /* If 0 or negative, use default */
else
wWidth = ( WORD ) iWidth;
wDec = 0;
}
if( pDec )
@@ -1147,24 +1129,27 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
/* This function does not include the decimal places in the width,
so the width must be adjusted downwards, if the decimal places
parameter is greater than 0 */
iDec = ( int ) hb_itemGetNL( pDec );
int iDec = ( int ) hb_itemGetNL( pDec );
if( iDec < 0 )
iDec = 0;
wDec = 0;
else if( iDec > 0 )
iWidth -= ( iDec + 1 );
{
wDec = ( WORD ) iDec;
wWidth -= ( wDec + 1 );
}
}
if( iWidth )
if( wWidth )
{
/* We at least have a width value */
int iBytes;
int iSize = ( iDec ? iWidth + 1 + iDec : iWidth );
int iSize = ( wDec ? wWidth + 1 + wDec : wWidth );
/* Be paranoid and use a large amount of padding */
szResult = ( char * ) hb_xgrab( HB_MAX_DOUBLE_LENGTH );
if( IS_DOUBLE( pNumber ) || iDec != 0 )
if( IS_DOUBLE( pNumber ) || wDec != 0 )
{
double dNumber = hb_itemGetND( pNumber );
@@ -1175,23 +1160,23 @@ char * hb_itemStr( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
else
#endif
{
if( iDec < pNumber->item.asDouble.decimal )
dNumber = hb_numRound( dNumber, iDec );
if( wDec < pNumber->item.asDouble.decimal )
dNumber = hb_numRound( dNumber, wDec );
if( iDec > 0 )
iBytes = sprintf( szResult, "%*.*f", iSize, iDec, dNumber );
if( wDec > 0 )
iBytes = sprintf( szResult, "%*.*f", iSize, wDec, dNumber );
else
iBytes = sprintf( szResult, "%*ld", iWidth, ( LONG ) dNumber );
iBytes = sprintf( szResult, "%*ld", wWidth, ( LONG ) dNumber );
}
}
else switch( pNumber->type & ~IT_BYREF )
{
case IT_INTEGER:
iBytes = sprintf( szResult, "%*i", iWidth, pNumber->item.asInteger.value );
iBytes = sprintf( szResult, "%*i", wWidth, pNumber->item.asInteger.value );
break;
case IT_LONG:
iBytes = sprintf( szResult, "%*li", iWidth, pNumber->item.asLong.value );
iBytes = sprintf( szResult, "%*li", wWidth, pNumber->item.asLong.value );
break;
default:

146
harbour/tests/working/Makefile
View File

@@ -20,132 +20,26 @@ ifeq ($(PM),)
endif
ifeq ($(PM),) # PM not defined = build all files
PRG_SOURCES=\
ac_test.prg \
adirtest.prg \
ainstest.prg \
and_or.prg \
array16.prg \
arrayidx.prg \
arrays.prg \
arreval.prg \
arrindex.prg \
atest.prg \
begin.prg \
box.prg \
byref.prg \
calling.prg \
cdow.prg \
clasinit.prg \
clasname.prg \
classch.prg \
classes.prg \
clsdata.prg \
cmphello.prg \
codebl.prg \
codebloc.prg \
comments.prg \
copyfile.prg \
curdirt.prg \
cursrtst.prg \
dates.prg \
dates2.prg \
dates3.prg \
dates4.prg \
debugtst.prg \
descend.prg \
dirtest.prg \
docase.prg \
dosshell.prg \
dynobj.prg \
dynsym.prg \
exittest.prg \
fib.prg \
fileio.prg \
filexist.prg \
fornext.prg \
fornext2.prg \
fortest.prg \
funcarr.prg \
guess.prg \
hardcr.prg \
hello.prg \
ifelse.prg \
ifinline.prg \
inherit.prg \
inifiles.prg \
initexit.prg \
inkeytst.prg \
inline.prg \
instr.prg \
iotest.prg \
iotest2.prg \
longstr.prg \
longstr2.prg \
mankala.prg \
mathtest.prg \
memvar.prg \
menutest.prg \
mtran.prg \
multiarg.prg \
nums.prg \
objarr.prg \
objasign.prg \
objects.prg \
operat.prg \
os.prg \
output.prg \
overload.prg \
passref.prg \
procline.prg \
procname.prg \
readfile.prg \
readhrb.prg \
recursiv.prg \
returns.prg \
round.prg \
rtfclass.prg \
rtl_test.prg \
say.prg \
scroll.prg \
seconds.prg \
set_num.prg \
set_test.prg \
sound.prg \
statfun.prg \
statics.prg \
strcmp.prg \
strdelim.prg \
strings.prg \
strings2.prg \
strings3.prg \
strip.prg \
syserror.prg \
t1.prg \
test.prg \
test_all.prg \
testbrw.prg \
testcgi.prg \
testcopy.prg \
testdbf.prg \
testerro.prg \
testfor.prg \
testgt.prg \
testhbf.prg \
testhtml.prg \
testinc.prg \
testmem.prg \
teststr.prg \
testtok.prg \
testpre.prg \
testread.prg \
testrdd.prg \
testvars.prg \
testwarn.prg \
tstcolor.prg \
transdef.prg \
val.prg \
version.prg \
while.prg \
ac_test.prg \
fortest.prg \
olvas.prg \
huh.prg \
testdbf.prg \
rtl_test.prg \
descend.prg \
fileio.prg \
and_or.prg \
copyfile.prg \
kej.prg \
kejj.prg \
inkeytst.prg \
para.prg \
i.prg \
j.prg \
k.prg \
ac_test.prg \
testrdd.prg \
testdbf.prg \
PRG_HEADERS=\
cgi.ch \

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

@@ -258,6 +258,42 @@ FUNCTION Main( cPar1 )
TEST_LINE( Descend( SToD( "01000101" ) ) , 3474223 )
TEST_LINE( Descend( SToD( "19801220" ) ) , 2787214 )
/* Decimals handling */
TEST_LINE( Str(Max(10, 12) ) , " 12" )
TEST_LINE( Str(Max(10.50, 10) ) , " 10.50" )
TEST_LINE( Str(Max(10, 9.50) ) , " 10" )
TEST_LINE( Str(Max(100000, 10) ) , " 100000" )
TEST_LINE( Str(Max(20.50, 20.670) ) , " 20.670" )
TEST_LINE( Str(Max(20.5125, 20.670) ) , " 20.670" )
TEST_LINE( Str(Min(10, 12) ) , " 10" )
TEST_LINE( Str(Min(10.50, 10) ) , " 10" )
TEST_LINE( Str(Min(10, 9.50) ) , " 9.50" )
TEST_LINE( Str(Min(100000, 10) ) , " 10" )
TEST_LINE( Str(Min(20.50, 20.670) ) , " 20.50" )
TEST_LINE( Str(Min(20.5125, 20.670) ) , " 20.5125" )
TEST_LINE( Str(Val("1") ) , "1" )
TEST_LINE( Str(Val("15") ) , "15" )
TEST_LINE( Str(Val("200") ) , "200" )
TEST_LINE( Str(Val("15.0") ) , "15.0" )
TEST_LINE( Str(Val("15.00") ) , "15.00" )
TEST_LINE( Str(Year(SToD("19990905")) ) , " 1999" )
TEST_LINE( Str(Month(SToD("19990905")) ) , " 9" )
TEST_LINE( Str(Day(SToD("19990905")) ) , " 5" )
TEST_LINE( Str(10 ) , " 10" )
TEST_LINE( Str(15.0 ) , " 15.0" )
TEST_LINE( Str(10.1 ) , " 10.1" )
TEST_LINE( Str(15.00 ) , " 15.00" )
TEST_LINE( Str(Log(0) ) , "***********************" )
TEST_LINE( Str(100.2 * 200.12 ) , " 20052.024" )
TEST_LINE( Str(100.20 * 200.12 ) , " 20052.0240" )
TEST_LINE( Str(1000.2 * 200.12 ) , " 200160.024" )
TEST_LINE( Str(100/1000 ) , " 0.10" )
TEST_LINE( Str(100/100000 ) , " 0.00" )
TEST_LINE( Str(10 * 10 ) , " 100" )
TEST_LINE( Str(100 / 10 ) , " 10" )
TEST_LINE( Str(1234567890 * 1234567890 ) , " 1524157875019052000" )
/* (operators) */
TEST_LINE( 1 + NIL , "E BASE 1081 Argument error + F:S" )