diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 029005eade..7de497e28b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,59 @@ +19990831-17:40 GMT+1 Victor Szel + + * source/rtl/arrays.c + include/extend.h + ! Fixed handling of zero array index, it was allowed previously. + (hb_arrayGet*(), hb_arraySet()) + + Added hb_arrayError() which checks the pArray and ulIndex, if it's not + valid, it throws a runtime error. + * source/vm/hvm.c + ! Fixed where operations followed the hb_err*() call. + (hb_vmArrayAt(), hb_vmArrayPut(), hb_vmDo(), ...) + ! hb_vmPopLogical() was decrementing the stack but was only clearing it + when it was logical type. Leak fixed. (Is this correct ?) + * hb_vmAliasPop() -> hb_vmPopAlias() + hb_vmAliasPush() -> hb_vmPushAlias() + hb_vmAliasSwap() -> hb_vmSwapAlias() + Renamed to be consistent with the pcode name and with the others. + * tests/working/rtl_test.prg + tests/working/empty.prg (removed) + tests/working/strsub.prg (removed) + + Added many new tests, comments, enhancement. + + EMPTY.PRG, STRSUB.PRG incorporated. + ! Some TRANSFORM() test results changed (@0) + * source/rtl/devoutp.prg + % One local variable eliminated. + * source/vm/hvm.c + + Added value substitution for errors 1081, 1082, 1083, 1084, 1085, 1088 + * source/rtl/transfrm.c + + Put all stuff related to the @0 picture clause between + #ifndef HARBOUR_STRICT_CLIPPER_COMPATIBILITY guards, since this was + not in original Clipper, that's why the tests failed. + * source/rtl/set.c + ! Fixed "ON"/"OFF" error where OFF was not recognized, this bug was + introduced yesterday. + % Some variables scopes optimalized, some internals changed to standard + interface calls. + * source/rtl/errorapi.c + source/vm/hvm.c + include/extend.h + + Moved ERRORBLOCK() and errorBlock variable to errorapi.c, hb_errInit() + hb_errExit() added. All that is a *bit* slower, since only "official" + API calls are being used. + * source/runner/runlib.c + source/rtl/gtapi.c + source/vm/dynsym.c + source/vm/hvm.c + include/vm.api + include/fm.api + include/hbpp.h + include/gtapi.h + include/extend.h + include/hb_vmpub.h + include/hbdefs.h + * Formatting errors corrected. + + static variables prefixed with "s_" + 19990831-02:37 GMT+1 Bruno Cantero * include/rddapi.h source/rdd/dbcmd.c diff --git a/harbour/include/errorapi.h b/harbour/include/errorapi.h index b5382f6c29..4280a73225 100644 --- a/harbour/include/errorapi.h +++ b/harbour/include/errorapi.h @@ -95,7 +95,10 @@ extern PHB_ITEM hb_errPutSubSystem ( PHB_ITEM pError, char * szSubSystem ); extern PHB_ITEM hb_errPutTries ( PHB_ITEM pError, USHORT uiTries ); extern void hb_errRelease ( PHB_ITEM pError ); -/* Error launchers */ +/* Harbour additions */ + +extern void hb_errInit ( void ); +extern void hb_errExit ( void ); extern PHB_ITEM hb_errLaunchSubst ( PHB_ITEM pError ); diff --git a/harbour/include/extend.h b/harbour/include/extend.h index d3546ef272..7658eed845 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -38,24 +38,24 @@ #endif /* items types */ -#define IT_NIL ((WORD) 0x0000) -#define IT_INTEGER ((WORD) 0x0002) -#define IT_LONG ((WORD) 0x0008) -#define IT_DOUBLE ((WORD) 0x0010) -#define IT_DATE ((WORD) 0x0020) -#define IT_LOGICAL ((WORD) 0x0080) -#define IT_SYMBOL ((WORD) 0x0100) -#define IT_ALIAS ((WORD) 0x0200) -#define IT_STRING ((WORD) 0x0400) -#define IT_MEMOFLAG ((WORD) 0x0800) +#define IT_NIL ( ( WORD ) 0x0000 ) +#define IT_INTEGER ( ( WORD ) 0x0002 ) +#define IT_LONG ( ( WORD ) 0x0008 ) +#define IT_DOUBLE ( ( WORD ) 0x0010 ) +#define IT_DATE ( ( WORD ) 0x0020 ) +#define IT_LOGICAL ( ( WORD ) 0x0080 ) +#define IT_SYMBOL ( ( WORD ) 0x0100 ) +#define IT_ALIAS ( ( WORD ) 0x0200 ) +#define IT_STRING ( ( WORD ) 0x0400 ) +#define IT_MEMOFLAG ( ( WORD ) 0x0800 ) #define IT_MEMO ( IT_MEMOFLAG & IT_STRING ) -#define IT_BLOCK ((WORD) 0x1000) -#define IT_BYREF ((WORD) 0x2000) -#define IT_MEMVAR ((WORD) 0x4000) -#define IT_ARRAY ((WORD) 0x8000) +#define IT_BLOCK ( ( WORD ) 0x1000 ) +#define IT_BYREF ( ( WORD ) 0x2000 ) +#define IT_MEMVAR ( ( WORD ) 0x4000 ) +#define IT_ARRAY ( ( WORD ) 0x8000 ) #define IT_OBJECT IT_ARRAY #define IT_NUMERIC ( IT_INTEGER | IT_LONG | IT_DOUBLE ) -#define IT_ANY ((WORD) 0xFFFF) +#define IT_ANY ( ( WORD ) 0xFFFF ) /* forward declarations */ struct _HB_CODEBLOCK; @@ -128,7 +128,7 @@ struct hb_struRefer struct hb_struString { ULONG length; - char *value; + char * value; }; struct hb_struSymbol @@ -186,7 +186,7 @@ typedef struct /* internal structure for codeblocks */ typedef struct _HB_CODEBLOCK { - BYTE* pCode; /* codeblock pcode */ + BYTE * pCode; /* codeblock pcode */ PHB_ITEM pLocals; /* table with referenced local variables */ WORD wLocals; /* number of referenced local variables */ PHB_SYMB pSymbols; /* codeblocks symbols */ @@ -202,7 +202,6 @@ typedef struct _HB_VALUE extern STACK stack; extern HB_SYMB symEval; -extern HB_ITEM errorBlock; extern HB_ITEM aStatics; /* Extend API */ @@ -246,6 +245,7 @@ extern void * hb_xrealloc( void * pMem, ULONG lSize ); /* reallocates memory * extern ULONG hb_xsize( void * pMem ); /* returns the size of an allocated memory block */ /* array management */ +extern BOOL hb_arrayError( PHB_ITEM pArray, ULONG ulIndex, BOOL bAssign ); /* Checks if the passed parameters are valid, launches runtim error if needed */ extern void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ); /* creates a new array */ extern void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* retrieves an item */ extern ULONG hb_arrayLen( PHB_ITEM pArray ); /* retrives the array len */ @@ -268,13 +268,13 @@ extern void hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pItemValue ); #define HB_STRGREATER_LEFT 1 #define HB_STRGREATER_RIGHT 2 -extern int hb_stricmp( const char *s1, const char *s2 ); +extern int hb_stricmp( const char * s1, const char * s2 ); extern int hb_strgreater( char * sz1, char * sz2 ); extern void hb_strupr( char * szText ); extern BOOL hb_strMatchRegExp( char * szString, char * szMask ); extern BOOL hb_strEmpty( char * szText, ULONG ulLen ); extern char * hb_strDescend( char * szText, ULONG ulLen ); -extern ULONG hb_strAt(char *szSub, ULONG ulSubLen, char *szText, ULONG ulLen); +extern ULONG hb_strAt( char * szSub, ULONG ulSubLen, char * szText, ULONG ulLen ); extern char * hb_strUpper( char * szText, ULONG ulLen ); extern char * hb_strLower( char * szText, ULONG ulLen ); extern char * hb_strDescend( char * szText, ULONG ulLen ); @@ -329,3 +329,4 @@ extern char * hb_consoleGetNewLine( void ); extern char * hb_setColor( char * ); #endif /* HB_EXTEND_H_ */ + diff --git a/harbour/include/fm.api b/harbour/include/fm.api index 83f67547f8..d0c45e49a0 100644 --- a/harbour/include/fm.api +++ b/harbour/include/fm.api @@ -13,13 +13,13 @@ /* Functions */ -#define _xalloc hb_xalloc -#define _xgrab hb_xgrab -#define _xfree hb_xfree +#define _xalloc hb_xalloc +#define _xgrab hb_xgrab +#define _xfree hb_xfree /* Nant*cket Clipper Summer 87 compatible */ -#define _exmgrab hb_xgrab -#define _exmback(p, s) hb_xfree( p ) +#define _exmgrab hb_xgrab +#define _exmback( p, s ) hb_xfree( p ) #endif /* HB_FM_API_ */ diff --git a/harbour/include/gtapi.h b/harbour/include/gtapi.h index c370b70556..091b7a6bfb 100644 --- a/harbour/include/gtapi.h +++ b/harbour/include/gtapi.h @@ -102,7 +102,7 @@ extern void hb_gt_DrawShadow( char cTop, char cLeft, char cBottom, char cRight extern void hb_gt_DispBegin( void ); extern void hb_gt_DispEnd( void ); extern BOOL hb_gt_SetMode( USHORT uiRows, USHORT uiCols ); -extern BOOL hb_gt_GetBlink(void); -extern void hb_gt_SetBlink(BOOL bBlink); +extern BOOL hb_gt_GetBlink( void ); +extern void hb_gt_SetBlink( BOOL bBlink ); #endif /* HB_GTAPI_H_ */ diff --git a/harbour/include/hb_vmpub.h b/harbour/include/hb_vmpub.h index 98d8867db0..7088e0329a 100644 --- a/harbour/include/hb_vmpub.h +++ b/harbour/include/hb_vmpub.h @@ -63,14 +63,14 @@ typedef struct _HB_DYNS #define HB_DYNS_FUNC( hbfunc ) BOOL hbfunc( PHB_DYNS pDynSymbol ) typedef HB_DYNS_FUNC( PHB_DYNS_FUNC ); -/* Harbour Functions scope (SYMBOLSCOPE) */ -#define FS_PUBLIC ((SYMBOLSCOPE)0x00) -#define FS_STATIC ((SYMBOLSCOPE)0x02) -#define FS_INIT ((SYMBOLSCOPE)0x08) -#define FS_EXIT ((SYMBOLSCOPE)0x10) +/* Harbour Functions scope ( SYMBOLSCOPE ) */ +#define FS_PUBLIC ( ( SYMBOLSCOPE ) 0x00 ) +#define FS_STATIC ( ( SYMBOLSCOPE ) 0x02 ) +#define FS_INIT ( ( SYMBOLSCOPE ) 0x08 ) +#define FS_EXIT ( ( SYMBOLSCOPE ) 0x10 ) #define FS_INITEXIT ( FS_INIT | FS_EXIT ) -#define FS_MESSAGE ((SYMBOLSCOPE)0x20) -#define FS_MEMVAR ((SYMBOLSCOPE)0x80) +#define FS_MESSAGE ( ( SYMBOLSCOPE ) 0x20 ) +#define FS_MEMVAR ( ( SYMBOLSCOPE ) 0x80 ) extern void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ); /* invokes the virtual machine */ diff --git a/harbour/include/hbdefs.h b/harbour/include/hbdefs.h index 5aedc1fde8..cead380f20 100644 --- a/harbour/include/hbdefs.h +++ b/harbour/include/hbdefs.h @@ -79,10 +79,10 @@ typedef unsigned long DWORD; #endif /* __IBMCPP__ */ #ifndef MAX -#define MAX( a, b ) (( ( a ) > ( b ) ) ? ( a ) : ( b ) ) +#define MAX( a, b ) ( ( ( a ) > ( b ) ) ? ( a ) : ( b ) ) #endif #ifndef MIN -#define MIN( a, b ) (( ( a ) < ( b ) ) ? ( a ) : ( b ) ) +#define MIN( a, b ) ( ( ( a ) < ( b ) ) ? ( a ) : ( b ) ) #endif #ifdef __GNUC__ diff --git a/harbour/include/hbpp.h b/harbour/include/hbpp.h index ea678eb812..a567ece0e9 100644 --- a/harbour/include/hbpp.h +++ b/harbour/include/hbpp.h @@ -11,51 +11,51 @@ #include "hbdefs.h" typedef struct _PATHNAMES { /* the list of pathnames to search with #include */ - char *szPath; + char * szPath; struct _PATHNAMES *pNext; } PATHNAMES; struct _DEFINES; typedef struct _DEFINES { - char *name; - char *pars; + char * name; + char * pars; int npars; - char *value; - struct _DEFINES *last; + char * value; + struct _DEFINES * last; } DEFINES; struct _COMMANDS; typedef struct _COMMANDS { int com_or_xcom; - char *name; - char *mpatt; - char *value; - struct _COMMANDS *last; + char * name; + char * mpatt; + char * value; + struct _COMMANDS * last; } COMMANDS; #define STR_SIZE 8192 #define BUFF_SIZE 2048 -#define SKIPTABSPACES( sptr ) while ( *sptr == ' ' || *sptr == '\t' ) ( sptr )++ +#define SKIPTABSPACES( sptr ) while( *sptr == ' ' || *sptr == '\t' ) ( sptr )++ #define IS_OPT_SEP( c ) ( strchr( OS_OPT_DELIMITER_LIST, ( c ) ) != NULL ) /* HBPP.C exported functions */ -extern int ParseDirective( char* ); -extern int ParseExpression( char*, char* ); -extern int pp_RdStr(FILE*,char *,int,int,char*,int*,int*); -extern int pp_WrStr(FILE*,char *); -extern int strolen ( char* ); -extern int strocpy (char*, char* ); -extern char* strodup ( char * ); -extern DEFINES *AddDefine( char * szDefine, char * szValue ); /* add a new Lex define from the command line */ +extern int ParseDirective( char * ); +extern int ParseExpression( char *, char * ); +extern int pp_RdStr( FILE *, char *, int, int, char *, int *, int * ); +extern int pp_WrStr( FILE *, char * ); +extern int strolen( char * ); +extern int strocpy( char *, char * ); +extern char * strodup( char * ); +extern DEFINES * AddDefine( char * szDefine, char * szValue ); /* add a new Lex define from the command line */ /* HBPP.C exported variables */ extern int lInclude; -extern int *aCondCompile, nCondCompile; +extern int * aCondCompile, nCondCompile; extern int nline; extern char * _szPErrors[]; @@ -72,8 +72,8 @@ typedef struct char * szExtension; } HB_FNAME, * PHB_FNAME, * HB_FNAME_PTR; -extern PHB_FNAME hb_fsFNameSplit ( char * szFilename ); /* Split given filename into path, name and extension */ -extern char * hb_fsFNameMerge ( char * szFileName, PHB_FNAME pFileName ); /* This function joins path, name and extension into a string with a filename */ +extern PHB_FNAME hb_fsFNameSplit( char * szFilename ); /* Split given filename into path, name and extension */ +extern char * hb_fsFNameMerge( char * szFileName, PHB_FNAME pFileName ); /* This function joins path, name and extension into a string with a filename */ extern void * hb_xgrab( ULONG lSize ); /* allocates memory, exists on failure */ extern void * hb_xrealloc( void * pMem, ULONG lSize ); /* reallocates memory */ @@ -81,10 +81,10 @@ extern void hb_xfree( void * pMem ); /* frees memory */ /* Needed support variables, but not contained in HBPP.C */ -extern PATHNAMES *_pIncludePath; +extern PATHNAMES * _pIncludePath; extern PHB_FNAME _pFileName; -extern DEFINES *topDefine; -extern COMMANDS *topCommand; -extern COMMANDS *topTranslate; +extern DEFINES * topDefine; +extern COMMANDS * topCommand; +extern COMMANDS * topTranslate; #endif /* HB_PP_H_ */ diff --git a/harbour/include/vm.api b/harbour/include/vm.api index ebf04ee420..98d9b132c3 100644 --- a/harbour/include/vm.api +++ b/harbour/include/vm.api @@ -25,7 +25,7 @@ typedef void * HANDLE; #define _xvunwire( h ) /* dummy */ /* State */ -#define _xvlockcount( h ) (0) +#define _xvlockcount( h ) ( 0 ) #define _xvsize( h ) hb_xsize( h ) /* -------------------------------------------------------- */ @@ -34,12 +34,12 @@ typedef void * HANDLE; /* -------------------------------------------------------- */ /* Heap */ -#define _xvheapnew( size ) (0) +#define _xvheapnew( size ) ( 0 ) #define _xvheapdestroy( h ) /* dummy */ #define _xvheapresize( h, size ) /* dummy */ -#define _xvheapalloc( h, size ) (0) +#define _xvheapalloc( h, size ) ( 0 ) #define _xvheapfree( h, offset ) /* dummy */ -#define _xvheaplock( h, offset ) (0) +#define _xvheaplock( h, offset ) ( 0 ) #define _xvheapunlock( h, offset ) /* dummy */ #endif /* HB_VM_API_ */ diff --git a/harbour/source/rtl/arrays.c b/harbour/source/rtl/arrays.c index 3ae0cb60b1..3c2f60fe65 100644 --- a/harbour/source/rtl/arrays.c +++ b/harbour/source/rtl/arrays.c @@ -33,11 +33,40 @@ * Internal */ +BOOL hb_arrayError( PHB_ITEM pArray, ULONG ulIndex, BOOL bAssign ) +{ + BOOL bRetVal; + + if( IS_ARRAY( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + bRetVal = FALSE; + else + { + bRetVal = TRUE; + if( bAssign ) + hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); + else + hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + } + } + else + { + bRetVal = TRUE; + if( bAssign ) + hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); + else + hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + } + + return bRetVal; +} + char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; @@ -64,7 +93,7 @@ BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; @@ -93,7 +122,7 @@ double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; @@ -162,7 +191,7 @@ void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) hb_itemCopy( pItem, pArray->item.asArray.value->pItems + ( ulIndex - 1 ) ); else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); @@ -175,7 +204,7 @@ char * hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; @@ -195,7 +224,7 @@ ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; @@ -215,7 +244,7 @@ int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) { PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1; return pItem->type; @@ -252,7 +281,7 @@ void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ) { if( IS_ARRAY( pArray ) ) { - if( ulIndex <= hb_arrayLen( pArray ) ) + if( ulIndex > 0 && ulIndex <= hb_arrayLen( pArray ) ) hb_itemCopy( pArray->item.asArray.value->pItems + ( ulIndex - 1 ), pItem ); else hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); diff --git a/harbour/source/rtl/devoutp.prg b/harbour/source/rtl/devoutp.prg index 2ce8f6aa91..71590930b8 100644 --- a/harbour/source/rtl/devoutp.prg +++ b/harbour/source/rtl/devoutp.prg @@ -76,6 +76,5 @@ */ FUNCTION DEVOUTPICT( xValue, cPicture, cColor ) - LOCAL cText := TRANSFORM( xValue, cPicture ) - DEVOUT( cText, cColor ) + DEVOUT( TRANSFORM( xValue, cPicture ), cColor ) RETURN NIL diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 69a8b27dff..551aa1454b 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -30,9 +30,11 @@ hb_errGetFlags() hb_errPutFlags() hb_errRT_New() + hb_errRT_New_Subst() HB___ERRRT_BASE() hb_errRT_BASE() hb_errRT_BASE_Ext1() + hb_errRT_BASE_Subst() hb_errInternal() See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms. */ @@ -47,9 +49,10 @@ go into an infinite loop, this is an emulated version of the Clipper "Unrecoverable error 650: Processor stack fault" internal error, but better shows what is really the problem */ -#define ERROR_LAUNCH_MAX 8 +#define HB_ERROR_LAUNCH_MAX 8 -static int s_iLaunchCount = 0; +static int s_iLaunchCount = 0; +static HB_ITEM s_errorBlock; extern HARBOUR HB_ERRORNEW( void ); @@ -60,6 +63,31 @@ void hb_errForceLink() HB_ERRORNEW(); } +HARBOUR HB_ERRORBLOCK( void ) +{ + HB_ITEM oldError; + PHB_ITEM pNewErrorBlock = hb_param( 1, IT_BLOCK ); + + hb_itemClear( &oldError ); + hb_itemCopy( &oldError, &s_errorBlock ); + + if( pNewErrorBlock ) + hb_itemCopy( &s_errorBlock, pNewErrorBlock ); + + hb_itemReturn( &oldError ); + hb_itemClear( &oldError ); +} + +void hb_errInit( void ) +{ + hb_itemClear( &s_errorBlock ); +} + +void hb_errExit( void ) +{ + hb_itemClear( &s_errorBlock ); +} + PHB_ITEM hb_errNew( void ) { PHB_ITEM pReturn = hb_itemNew( NULL ); @@ -86,12 +114,12 @@ WORD hb_errLaunch( PHB_ITEM pError ) /* Check if we have a valid error handler */ - if( ! IS_BLOCK( &errorBlock ) ) + if( ! IS_BLOCK( &s_errorBlock ) ) hb_errInternal( 9999, "No ERRORBLOCK() for error", NULL, NULL ); /* Check if the error launcher was called too many times recursively */ - if( s_iLaunchCount == ERROR_LAUNCH_MAX ) + if( s_iLaunchCount == HB_ERROR_LAUNCH_MAX ) hb_errInternal( 9999, "Too many recursive error handler calls", NULL, NULL ); s_iLaunchCount++; @@ -101,7 +129,7 @@ WORD hb_errLaunch( PHB_ITEM pError ) pBlock = hb_itemNew( NULL ); pObject = hb_itemNew( NULL ); - hb_itemCopy( pBlock, &errorBlock ); + hb_itemCopy( pBlock, &s_errorBlock ); hb_itemCopy( pObject, pError ); hb_evalNew( &eval, pBlock ); @@ -178,12 +206,12 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) /* Check if we have a valid error handler */ - if( ! IS_BLOCK( &errorBlock ) ) + if( ! IS_BLOCK( &s_errorBlock ) ) hb_errInternal( 9999, "No ERRORBLOCK() for error", NULL, NULL ); /* Check if the error launcher was called too many times recursively */ - if( s_iLaunchCount == ERROR_LAUNCH_MAX ) + if( s_iLaunchCount == HB_ERROR_LAUNCH_MAX ) hb_errInternal( 9999, "Too many recursive ERRORBLOCK() calls", NULL, NULL ); s_iLaunchCount++; @@ -193,7 +221,7 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) pBlock = hb_itemNew( NULL ); pObject = hb_itemNew( NULL ); - hb_itemCopy( pBlock, &errorBlock ); + hb_itemCopy( pBlock, &s_errorBlock ); hb_itemCopy( pObject, pError ); hb_evalNew( &eval, pBlock ); @@ -252,7 +280,6 @@ PHB_ITEM hb_errPutDescription( PHB_ITEM pError, char * szDescription ) hb_vmPush( pError ); hb_vmPushString( szDescription, strlen( szDescription ) ); hb_vmDo( 1 ); - return pError; } @@ -456,8 +483,7 @@ PHB_ITEM hb_errPutFlags( PHB_ITEM pError, USHORT uiFlags ) /* Wrappers for hb_errLaunch() */ -static WORD hb_errRT_New -( +static WORD hb_errRT_New( USHORT uiSeverity, char * szSubSystem, ULONG ulGenCode, @@ -465,8 +491,7 @@ static WORD hb_errRT_New char * szDescription, char * szOperation, USHORT uiOsCode, - USHORT uiFlags -) + USHORT uiFlags ) { PHB_ITEM pError = hb_errNew(); WORD wRetVal; @@ -487,8 +512,7 @@ static WORD hb_errRT_New return wRetVal; } -static PHB_ITEM hb_errRT_New_Subst -( +static PHB_ITEM hb_errRT_New_Subst( USHORT uiSeverity, char * szSubSystem, ULONG ulGenCode, @@ -496,8 +520,7 @@ static PHB_ITEM hb_errRT_New_Subst char * szDescription, char * szOperation, USHORT uiOsCode, - USHORT uiFlags -) + USHORT uiFlags ) { PHB_ITEM pError = hb_errNew(); PHB_ITEM pRetVal; diff --git a/harbour/source/rtl/errorsys.prg b/harbour/source/rtl/errorsys.prg index e2477756fc..d1fb3fdbea 100644 --- a/harbour/source/rtl/errorsys.prg +++ b/harbour/source/rtl/errorsys.prg @@ -41,6 +41,14 @@ return //----------------------------------------------------------------------------// +procedure ErrorSys + + ErrorBlock( { | oError | DefError( oError ) } ) + +return + +//----------------------------------------------------------------------------// + static function DefError( oError ) LOCAL cMessage @@ -111,14 +119,6 @@ static function DefError( oError ) RETURN .F. -//----------------------------------------------------------------------------// - -procedure ErrorSys - - ErrorBlock( { | oError | DefError( oError ) } ) - -return - // [vszel] STATIC FUNCTION ErrorMessage(oError) diff --git a/harbour/source/rtl/gtapi.c b/harbour/source/rtl/gtapi.c index 1abee743c4..b668f2ab7d 100644 --- a/harbour/source/rtl/gtapi.c +++ b/harbour/source/rtl/gtapi.c @@ -132,14 +132,16 @@ int hb_gtBox( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, char if( uiTop > uiMRow || uiBottom > uiMRow || uiLeft > uiMCol || uiRight > uiMCol ) { - return 1; + return 1; } /* For full compatibility, pad box string with last char if too short */ cPadChar = ' '; - for( tmp = 0; *pbyFrame && tmp < 9; tmp++ ) cPadChar = pszBox[ tmp ] = *pbyFrame++; - while( tmp < 8 ) pszBox[ tmp++ ] = cPadChar; + for( tmp = 0; *pbyFrame && tmp < 9; tmp++ ) + cPadChar = pszBox[ tmp ] = *pbyFrame++; + while( tmp < 8 ) + pszBox[ tmp++ ] = cPadChar; pszBox[ tmp ] = '\0'; /* Ensure that box is drawn from top left to bottom right. */ @@ -178,27 +180,27 @@ int hb_gtBox( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, char { hb_gtRepChar( uiRow, uiCol, pszBox[ 1 ], uiRight - uiLeft + ( height > 1 ? -1 : 1 ) ); if( height > 1 ) - hb_gtRepChar( uiBottom, uiCol, pszBox[ 5 ], uiRight - uiLeft + ( height > 1 ? -1 : 1 ) ); + hb_gtRepChar( uiBottom, uiCol, pszBox[ 5 ], uiRight - uiLeft + ( height > 1 ? -1 : 1 ) ); } if( pszBox[ 8 ] && height > 2 && width > 2 ) { - for( uiRow = uiTop + 1; uiRow < uiBottom; uiRow++ ) - { - uiCol = uiLeft; - hb_gtWriteAt( uiRow, uiCol++, pszBox + 7, sizeof( BYTE ) ); - hb_gtRepChar( uiRow, uiCol , pszBox[ 8 ], uiRight - uiLeft - 1 ); - hb_gtWriteAt( uiRow, uiRight, pszBox + 3, sizeof( BYTE ) ); - } + for( uiRow = uiTop + 1; uiRow < uiBottom; uiRow++ ) + { + uiCol = uiLeft; + hb_gtWriteAt( uiRow, uiCol++, pszBox + 7, sizeof( BYTE ) ); + hb_gtRepChar( uiRow, uiCol , pszBox[ 8 ], uiRight - uiLeft - 1 ); + hb_gtWriteAt( uiRow, uiRight, pszBox + 3, sizeof( BYTE ) ); + } } else { - for( uiRow = ( width > 1 ? uiTop + 1 : uiTop ); uiRow < ( width > 1 ? uiBottom : uiBottom + 1 ); uiRow++ ) - { - hb_gtWriteAt( uiRow, uiLeft, pszBox + 7, sizeof( BYTE ) ); - if( width > 1 ) - hb_gtWriteAt( uiRow, uiRight, pszBox + 3, sizeof( BYTE ) ); - } + for( uiRow = ( width > 1 ? uiTop + 1 : uiTop ); uiRow < ( width > 1 ? uiBottom : uiBottom + 1 ); uiRow++ ) + { + hb_gtWriteAt( uiRow, uiLeft, pszBox + 7, sizeof( BYTE ) ); + if( width > 1 ) + hb_gtWriteAt( uiRow, uiRight, pszBox + 3, sizeof( BYTE ) ); + } } /* speed issue for now */ @@ -222,9 +224,9 @@ int hb_gtBoxS( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight ) int hb_gtColorSelect(USHORT uiColorIndex) { if( uiColorIndex > s_ColorCount ) - return 1; + return 1; else - s_uiColorIndex = uiColorIndex; + s_uiColorIndex = uiColorIndex; return 0; } @@ -533,7 +535,7 @@ int hb_gtGetCursor( USHORT * uipCursorShape ) if( i <= SC_SPECIAL2 ) { - * uipCursorShape = i; + *uipCursorShape = i; } else { @@ -594,15 +596,15 @@ int hb_gtRectSize( USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, USHORT uiMCol = s_uiMaxCol; if( uiBottom > uiMRow ) - uiBottom = uiMRow; + uiBottom = uiMRow; if( uiRight > uiMCol ) - uiRight = uiMCol; + uiRight = uiMCol; if( uiTop > uiMRow || uiBottom > uiMRow || uiLeft > uiMCol || uiRight > uiMCol || uiTop > uiBottom || uiLeft > uiRight ) { - return 1; + return 1; } *uipBuffSize = ( uiBottom - uiTop + 1 ) * ( uiRight - uiLeft + 1 ) * 2; diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index e26b1282e7..a8edbc0039 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -187,22 +187,19 @@ static BOOL set_logical( PHB_ITEM pItem ) { BOOL logical = FALSE; - if( IS_LOGICAL( pItem ) ) logical = pItem->item.asLogical.value; + if( IS_LOGICAL( pItem ) ) + logical = pItem->item.asLogical.value; else if( IS_STRING( pItem ) ) { - if( pItem->item.asString.length >= 2 ) - { - if( toupper( pItem->item.asString.value[ 0 ] ) == 'O' - && toupper( pItem->item.asString.value[ 1 ] ) == 'N' ) - logical = TRUE; - } - else if( pItem->item.asString.length >= 3 ) - { - if( toupper( pItem->item.asString.value[ 0 ] ) == 'O' - && toupper( pItem->item.asString.value[ 1 ] ) == 'F' - && toupper( pItem->item.asString.value[ 2 ] ) == 'F' ) - logical = FALSE; - } + if( pItem->item.asString.length >= 2 + && toupper( pItem->item.asString.value[ 0 ] ) == 'O' + && toupper( pItem->item.asString.value[ 1 ] ) == 'N' ) + logical = TRUE; + else if( pItem->item.asString.length >= 3 + && toupper( pItem->item.asString.value[ 0 ] ) == 'O' + && toupper( pItem->item.asString.value[ 1 ] ) == 'F' + && toupper( pItem->item.asString.value[ 2 ] ) == 'F' ) + logical = FALSE; } return logical; @@ -337,40 +334,39 @@ static int open_handle( char * file_name, BOOL bMode, char * def_ext, HB_set_enu */ HARBOUR HB___SETCENTURY( void ) { - int count, digit, size, y_size, y_start, y_stop; int old_century_setting = hb_set_century; - PHB_ITEM pItem = hb_param( 1, IT_ANY ); - char * szDateFormat, * szNewFormat; - /* Start by returning the current setting */ - hb_retl( hb_set_century ); /* - * Then change the setting if the parameter is a logical value, or is + * Change the setting if the parameter is a logical value, or is * either "ON" or "OFF" (regardless of case) */ - if( pItem && IS_LOGICAL( pItem ) ) hb_set_century = pItem->item.asLogical.value; - else if( pItem && IS_STRING( pItem ) ) + if( ISLOG( 1 ) ) + hb_set_century = hb_parl( 1 ); + else if( ISCHAR( 1 ) ) { - if( pItem->item.asString.length >= 2 ) - { - if( toupper( pItem->item.asString.value[ 0 ] ) == 'O' - && toupper( pItem->item.asString.value[ 1 ] ) == 'N' ) - hb_set_century = TRUE; - } - else if( pItem->item.asString.length >= 3 ) - { - if( toupper ( pItem->item.asString.value[ 0 ] ) == 'O' - && toupper ( pItem->item.asString.value[ 1 ] ) == 'F' - && toupper ( pItem->item.asString.value[ 2 ] ) == 'F' ) - hb_set_century = FALSE; - } + char * szString = hb_parc( 1 ); + ULONG ulLen = hb_parclen( 1 ); + + if( ulLen >= 2 + && toupper( szString[ 0 ] ) == 'O' + && toupper( szString[ 1 ] ) == 'N' ) + hb_set_century = TRUE; + else if( ulLen >= 3 + && toupper( szString[ 0 ] ) == 'O' + && toupper( szString[ 1 ] ) == 'F' + && toupper( szString[ 2 ] ) == 'F' ) + hb_set_century = FALSE; } + /* * Finally, if the setting changed, adjust the current date format to use * the correct number of year digits. */ if( old_century_setting != hb_set_century ) { + int count, digit, size, y_size, y_start, y_stop; + char * szDateFormat, * szNewFormat; + /* Convert to upper case and determine where year is */ y_start = y_stop = -1; szDateFormat = hb_set.HB_SET_DATEFORMAT; @@ -412,6 +408,9 @@ HARBOUR HB___SETCENTURY( void ) hb_set.HB_SET_DATEFORMAT = szNewFormat; } } + + /* Return the previous setting */ + hb_retl( old_century_setting ); } /* $DOC$ diff --git a/harbour/source/rtl/transfrm.c b/harbour/source/rtl/transfrm.c index d1db0e2e93..8ccc63fc3a 100644 --- a/harbour/source/rtl/transfrm.c +++ b/harbour/source/rtl/transfrm.c @@ -56,7 +56,9 @@ #define PF_LEFT 0x0001 /* @B */ #define PF_CREDIT 0x0002 /* @C */ #define PF_DEBIT 0x0004 /* @X */ +#ifndef HARBOUR_STRICT_CLIPPER_COMPATIBILITY #define PF_ZERO 0x0008 /* @0 */ +#endif #define PF_PARNEG 0x0010 /* @( */ #define PF_REMAIN 0x0020 /* @R */ #define PF_UPPER 0x0040 /* @! */ @@ -114,9 +116,11 @@ static WORD PictFunc( char **szPict, ULONG *pulPicLen ) case '(': wPicFlags |= PF_PARNEG; break; +#ifndef HARBOUR_STRICT_CLIPPER_COMPATIBILITY case '0': wPicFlags |= PF_ZERO; break; +#endif case 'B': wPicFlags |= PF_LEFT; break; @@ -228,18 +232,23 @@ static char * NumPicture( char *szPic, ULONG ulPic, WORD wPicFlags, double dValu szStr = pItem->item.asString.value; iCount = 0; - if( wPicFlags & PF_ZERO ) /* Pad with Zero's */ +#ifndef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + /* Pad with Zero's */ + if( wPicFlags & PF_ZERO ) { for( i = 0; szStr[ i ] == ' ' && i < iWidth; i++ ) szStr[ i ] = '0'; } +#endif + + /* Suppress empty value */ if( bEmpty && pItem->item.asString.length ) - /* Suppress empty value */ { szStr[ pItem->item.asString.length - 1 ] = ' '; } - if( wPicFlags & PF_LEFT ) /* Left align */ + /* Left align */ + if( wPicFlags & PF_LEFT ) { for( i = 0; szStr[ i ] == ' ' && i <= iWidth; i++ ); /* Find first non-space */ diff --git a/harbour/source/runner/runlib.c b/harbour/source/runner/runlib.c index c64fa4bceb..2544eaeb7c 100644 --- a/harbour/source/runner/runlib.c +++ b/harbour/source/runner/runlib.c @@ -46,7 +46,7 @@ static BYTE prgFunction[] = { 0x68, 0x00, 0x00, 0x00, 0x00, add esp, 8 ret near */ - /* This is the assembler output from : hb_vmExecute(pcode,symbols). */ + /* This is the assembler output from : hb_vmExecute( pcode, symbols ). */ /* #elseif INTEL16 */ /* #elseif MOTOROLA */ @@ -114,9 +114,9 @@ HARBOUR HB___HRBRUN( void ) /* Open as binary */ - while ((file = hb_hrbFileOpen( szFileName )) == NULL) + while ( ( file = hb_hrbFileOpen( szFileName ) ) == NULL ) { - if ( hb_errRT_BASE_Ext1( EG_OPEN, 9999, NULL, szFileName, 0, EF_CANDEFAULT | EF_CANRETRY ) == E_DEFAULT ) + if( hb_errRT_BASE_Ext1( EG_OPEN, 9999, NULL, szFileName, 0, EF_CANDEFAULT | EF_CANRETRY ) == E_DEFAULT ) { break; } @@ -140,17 +140,17 @@ HARBOUR HB___HRBRUN( void ) ulSymbols = hb_hrbFileReadLong( file, szFileName ); pSymRead = ( PHB_SYMB )hb_xgrab( ulSymbols * sizeof( HB_SYMB ) ); - for( ul=0; ul < ulSymbols; ul++) /* Read symbols in .HRB */ + for( ul = 0; ul < ulSymbols; ul++ ) /* Read symbols in .HRB */ { pSymRead[ ul ].szName = hb_hrbFileReadId( file, szFileName ); pSymRead[ ul ].cScope = hb_hrbFileReadByte( file, szFileName ); - pSymRead[ ul ].pFunPtr = ( PHB_FUNC ) (ULONG) hb_hrbFileReadByte( file, szFileName ); + pSymRead[ ul ].pFunPtr = ( PHB_FUNC ) ( ULONG ) hb_hrbFileReadByte( file, szFileName ); pSymRead[ ul ].pDynSym = NULL; } ulFuncs = hb_hrbFileReadLong( file, szFileName ); /* Read number of functions */ pDynFunc = ( PHB_DYNF ) hb_xgrab( ulFuncs * sizeof( HB_DYNF ) ); - for( ul=0; ul < ulFuncs; ul++) /* Read symbols in .HRB */ + for( ul = 0; ul < ulFuncs; ul++ ) /* Read symbols in .HRB */ { pDynFunc[ ul ].szName = hb_hrbFileReadId( file, szFileName ); @@ -168,7 +168,7 @@ HARBOUR HB___HRBRUN( void ) s_ulSymEntry = 0; for( ul = 0; ul < ulSymbols; ul++ ) /* Linker */ { - if( ( (ULONG) pSymRead[ ul ].pFunPtr ) == SYM_FUNC ) + if( ( ( ULONG ) pSymRead[ ul ].pFunPtr ) == SYM_FUNC ) { ulPos = hb_hrbFindSymbol( pSymRead[ ul ].szName, pDynFunc, ulFuncs ); if( ulPos != SYM_NOT_FOUND ) @@ -185,7 +185,7 @@ HARBOUR HB___HRBRUN( void ) else pSymRead[ ul ].pFunPtr = ( PHB_FUNC ) SYM_EXTERN; } - if( ( (ULONG) pSymRead[ ul ].pFunPtr ) == SYM_EXTERN ) + if( ( ( ULONG ) pSymRead[ ul ].pFunPtr ) == SYM_EXTERN ) { /* External function */ pDynSym = hb_dynsymFind( pSymRead[ ul ].szName ); if( !pDynSym ) @@ -218,7 +218,7 @@ HARBOUR HB___HRBRUN( void ) { hb_vmPushSymbol( pSymRead + ul ); hb_vmPushNil(); - for( i = 0; i < (hb_pcount() - 1); i++ ) + for( i = 0; i < ( hb_pcount() - 1 ); i++ ) hb_vmPush( hb_param( i + 2, IT_ANY ) ); /* Push other cmdline params*/ hb_vmDo( hb_pcount() - 1 ); /* Run init function */ @@ -227,7 +227,7 @@ HARBOUR HB___HRBRUN( void ) hb_vmPushSymbol( pSymRead ); hb_vmPushNil(); - for( i = 0; i < (hb_pcount() - 1); i++ ) + for( i = 0; i < ( hb_pcount() - 1 ); i++ ) hb_vmPush( hb_param( i + 2, IT_ANY ) ); /* Push other cmdline params*/ hb_vmDo( hb_pcount() - 1 ); /* Run the thing !!! */ @@ -318,7 +318,7 @@ static char * hb_hrbFileReadId( FILE *file, char * szFileName ) bCont = FALSE; } while( bCont ); - szRet = (char *) hb_xgrab( szIdx - szTemp + 1 ); + szRet = ( char * ) hb_xgrab( szIdx - szTemp + 1 ); strcpy( szRet, szTemp ); hb_xfree( szTemp ); @@ -330,7 +330,7 @@ static BYTE hb_hrbFileReadByte( FILE *file, char * szFileName ) { BYTE bRet; - hb_hrbFileRead( file, szFileName, &bRet, 1, 1); + hb_hrbFileRead( file, szFileName, &bRet, 1, 1 ); return bRet; } @@ -338,20 +338,20 @@ static BYTE hb_hrbFileReadByte( FILE *file, char * szFileName ) static long hb_hrbFileReadLong( FILE *file, char * szFileName ) { - char cLong[4]; /* Temporary long */ + char cLong[ 4 ]; /* Temporary long */ hb_hrbFileRead( file, szFileName, cLong, 4, 1 ); - if( cLong[3] ) /* Convert to long if ok */ + if( cLong[ 3 ] ) /* Convert to long if ok */ { hb_errRT_BASE_Ext1( EG_READ, 9999, NULL, szFileName, 0, EF_NONE ); return 0; } else - return ( (BYTE) cLong[0] ) + - ( (BYTE) cLong[1] ) * 0x100 + - ( (BYTE) cLong[2] ) * 0x10000 + - ( (BYTE) cLong[3] ) * 0x1000000 ; + return ( ( BYTE ) cLong[ 0 ] ) + + ( ( BYTE ) cLong[ 1 ] ) * 0x100 + + ( ( BYTE ) cLong[ 2 ] ) * 0x10000 + + ( ( BYTE ) cLong[ 3 ] ) * 0x1000000 ; } @@ -359,7 +359,7 @@ static long hb_hrbFileReadLong( FILE *file, char * szFileName ) Controlled read from file. If errornous -> Break */ static void hb_hrbFileRead( FILE *file, char * szFileName, char *cBuffer, int iSize, int iCount ) { - if( iCount != (int) fread( cBuffer, iSize, iCount, file ) ) + if( iCount != ( int ) fread( cBuffer, iSize, iCount, file ) ) { /* Read error */ hb_errRT_BASE_Ext1( EG_READ, 9999, NULL, szFileName, 0, EF_NONE ); } @@ -399,15 +399,15 @@ static void hb_hrbFileClose( FILE *file ) */ static PASM_CALL hb_hrbAsmCreateFun( PHB_SYMB pSymbols, BYTE * pCode ) { - PASM_CALL asmRet = (PASM_CALL) hb_xgrab( sizeof( ASM_CALL ) ); + PASM_CALL asmRet = ( PASM_CALL ) hb_xgrab( sizeof( ASM_CALL ) ); - asmRet->pAsmData = (BYTE * ) hb_xgrab( sizeof( prgFunction ) ); + asmRet->pAsmData = ( BYTE * ) hb_xgrab( sizeof( prgFunction ) ); memcpy( asmRet->pAsmData, prgFunction, sizeof( prgFunction ) ); /* Copy new assembler code in */ /* #if INTEL32 */ - hb_hrbAsmPatch( asmRet->pAsmData, 1, pSymbols ); /* Insert pointer to testsym */ - hb_hrbAsmPatch( asmRet->pAsmData, 6, pCode); /* Insert pointer to testcode */ + hb_hrbAsmPatch( asmRet->pAsmData, 1, pSymbols ); /* Insert pointer to testsym */ + hb_hrbAsmPatch( asmRet->pAsmData, 6, pCode ); /* Insert pointer to testcode */ hb_hrbAsmPatchRelative( asmRet->pAsmData, 11, &hb_vmExecute, 15 ); /* Insert pointer to hb_vmExecute() */ @@ -423,10 +423,10 @@ static void hb_hrbAsmPatch( BYTE * pCode, ULONG ulOffset, void *Address ) { /* #if 32 bits and low byte first */ - pCode[ ulOffset ] = ( (ULONG) Address ) & 0xFF; - pCode[ ulOffset + 1 ] = ( (ULONG) Address >> 8 ) & 0xFF; - pCode[ ulOffset + 2 ] = ( (ULONG) Address >> 16 ) & 0xFF; - pCode[ ulOffset + 3 ] = ( (ULONG) Address >> 24 ) & 0xFF; + pCode[ ulOffset ] = ( ( ULONG ) Address ) & 0xFF; + pCode[ ulOffset + 1 ] = ( ( ULONG ) Address >> 8 ) & 0xFF; + pCode[ ulOffset + 2 ] = ( ( ULONG ) Address >> 16 ) & 0xFF; + pCode[ ulOffset + 3 ] = ( ( ULONG ) Address >> 24 ) & 0xFF; /* #elseif 16 bits and low byte first */ /* #elseif 32 bits and high byte first */ @@ -440,9 +440,9 @@ static void hb_hrbAsmPatchRelative( BYTE * pCode, ULONG ulOffset, void * Address, ULONG ulNext ) { /* #if 32 bits and low byte first */ - ULONG ulBase = (ULONG) pCode + ulNext; + ULONG ulBase = ( ULONG ) pCode + ulNext; /* Relative to next instruction */ - ULONG ulRelative = (ULONG) Address - ulBase; + ULONG ulRelative = ( ULONG ) Address - ulBase; pCode[ ulOffset ] = ( ulRelative ) & 0xFF; pCode[ ulOffset + 1 ] = ( ulRelative >> 8 ) & 0xFF; diff --git a/harbour/source/vm/dynsym.c b/harbour/source/vm/dynsym.c index d225febfc9..999fb532ca 100644 --- a/harbour/source/vm/dynsym.c +++ b/harbour/source/vm/dynsym.c @@ -28,16 +28,16 @@ #include "extend.h" -#define SYM_ALLOCATED ((SYMBOLSCOPE)-1) +#define SYM_ALLOCATED ( ( SYMBOLSCOPE ) -1 ) typedef struct { PHB_DYNS pDynSym; /* Pointer to dynamic symbol */ } DYNHB_ITEM, * PDYNHB_ITEM, * DYNHB_ITEM_PTR; -static PDYNHB_ITEM pDynItems = NULL; /* Pointer to dynamic items */ -static WORD wDynSymbols = 0; /* Number of symbols present */ -static WORD wClosestDynSym = 0; +static PDYNHB_ITEM s_pDynItems = NULL; /* Pointer to dynamic items */ +static WORD s_wDynSymbols = 0; /* Number of symbols present */ +static WORD s_wClosestDynSym = 0; /* Closest symbol for match. hb_dynsymFind() will search for the name. */ /* If it cannot find the name, it positions itself to the */ /* closest symbol. */ @@ -46,8 +46,8 @@ void hb_dynsymLog( void ) { WORD w; - for( w = 0; w < wDynSymbols; w++ ) /* For all dynamic symbols */ - printf( "%i %s\n", w + 1, pDynItems[ w ].pDynSym->pSymbol->szName ); + for( w = 0; w < s_wDynSymbols; w++ ) /* For all dynamic symbols */ + printf( "%i %s\n", w + 1, s_pDynItems[ w ].pDynSym->pSymbol->szName ); } PHB_SYMB hb_symbolNew( char * szName ) /* Create a new symbol */ @@ -78,26 +78,26 @@ PHB_DYNS hb_dynsymNew( PHB_SYMB pSymbol ) /* creates a new dynamic symbol */ return pDynSym; /* Return pointer to DynSym */ } - if( wDynSymbols == 0 ) /* Do we have any symbols ? */ - pDynSym = pDynItems[ 0 ].pDynSym; /* Point to first symbol */ + if( s_wDynSymbols == 0 ) /* Do we have any symbols ? */ + pDynSym = s_pDynItems[ 0 ].pDynSym; /* Point to first symbol */ /* *<1>* Remember we already got this one */ else { /* We want more symbols ! */ - pDynItems = ( PDYNHB_ITEM ) hb_xrealloc( pDynItems, ( wDynSymbols + 1 ) * sizeof( DYNHB_ITEM ) ); + s_pDynItems = ( PDYNHB_ITEM ) hb_xrealloc( s_pDynItems, ( s_wDynSymbols + 1 ) * sizeof( DYNHB_ITEM ) ); - if( wClosestDynSym <= wDynSymbols ) /* Closest < current !! */ + if( s_wClosestDynSym <= s_wDynSymbols ) /* Closest < current !! */ { /* Here it goes :-) */ WORD w; - for( w = 0; w < ( wDynSymbols - wClosestDynSym ); w++ ) - memcpy( &pDynItems[ wDynSymbols - w ], - &pDynItems[ wDynSymbols - w - 1 ], sizeof( DYNHB_ITEM ) ); + for( w = 0; w < ( s_wDynSymbols - s_wClosestDynSym ); w++ ) + memcpy( &s_pDynItems[ s_wDynSymbols - w ], + &s_pDynItems[ s_wDynSymbols - w - 1 ], sizeof( DYNHB_ITEM ) ); } /* Insert element in array */ pDynSym = ( PHB_DYNS ) hb_xgrab( sizeof( HB_DYNS ) ); - pDynItems[ wClosestDynSym ].pDynSym = pDynSym; /* Enter DynSym */ + s_pDynItems[ s_wClosestDynSym ].pDynSym = pDynSym; /* Enter DynSym */ } - wDynSymbols++; /* Got one more symbol */ + s_wDynSymbols++; /* Got one more symbol */ pDynSym->pSymbol = pSymbol; pDynSym->hMemvar = 0; pDynSym->hArea = 0; @@ -134,21 +134,21 @@ PHB_DYNS hb_dynsymGet( char * szName ) /* finds and creates a symbol if not fou PHB_DYNS hb_dynsymFind( char * szName ) { - if( ! pDynItems ) + if( s_pDynItems == NULL ) { - pDynItems = ( PDYNHB_ITEM ) hb_xgrab( sizeof( DYNHB_ITEM ) ); /* Grab array */ - pDynItems->pDynSym = ( PHB_DYNS ) hb_xgrab( sizeof( HB_DYNS ) ); + s_pDynItems = ( PDYNHB_ITEM ) hb_xgrab( sizeof( DYNHB_ITEM ) ); /* Grab array */ + s_pDynItems->pDynSym = ( PHB_DYNS ) hb_xgrab( sizeof( HB_DYNS ) ); /* Always grab a first symbol. Never an empty bucket. *<1>* */ - pDynItems->pDynSym->hMemvar = 0; - pDynItems->pDynSym->pSymbol = NULL; - pDynItems->pDynSym->pFunPtr = NULL; + s_pDynItems->pDynSym->hMemvar = 0; + s_pDynItems->pDynSym->pSymbol = NULL; + s_pDynItems->pDynSym->pFunPtr = NULL; return NULL; } else { /* Classic Tree Insert Sort Mechanism * * Insert Sort means the new item is entered alphabetically into - * the array. In this case pDynItems ! + * the array. In this case s_pDynItems ! * * 1) We start in the middle of the array. * 2a) If the symbols are equal -> we have found the symbol !! @@ -164,26 +164,26 @@ PHB_DYNS hb_dynsymFind( char * szName ) */ WORD wFirst = 0; - WORD wLast = wDynSymbols; + WORD wLast = s_wDynSymbols; WORD wMiddle = wLast / 2; - wClosestDynSym = wMiddle; /* Start in the middle */ + s_wClosestDynSym = wMiddle; /* Start in the middle */ while( wFirst < wLast ) { - switch( hb_strgreater( pDynItems[ wMiddle ].pDynSym->pSymbol->szName, szName ) ) + switch( hb_strgreater( s_pDynItems[ wMiddle ].pDynSym->pSymbol->szName, szName ) ) { case HB_STRGREATER_EQUAL: /* they are equals */ - return pDynItems[ wMiddle ].pDynSym; + return s_pDynItems[ wMiddle ].pDynSym; case HB_STRGREATER_LEFT: /* pMiddle is greater */ wLast = wMiddle; - wClosestDynSym = wMiddle; + s_wClosestDynSym = wMiddle; break; case HB_STRGREATER_RIGHT: /* szName is greater */ wFirst = wMiddle + 1; - wClosestDynSym = wFirst; + s_wClosestDynSym = wFirst; break; } wMiddle = wFirst + ( ( wLast - wFirst ) / 2 ); @@ -197,8 +197,8 @@ void hb_dynsymEval( PHB_DYNS_FUNC pFunction ) BOOL bCont = TRUE; WORD i; - for( i = 0; i < wDynSymbols && bCont; i++ ) - bCont = (pFunction)( pDynItems[ i ].pDynSym ); + for( i = 0; i < s_wDynSymbols && bCont; i++ ) + bCont = ( pFunction )( s_pDynItems[ i ].pDynSym ); } @@ -206,29 +206,29 @@ void hb_dynsymRelease( void ) { WORD w; - for( w = 0; w < wDynSymbols; w++ ) + for( w = 0; w < s_wDynSymbols; w++ ) { /* it is a allocated symbol ? */ - if( ( pDynItems + w )->pDynSym->pSymbol->cScope == (SYMBOLSCOPE)SYM_ALLOCATED ) + if( ( s_pDynItems + w )->pDynSym->pSymbol->cScope == SYM_ALLOCATED ) { - hb_xfree( ( pDynItems + w )->pDynSym->pSymbol->szName ); - hb_xfree( ( pDynItems + w )->pDynSym->pSymbol ); + hb_xfree( ( s_pDynItems + w )->pDynSym->pSymbol->szName ); + hb_xfree( ( s_pDynItems + w )->pDynSym->pSymbol ); } - hb_xfree( ( pDynItems + w )->pDynSym ); + hb_xfree( ( s_pDynItems + w )->pDynSym ); } - hb_xfree( pDynItems ); + hb_xfree( s_pDynItems ); } HARBOUR HB___DYNSCOUNT( void ) /* How much symbols do we have: dsCount = __dynsymCount() */ { - hb_retnl( wDynSymbols ); + hb_retnl( s_wDynSymbols ); } HARBOUR HB___DYNSGETNAME( void ) /* Get name of symbol: cSymbol = __dynsymGetName( dsIndex ) */ { - hb_retc( pDynItems[ hb_parnl( 1 ) - 1 ].pDynSym->pSymbol->szName ); + hb_retc( s_pDynItems[ hb_parnl( 1 ) - 1 ].pDynSym->pSymbol->szName ); } HARBOUR HB___DYNSGETINDEX( void ) /* Gimme index number of symbol: dsIndex = __dynsymGetIndex( cSymbol ) */ diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 08f0a7bd1b..ffcfed3f58 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -27,7 +27,7 @@ #include #ifndef __MPW__ - #include + #include #endif #include @@ -52,13 +52,13 @@ typedef struct _SYMBOLS extern HARBOUR HB_ERRORSYS( void ); extern HARBOUR HB_ERRORNEW( void ); -static void hb_vmAliasPop( void ); /* pops the workarea number form the eval stack */ -static void hb_vmAliasPush( void ); /* pushes the current workarea number */ -static void hb_vmAliasSwap( void ); /* swaps items on the eval stack and pops the workarea number */ +static void hb_vmPopAlias( void ); /* pops the workarea number form the eval stack */ static void hb_vmPopAliasedField( PHB_SYMB ); /* pops an aliased field from the eval stack*/ static void hb_vmPopField( PHB_SYMB ); /* pops an unaliased field from the eval stack */ +static void hb_vmPushAlias( void ); /* pushes the current workarea number */ static void hb_vmPushAliasedField( PHB_SYMB ); /* pushes an aliased field on the eval stack */ static void hb_vmPushField( PHB_SYMB ); /* pushes an unaliased field on the eval stack */ +static void hb_vmSwapAlias( void ); /* swaps items on the eval stack and pops the workarea number */ static void hb_vmDoInitStatics( void ); /* executes all _INITSTATICS functions */ static void hb_vmDoInitFunctions( int argc, char * argv[] ); /* executes all defined PRGs INIT functions */ @@ -88,19 +88,18 @@ extern POBJSYMBOLS HB_FIRSTSYMBOL, HB_LASTSYMBOL; STACK stack; HB_SYMB symEval = { "__EVAL", FS_PUBLIC, hb_vmDoBlock, 0 }; /* symbol to evaluate codeblocks */ -HB_ITEM errorBlock; /* errorblock */ HB_ITEM aStatics; /* Harbour array to hold all application statics variables */ -static BOOL bDebugging = FALSE; -static BOOL bDebugShowLines = FALSE; /* update source code line on the debugger display */ -static PHB_SYMB pSymStart; /* start symbol of the application. MAIN() is not required */ -static PSYMBOLS pSymbols = NULL; /* to hold a linked list of all different modules symbol tables */ -static BYTE byErrorLevel = 0; /* application exit errorlevel */ +static BOOL s_bDebugging = FALSE; +static BOOL s_bDebugShowLines = FALSE; /* update source code line on the debugger display */ +static PHB_SYMB s_pSymStart = NULL; /* start symbol of the application. MAIN() is not required */ +static PSYMBOLS s_pSymbols = NULL; /* to hold a linked list of all different modules symbol tables */ +static BYTE s_byErrorLevel = 0; /* application exit errorlevel */ /* Stores the position on the stack of current SEQUENCE envelope or 0 if no * SEQUENCE is active */ -static LONG RecoverBase = 0; +static LONG s_lRecoverBase = 0; #define HB_RECOVER_STATE -1 #define HB_RECOVER_BASE -2 #define HB_RECOVER_ADDRESS -3 @@ -108,7 +107,7 @@ static LONG RecoverBase = 0; /* Request for some action - stop processing of opcodes */ -static WORD wActionRequest = 0; +static WORD s_wActionRequest = 0; /* uncomment it to trace the virtual machine activity */ /* #define bHB_DEBUG */ @@ -131,10 +130,10 @@ int main( int argc, char * argv[] ) /* initialize internal data structures */ aStatics.type = IT_NIL; - errorBlock.type = IT_NIL; stack.Return.type = IT_NIL; hb_xinit(); + hb_errInit(); hb_stackInit(); hb_dynsymNew( &symEval ); /* initialize dynamic symbol for evaluating codeblocks */ hb_setInitialize(); /* initialize Sets */ @@ -157,13 +156,13 @@ int main( int argc, char * argv[] ) PHB_DYNS pDynSym = hb_dynsymFind( HARBOUR_START_PROCEDURE ); if( pDynSym ) - pSymStart = pDynSym->pSymbol; + s_pSymStart = pDynSym->pSymbol; else hb_errInternal( 9999, "Can\'t locate the starting procedure: \'%s\'", HARBOUR_START_PROCEDURE, NULL ); } #endif - hb_vmPushSymbol( pSymStart ); /* pushes first FS_PUBLIC defined symbol to the stack */ + hb_vmPushSymbol( s_pSymStart ); /* pushes first FS_PUBLIC defined symbol to the stack */ hb_vmPushNil(); /* places NIL at self */ for( i = 1; i < argc; i++ ) /* places application parameters on the stack */ hb_vmPushString( argv[ i ], strlen( argv[ i ] ) ); @@ -178,7 +177,7 @@ int main( int argc, char * argv[] ) void hb_vmQuit( void ) { - wActionRequest = 0; /* EXIT procedures should be processed */ + s_wActionRequest = 0; /* EXIT procedures should be processed */ hb_vmDoExitFunctions(); /* process defined EXIT functions */ while( stack.pPos > stack.pItems ) @@ -186,7 +185,7 @@ void hb_vmQuit( void ) hb_itemClear( &stack.Return ); hb_arrayRelease( &aStatics ); - hb_itemClear( &errorBlock ); + hb_errExit(); hb_clsReleaseAll(); hb_vmReleaseLocalSymbols(); /* releases the local modules linked list */ hb_dynsymRelease(); /* releases the dynamic symbol table */ @@ -199,7 +198,7 @@ void hb_vmQuit( void ) HB_DEBUG( "Done!\n" ); - exit( byErrorLevel ); + exit( s_byErrorLevel ); } void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) @@ -361,7 +360,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) case HB_P_LINE: stack.pBase->item.asSymbol.lineno = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - if( bDebugging && bDebugShowLines ) + if( s_bDebugging && s_bDebugShowLines ) hb_vmDebuggerShowLine( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) ); w += 3; break; @@ -422,7 +421,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 ] ); - w +=4; + w += 4; break; case HB_P_PLUS: @@ -436,7 +435,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) break; case HB_P_POPALIAS: - hb_vmAliasPop(); + hb_vmPopAlias(); w++; break; @@ -474,7 +473,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) break; case HB_P_PUSHALIAS: - hb_vmAliasPush(); + hb_vmPushAlias(); w++; break; @@ -492,7 +491,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) * +7 -> start of table with referenced local variables */ hb_vmPushBlock( pCode + w, pSymbols ); - w += (pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 )); + w += ( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) ); break; case HB_P_PUSHDOUBLE: @@ -560,7 +559,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) case HB_P_PUSHSTR: wSize = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - hb_vmPushString( (char*)pCode + w + 3, wSize ); + hb_vmPushString( ( char * ) pCode + w + 3, wSize ); w += ( wSize + 3 ); break; @@ -571,7 +570,7 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) break; case HB_P_SWAPALIAS: - hb_vmAliasSwap(); + hb_vmSwapAlias(); w++; break; @@ -592,31 +591,31 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) /* * 1) clear the storage for value returned by BREAK statement */ - stack.pPos->type =IT_NIL; + stack.pPos->type = IT_NIL; hb_stackPush(); /* * 2) store the address of RECOVER or END opcode */ - stack.pPos->type =IT_LONG; - stack.pPos->item.asLong.value =w + pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); + stack.pPos->type = IT_LONG; + stack.pPos->item.asLong.value = w + pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); hb_stackPush(); /* * 3) store current RECOVER base */ - stack.pPos->type =IT_LONG; - stack.pPos->item.asLong.value =RecoverBase; + stack.pPos->type = IT_LONG; + stack.pPos->item.asLong.value = s_lRecoverBase; hb_stackPush(); /* * 4) store current bCanRecover flag - in a case of nested sequences * in the same procedure/function */ - stack.pPos->type =IT_LOGICAL; - stack.pPos->item.asLogical.value =bCanRecover; + stack.pPos->type = IT_LOGICAL; + stack.pPos->item.asLogical.value = bCanRecover; hb_stackPush(); /* * set new recover base */ - RecoverBase =stack.pPos - stack.pItems;; + s_lRecoverBase = stack.pPos - stack.pItems; /* * we are now inside a valid SEQUENCE envelope */ @@ -634,19 +633,19 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) * 4) Restore previous recovery state */ hb_stackDec(); - bCanRecover =stack.pPos->item.asLogical.value; - stack.pPos->type =IT_NIL; + bCanRecover = stack.pPos->item.asLogical.value; + stack.pPos->type = IT_NIL; /* * 3) Restore previous RECOVER base */ hb_stackDec(); - RecoverBase =stack.pPos->item.asLong.value; - stack.pPos->type =IT_NIL; + s_lRecoverBase = stack.pPos->item.asLong.value; + stack.pPos->type = IT_NIL; /* * 2) Remove RECOVER address */ hb_stackDec(); - stack.pPos->type =IT_NIL; + stack.pPos->type = IT_NIL; /* 1) Discard the value returned by BREAK statement - there * was no RECOVER clause or there was no BREAK statement */ @@ -665,19 +664,19 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) * 4) Restore previous recovery state */ hb_stackDec(); - bCanRecover =stack.pPos->item.asLogical.value; - stack.pPos->type =IT_NIL; + bCanRecover = stack.pPos->item.asLogical.value; + stack.pPos->type = IT_NIL; /* * 3) Restore previous RECOVER base */ hb_stackDec(); - RecoverBase =stack.pPos->item.asLong.value; - stack.pPos->type =IT_NIL; + s_lRecoverBase = stack.pPos->item.asLong.value; + stack.pPos->type = IT_NIL; /* * 2) Remove RECOVER address */ hb_stackDec(); - stack.pPos->type =IT_NIL; + stack.pPos->type = IT_NIL; /* * 1) Leave the value returned from BREAK - it will be popped * in next executed opcode @@ -717,9 +716,9 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) break; } - if( wActionRequest ) + if( s_wActionRequest ) { - if( wActionRequest & HB_BREAK_REQUESTED ) + if( s_wActionRequest & HB_BREAK_REQUESTED ) { if( bCanRecover ) { @@ -730,130 +729,28 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) /* * remove all items placed on the stack after BEGIN code */ - while( stack.pPos > stack.pItems + RecoverBase ) + while( stack.pPos > stack.pItems + s_lRecoverBase ) hb_stackPop(); /* * reload the address of recovery code */ - w = stack.pItems[ RecoverBase + HB_RECOVER_ADDRESS ].item.asLong.value; + w = stack.pItems[ s_lRecoverBase + HB_RECOVER_ADDRESS ].item.asLong.value; /* * leave the SEQUENCE envelope on the stack - it will * be popped either in RECOVER or END opcode */ - wActionRequest = 0; + s_wActionRequest = 0; } else break; } - else if( wActionRequest & HB_QUIT_REQUESTED ) + else if( s_wActionRequest & HB_QUIT_REQUESTED ) break; } } hb_memvarSetPrivatesBase( ulPrivateBase ); } -/* Pops the item from the eval stack and uses it to select the current - * workarea - */ -static void hb_vmAliasPop( void ) -{ - PHB_ITEM pItem; - - hb_stackDec(); - pItem = stack.pPos; - switch( pItem->type & ~IT_BYREF ) - { - case IT_INTEGER: - /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmAliasPush() - * or was evaluated from an expression, (nWorkArea)->field - */ - hb_rddSelectWorkAreaNumber( pItem->item.asInteger.value ); - pItem->type = IT_NIL; - break; - - case IT_SYMBOL: - /* Alias was specified using alias identifier, for example: al->field - */ - hb_rddSelectWorkAreaSymbol( pItem->item.asSymbol.value ); - pItem->type = IT_NIL; - break; - - case IT_STRING: - /* Alias was evaluated from an expression, for example: (cVar)->field - */ - /* TODO: synchronize it with RDD API - hb_SelectWorkAreaAlias( pItem->item.asString.value ); - */ - hb_itemClear( pItem ); - break; - - default: - hb_itemClear( pItem ); - hb_errRT_BASE( EG_BADALIAS, 9999, NULL, NULL ); - break; - } - - HB_DEBUG( "hb_vmAliasPop\n" ); -} - -/* pushes current workarea number on the eval stack - */ -static void hb_vmAliasPush( void ) -{ - stack.pPos->type = IT_INTEGER; - stack.pPos->item.asInteger.value = hb_rddGetCurrentWorkAreaNumber(); - stack.pPos->item.asInteger.length = 10; - hb_stackPush(); - HB_DEBUG( "hb_vmAliasPush\n" ); -} - -/* Swaps two last items on the eval stack - the last item after swaping - * is popped as current workarea number - */ -static void hb_vmAliasSwap( void ) -{ - HB_ITEM_PTR pItem = stack.pPos -1; - HB_ITEM_PTR pWorkArea = stack.pPos -2; - - switch( pWorkArea->type & ~IT_BYREF ) - { - case IT_INTEGER: - /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmAliasPush() - * or was evaluated from an expression, (nWorkArea)->field - */ - hb_rddSelectWorkAreaNumber( pWorkArea->item.asInteger.value ); - break; - - case IT_SYMBOL: - /* Alias was specified using alias identifier, for example: al->field - */ - hb_rddSelectWorkAreaSymbol( pItem->item.asSymbol.value ); - break; - - case IT_STRING: - /* Alias was evaluated from an expression, for example: (cVar)->field - */ - /* TODO: synchronize it with RDD API - hb_rddSelectWorkAreaAlias( pWorkArea->item.asString.value ); - */ - hb_itemClear( pWorkArea ); - break; - - default: - hb_itemClear( pWorkArea ); - hb_errRT_BASE( EG_BADALIAS, 9999, NULL, NULL ); - break; - } - memcpy( pWorkArea, pItem, sizeof( HB_ITEM ) ); - pItem->type =IT_NIL; - hb_stackDec(); - - HB_DEBUG( "hb_vmAliasSwap\n" ); -} - - void hb_vmAnd( void ) { PHB_ITEM pItem2 = stack.pPos - 1; @@ -877,7 +774,6 @@ void hb_vmArrayAt( void ) PHB_ITEM pIndex = stack.pPos - 1; PHB_ITEM pArray = stack.pPos - 2; ULONG ulIndex; - HB_ITEM item; if( IS_INTEGER( pIndex ) ) ulIndex = pIndex->item.asInteger.value; @@ -889,15 +785,23 @@ void hb_vmArrayAt( void ) ulIndex = pIndex->item.asDouble.value; else + { hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ) ); + return; + } - hb_arrayGet( pArray, ulIndex, &item ); - hb_stackPop(); - hb_stackPop(); + if( ! hb_arrayError( pArray, ulIndex, FALSE ) ) + { + HB_ITEM item; - hb_itemCopy( stack.pPos, &item ); - hb_itemClear( &item ); - hb_stackPush(); + hb_arrayGet( pArray, ulIndex, &item ); + hb_stackPop(); + hb_stackPop(); + + hb_itemCopy( stack.pPos, &item ); + hb_itemClear( &item ); + hb_stackPush(); + } } void hb_vmArrayPut( void ) @@ -917,12 +821,18 @@ void hb_vmArrayPut( void ) ulIndex = pIndex->item.asDouble.value; else + { hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ) ); + return; + } - hb_arraySet( pArray, ulIndex, pValue ); - hb_itemCopy( pArray, pValue ); /* places pValue at pArray position */ - hb_stackPop(); - hb_stackPop(); + if( ! hb_arrayError( pArray, ulIndex, TRUE ) ) + { + hb_arraySet( pArray, ulIndex, pValue ); + hb_itemCopy( pArray, pValue ); /* places pValue at pArray position */ + hb_stackPop(); + hb_stackPop(); + } } static void hb_vmDebuggerEndProc( void ) @@ -931,11 +841,11 @@ static void hb_vmDebuggerEndProc( void ) hb_itemCopy( &item, &stack.Return ); /* saves the previous returned value */ - bDebugShowLines = FALSE; + s_bDebugShowLines = FALSE; hb_vmPushSymbol( hb_dynsymFind( "__DBGENTRY" )->pSymbol ); hb_vmPushNil(); hb_vmDo( 0 ); - bDebugShowLines = TRUE; + s_bDebugShowLines = TRUE; hb_itemCopy( &stack.Return, &item ); /* restores the previous returned value */ hb_itemClear( &item ); @@ -943,12 +853,12 @@ static void hb_vmDebuggerEndProc( void ) static void hb_vmDebuggerShowLine( WORD wLine ) /* makes the debugger shows a specific source code line */ { - bDebugShowLines = FALSE; + s_bDebugShowLines = FALSE; hb_vmPushSymbol( hb_dynsymFind( "__DBGENTRY" )->pSymbol ); hb_vmPushNil(); hb_vmPushInteger( wLine ); hb_vmDo( 1 ); - bDebugShowLines = TRUE; + s_bDebugShowLines = TRUE; } void hb_vmDec( void ) @@ -1011,15 +921,27 @@ void hb_vmDivide( void ) { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1340, NULL, "/" ); - hb_vmPush( pResult ); - - hb_itemRelease( pResult ); + if( pResult ) + { + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } } else hb_vmPushNumber( d1 / d2, hb_set.HB_SET_DECIMALS ); } else - hb_errRT_BASE( EG_ARG, 1084, NULL, "/" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1084, NULL, "/" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmDo( WORD wParams ) @@ -1031,9 +953,9 @@ void hb_vmDo( WORD wParams ) PHB_ITEM pSelf = stack.pPos - wParams - 1; /* NIL, OBJECT or BLOCK */ PHB_FUNC pFunc; int iStatics = stack.iStatics; /* Return iStatics position */ - BOOL bDebugPrevState = bDebugging; + BOOL bDebugPrevState = s_bDebugging; - bDebugging = FALSE; + s_bDebugging = FALSE; if( ! IS_SYMBOL( pItem ) ) { @@ -1065,24 +987,24 @@ void hb_vmDo( WORD wParams ) else pFunc = hb_objGetMethod( pSelf, pSym ); - if( ! pFunc ) + if( pFunc ) + pFunc(); + else { if( pSym->szName[ 0 ] == '_' ) hb_errRT_BASE( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1 ); else hb_errRT_BASE( EG_NOMETHOD, 1004, NULL, pSym->szName ); } - - pFunc(); } else /* it is a function */ { pFunc = pSym->pFunPtr; - if( ! pFunc ) + if( pFunc ) + pFunc(); + else hb_errInternal( 9999, "Invalid function pointer (%s) from hb_vmDo()", pSym->szName, NULL ); - - pFunc(); } while( stack.pPos > stack.pItems + wItemIndex ) @@ -1091,10 +1013,10 @@ void hb_vmDo( WORD wParams ) stack.pBase = stack.pItems + wStackBase; stack.iStatics = iStatics; - if( bDebugging ) + if( s_bDebugging ) hb_vmDebuggerEndProc(); - bDebugging = bDebugPrevState; + s_bDebugging = bDebugPrevState; } HARBOUR hb_vmDoBlock( void ) @@ -1107,7 +1029,7 @@ HARBOUR hb_vmDoBlock( void ) hb_errInternal( 9999, "Codeblock expected from hb_vmDoBlock()", NULL, NULL ); /* Check for valid count of parameters */ - iParam =pBlock->item.asBlock.paramcnt -hb_pcount(); + iParam = pBlock->item.asBlock.paramcnt - hb_pcount(); /* add missing parameters */ while( iParam-- > 0 ) hb_vmPushNil(); @@ -1115,7 +1037,7 @@ HARBOUR hb_vmDoBlock( void ) /* set pBaseCB to point to local variables of a function where * the codeblock was defined */ - stack.pBase->item.asSymbol.lineno =pBlock->item.asBlock.lineno; + stack.pBase->item.asSymbol.lineno = pBlock->item.asBlock.lineno; hb_codeblockEvaluate( pBlock ); @@ -1200,7 +1122,7 @@ void hb_vmEqual( BOOL bExact ) hb_vmPushLogical( hb_vmPopLogical() == hb_vmPopLogical() ); else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) ) - hb_vmPushLogical( hb_vmPopDouble(&wDec) == hb_vmPopDouble(&wDec) ); + hb_vmPushLogical( hb_vmPopDouble( &wDec ) == hb_vmPopDouble( &wDec ) ); else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "==" ) ) hb_vmOperatorCall( pItem1, pItem2, "==" ); @@ -1401,12 +1323,11 @@ void hb_vmInstring( void ) { PHB_ITEM pItem1 = stack.pPos - 2; PHB_ITEM pItem2 = stack.pPos - 1; - int iResult; if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) ) { - iResult = hb_strAt( pItem1->item.asString.value, pItem1->item.asString.length, - pItem2->item.asString.value, pItem2->item.asString.length ); + int iResult = hb_strAt( pItem1->item.asString.value, pItem1->item.asString.length, + pItem2->item.asString.value, pItem2->item.asString.length ); hb_stackPop(); hb_stackPop(); hb_vmPushLogical( iResult == 0 ? FALSE : TRUE ); @@ -1599,7 +1520,7 @@ void hb_vmMinus( void ) double dNumber2 = hb_vmPopDouble( &wDec2 ); double dNumber1 = hb_vmPopDouble( &wDec1 ); - hb_vmPushNumber( dNumber1 - dNumber2, (wDec1 > wDec2) ? wDec1 : wDec2 ); + hb_vmPushNumber( dNumber1 - dNumber2, ( wDec1 > wDec2 ) ? wDec1 : wDec2 ); } else if( IS_DATE( pItem2 ) && IS_DATE( pItem1 ) ) { @@ -1629,7 +1550,7 @@ void hb_vmMinus( void ) memcpy( pItem1->item.asString.value + ulLen, pItem2->item.asString.value, pItem2->item.asString.length ); ulLen += pItem2->item.asString.length; - memset( pItem1->item.asString.value + ulLen, ' ', pItem1->item.asString.length - ulLen); + memset( pItem1->item.asString.value + ulLen, ' ', pItem1->item.asString.length - ulLen ); pItem1->item.asString.value[ pItem1->item.asString.length ] = '\0'; if( pItem2->item.asString.value ) @@ -1646,18 +1567,28 @@ void hb_vmMinus( void ) else if( IS_OBJECT( stack.pPos - 2 ) && hb_objHasMsg( stack.pPos - 2, "-" ) ) hb_vmOperatorCall( stack.pPos - 2, stack.pPos - 1, "-" ); else - hb_errRT_BASE( EG_ARG, 1082, NULL, "-" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1082, NULL, "-" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmModuleName( char * szModuleName ) /* PRG and function name information for the debugger */ { - bDebugging = TRUE; - bDebugShowLines = FALSE; + s_bDebugging = TRUE; + s_bDebugShowLines = FALSE; hb_vmPushSymbol( hb_dynsymFind( "__DBGENTRY" )->pSymbol ); hb_vmPushNil(); hb_vmPushString( szModuleName, strlen( szModuleName ) ); hb_vmDo( 1 ); - bDebugShowLines = TRUE; + s_bDebugShowLines = TRUE; } void hb_vmModulus( void ) @@ -1675,9 +1606,11 @@ void hb_vmModulus( void ) { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%" ); - hb_vmPush( pResult ); - - hb_itemRelease( pResult ); + if( pResult ) + { + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } } else /* NOTE: Clipper always returns the result of modulus @@ -1685,7 +1618,17 @@ void hb_vmModulus( void ) hb_vmPushNumber( fmod( d1, d2 ), hb_set.HB_SET_DECIMALS ); } else - hb_errRT_BASE( EG_ARG, 1085, NULL, "%" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmMult( void ) @@ -1702,7 +1645,17 @@ void hb_vmMult( void ) hb_vmPushNumber( d1 * d2, wDec1 + wDec2 ); } else - hb_errRT_BASE( EG_ARG, 1083, NULL, "*" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1083, NULL, "*" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } } void hb_vmOperatorCall( PHB_ITEM pItem1, PHB_ITEM pItem2, char *szSymbol ) @@ -1785,7 +1738,17 @@ void hb_vmPlus( void ) hb_vmOperatorCall( pItem1, pItem2, "+" ); else - hb_errRT_BASE( EG_ARG, 1081, NULL, "+" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } HB_DEBUG( "Plus\n" ); } @@ -1802,10 +1765,55 @@ long hb_vmPopDate( void ) else { hb_errInternal( 9999, "Incorrect item value trying to Pop a date value", NULL, NULL ); - return 0; + return 0; /* To suppress compiler warning */ } } +/* Pops the item from the eval stack and uses it to select the current + * workarea + */ +static void hb_vmPopAlias( void ) +{ + PHB_ITEM pItem; + + hb_stackDec(); + pItem = stack.pPos; + switch( pItem->type & ~IT_BYREF ) + { + case IT_INTEGER: + /* Alias was used as integer value, for example: 4->field + * or it was saved on the stack using hb_vmPushAlias() + * or was evaluated from an expression, (nWorkArea)->field + */ + hb_rddSelectWorkAreaNumber( pItem->item.asInteger.value ); + pItem->type = IT_NIL; + break; + + case IT_SYMBOL: + /* Alias was specified using alias identifier, for example: al->field + */ + hb_rddSelectWorkAreaSymbol( pItem->item.asSymbol.value ); + pItem->type = IT_NIL; + break; + + case IT_STRING: + /* Alias was evaluated from an expression, for example: (cVar)->field + */ + /* TODO: synchronize it with RDD API + hb_SelectWorkAreaAlias( pItem->item.asString.value ); + */ + hb_itemClear( pItem ); + break; + + default: + hb_itemClear( pItem ); + hb_errRT_BASE( EG_BADALIAS, 9999, NULL, NULL ); + break; + } + + HB_DEBUG( "hb_vmPopAlias\n" ); +} + static void hb_vmPopAliasedField( PHB_SYMB pSym ) { PHB_ITEM pAlias = stack.pPos - 1; @@ -1815,7 +1823,7 @@ static void hb_vmPopAliasedField( PHB_SYMB pSym ) { case IT_INTEGER: /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmAliasPush() + * or it was saved on the stack using hb_vmPushAlias() * or was evaluated from an expression, (nWorkArea)->field */ hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); @@ -1841,7 +1849,7 @@ static void hb_vmPopAliasedField( PHB_SYMB pSym ) default: hb_itemClear( pAlias ); hb_errRT_BASE( EG_BADALIAS, 9999, NULL, NULL ); - break; + return; } hb_rddPutFieldValue( stack.pPos - 2, pSym ); @@ -1920,17 +1928,17 @@ void hb_vmPopLocal( SHORT iLocal ) BOOL hb_vmPopLogical( void ) { - hb_stackDec(); - - if( IS_LOGICAL( stack.pPos ) ) + if( IS_LOGICAL( stack.pPos - 1 ) ) { + hb_stackDec(); + stack.pPos->type = IT_NIL; return stack.pPos->item.asLogical.value; } else { hb_errRT_BASE( EG_ARG, 1066, NULL, hb_langDGetErrorDesc( EG_CONDITION ) ); - return 0; + return FALSE; } } @@ -2013,7 +2021,28 @@ void hb_vmPower( void ) hb_vmPushNumber( pow( d1, d2 ), hb_set.HB_SET_DECIMALS ); } else - hb_errRT_BASE( EG_ARG, 1088, NULL, "^" ); + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1088, NULL, "^" ); + + if( pResult ) + { + hb_stackPop(); + hb_stackPop(); + hb_vmPush( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* pushes current workarea number on the eval stack + */ +static void hb_vmPushAlias( void ) +{ + stack.pPos->type = IT_INTEGER; + stack.pPos->item.asInteger.value = hb_rddGetCurrentWorkAreaNumber(); + stack.pPos->item.asInteger.length = 10; + hb_stackPush(); + HB_DEBUG( "hb_vmPushAlias\n" ); } static void hb_vmPushAliasedField( PHB_SYMB pSym ) @@ -2025,7 +2054,7 @@ static void hb_vmPushAliasedField( PHB_SYMB pSym ) { case IT_INTEGER: /* Alias was used as integer value, for example: 4->field - * or it was saved on the stack using hb_vmAliasPush() + * or it was saved on the stack using hb_vmPushAlias() * or was evaluated from an expression, (nWorkArea)->field */ hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); @@ -2051,7 +2080,7 @@ static void hb_vmPushAliasedField( PHB_SYMB pSym ) default: hb_itemClear( pAlias ); hb_errRT_BASE( EG_BADALIAS, 9999, NULL, NULL ); - break; + return; } hb_rddGetFieldValue( pAlias, pSym ); @@ -2091,7 +2120,7 @@ void hb_vmPushLocal( SHORT iLocal ) /* local variable referenced in a codeblock * stack.pBase+1 points to a codeblock that is currently evaluated */ - hb_itemCopy( stack.pPos, hb_codeblockGetVar( stack.pBase + 1, (LONG)iLocal ) ); + hb_itemCopy( stack.pPos, hb_codeblockGetVar( stack.pBase + 1, ( LONG ) iLocal ) ); hb_stackPush(); HB_DEBUG2( "hb_vmPushLocal %i\n", iLocal ); @@ -2150,8 +2179,8 @@ void hb_vmPushStatic( WORD wStatic ) PHB_ITEM pStatic; pStatic = aStatics.item.asArray.value->pItems + stack.iStatics + wStatic - 1; - if( IS_BYREF(pStatic) ) - hb_itemCopy( stack.pPos, hb_itemUnRef(pStatic) ); + if( IS_BYREF( pStatic ) ) + hb_itemCopy( stack.pPos, hb_itemUnRef( pStatic ) ); else hb_itemCopy( stack.pPos, pStatic ); hb_stackPush(); @@ -2174,7 +2203,7 @@ void hb_vmPushString( char * szText, ULONG length ) { char * szTemp = ( char * ) hb_xgrab( length + 1 ); - memcpy (szTemp, szText, length); + memcpy( szTemp, szText, length ); szTemp[ length ] = '\0'; stack.pPos->type = IT_STRING; @@ -2216,7 +2245,7 @@ void hb_vmPushBlock( BYTE * pCode, PHB_SYMB pSymbols ) stack.pPos->item.asBlock.value = hb_codeblockNew( pCode + 7 + wLocals*2, /* pcode buffer */ wLocals, /* number of referenced local variables */ - (WORD *)( pCode + 7 ), /* table with referenced local variables */ + ( WORD * )( pCode + 7 ), /* table with referenced local variables */ pSymbols ); /* store the statics base of function where the codeblock was defined @@ -2315,7 +2344,7 @@ void hb_stackPush( void ) /* no, make more headroom: */ /* hb_stackDispLocal(); */ - stack.pItems = (PHB_ITEM)hb_xrealloc( stack.pItems, sizeof( HB_ITEM ) * + stack.pItems = ( PHB_ITEM ) hb_xrealloc( stack.pItems, sizeof( HB_ITEM ) * ( stack.wItems + STACK_EXPANDHB_ITEMS ) ); /* fix possibly invalid pointers: */ @@ -2446,6 +2475,52 @@ void hb_vmStatics( PHB_SYMB pSym ) /* initializes the global aStatics array or r HB_DEBUG2( "Statics %li\n", hb_arrayLen( &aStatics ) ); } +/* Swaps two last items on the eval stack - the last item after swaping + * is popped as current workarea number + */ +static void hb_vmSwapAlias( void ) +{ + HB_ITEM_PTR pItem = stack.pPos -1; + HB_ITEM_PTR pWorkArea = stack.pPos -2; + + switch( pWorkArea->type & ~IT_BYREF ) + { + case IT_INTEGER: + /* Alias was used as integer value, for example: 4->field + * or it was saved on the stack using hb_vmPushAlias() + * or was evaluated from an expression, (nWorkArea)->field + */ + hb_rddSelectWorkAreaNumber( pWorkArea->item.asInteger.value ); + break; + + case IT_SYMBOL: + /* Alias was specified using alias identifier, for example: al->field + */ + hb_rddSelectWorkAreaSymbol( pItem->item.asSymbol.value ); + break; + + case IT_STRING: + /* Alias was evaluated from an expression, for example: (cVar)->field + */ + /* TODO: synchronize it with RDD API + hb_rddSelectWorkAreaAlias( pWorkArea->item.asString.value ); + */ + hb_itemClear( pWorkArea ); + break; + + default: + hb_itemClear( pWorkArea ); + hb_errRT_BASE( EG_BADALIAS, 9999, NULL, NULL ); + return; + } + + memcpy( pWorkArea, pItem, sizeof( HB_ITEM ) ); + pItem->type = IT_NIL; + hb_stackDec(); + + HB_DEBUG( "hb_vmSwapAlias\n" ); +} + void hb_vmProcessSymbols( PHB_SYMB pModuleSymbols, WORD wModuleSymbols ) /* module symbols initialization */ { PSYMBOLS pNewSymbols, pLastSymbols; @@ -2468,11 +2543,11 @@ void hb_vmProcessSymbols( PHB_SYMB pModuleSymbols, WORD wModuleSymbols ) /* modu pNewSymbols->pNext = NULL; pNewSymbols->hScope = 0; - if( ! pSymbols ) - pSymbols = pNewSymbols; + if( s_pSymbols == NULL ) + s_pSymbols = pNewSymbols; else { - pLastSymbols = pSymbols; + pLastSymbols = s_pSymbols; while( pLastSymbols->pNext ) /* locates the latest processed group of symbols */ pLastSymbols = pLastSymbols->pNext; pLastSymbols->pNext = pNewSymbols; @@ -2480,12 +2555,12 @@ void hb_vmProcessSymbols( PHB_SYMB pModuleSymbols, WORD wModuleSymbols ) /* modu for( w = 0; w < wModuleSymbols; w++ ) /* register each public symbol on the dynamic symbol table */ { - hSymScope =( pModuleSymbols + w )->cScope; - pNewSymbols->hScope |=hSymScope; - if( ( ! pSymStart ) && ( hSymScope == FS_PUBLIC ) ) - pSymStart = pModuleSymbols + w; /* first public defined symbol to start execution */ + hSymScope = ( pModuleSymbols + w )->cScope; + pNewSymbols->hScope |= hSymScope; + if( ( ! s_pSymStart ) && ( hSymScope == FS_PUBLIC ) ) + s_pSymStart = pModuleSymbols + w; /* first public defined symbol to start execution */ - if( (hSymScope == FS_PUBLIC) || (hSymScope & ( FS_MESSAGE | FS_MEMVAR )) ) + if( ( hSymScope == FS_PUBLIC ) || ( hSymScope & ( FS_MESSAGE | FS_MEMVAR ) ) ) hb_dynsymNew( pModuleSymbols + w ); } } @@ -2513,32 +2588,33 @@ static void hb_vmReleaseLocalSymbols( void ) { PSYMBOLS pDestroy; - while( pSymbols ) + while( s_pSymbols ) { - pDestroy = pSymbols; - pSymbols = pSymbols->pNext; + pDestroy = s_pSymbols; + s_pSymbols = s_pSymbols->pNext; hb_xfree( pDestroy ); } } /* This calls all _INITSTATICS functions defined in the application. - * We are using a special symbol's scope (FS_INIT | FS_EXIT) to mark + * We are using a special symbol's scope ( FS_INIT | FS_EXIT ) to mark * this function. These two bits cannot be marked at the same * time for normal user defined functions. */ static void hb_vmDoInitStatics( void ) { - PSYMBOLS pLastSymbols = pSymbols; + PSYMBOLS pLastSymbols = s_pSymbols; WORD w; SYMBOLSCOPE scope; - do { - if( (pLastSymbols->hScope & (FS_INIT | FS_EXIT)) == (FS_INIT | FS_EXIT) ) + do + { + if( ( pLastSymbols->hScope & ( FS_INIT | FS_EXIT ) ) == ( FS_INIT | FS_EXIT ) ) { for( w = 0; w < pLastSymbols->wModuleSymbols; w++ ) { - scope =( pLastSymbols->pModuleSymbols + w )->cScope & (FS_EXIT | FS_INIT); - if( scope == (FS_INIT | FS_EXIT) ) + scope = ( pLastSymbols->pModuleSymbols + w )->cScope & ( FS_EXIT | FS_INIT ); + if( scope == ( FS_INIT | FS_EXIT ) ) { /* _INITSTATICS procedure cannot call any function and it * cannot use any local variable then it is safe to call @@ -2558,22 +2634,23 @@ static void hb_vmDoInitStatics( void ) static void hb_vmDoExitFunctions( void ) { - PSYMBOLS pLastSymbols = pSymbols; + PSYMBOLS pLastSymbols = s_pSymbols; WORD w; SYMBOLSCOPE scope; - do { + do + { if( pLastSymbols->hScope & FS_EXIT ) { /* only if module contains some EXIT functions */ for( w = 0; w < pLastSymbols->wModuleSymbols; w++ ) { - scope =( pLastSymbols->pModuleSymbols + w )->cScope & (FS_EXIT | FS_INIT); + scope = ( pLastSymbols->pModuleSymbols + w )->cScope & ( FS_EXIT | FS_INIT ); if( scope == FS_EXIT ) { hb_vmPushSymbol( pLastSymbols->pModuleSymbols + w ); hb_vmPushNil(); hb_vmDo( 0 ); - if( wActionRequest ) + if( s_wActionRequest ) /* QUIT or BREAK was issued - stop processing */ return; @@ -2586,16 +2663,17 @@ static void hb_vmDoExitFunctions( void ) static void hb_vmDoInitFunctions( int argc, char * argv[] ) { - PSYMBOLS pLastSymbols = pSymbols; + PSYMBOLS pLastSymbols = s_pSymbols; WORD w; SYMBOLSCOPE scope; - do { + do + { if( pLastSymbols->hScope & FS_INIT ) { /* only if module contains some INIT functions */ for( w = 0; w < pLastSymbols->wModuleSymbols; w++ ) { - scope =( pLastSymbols->pModuleSymbols + w )->cScope & (FS_EXIT | FS_INIT); + scope = ( pLastSymbols->pModuleSymbols + w )->cScope & ( FS_EXIT | FS_INIT ); if( scope == FS_INIT ) { int i; @@ -2652,7 +2730,7 @@ HARBOUR HB_LEN( void ) hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "LEN" ); /* NOTE: Clipper catches this at compile time! */ } -HARBOUR HB_EMPTY(void) +HARBOUR HB_EMPTY( void ) { if( hb_pcount() == 1 ) { @@ -2770,22 +2848,7 @@ HARBOUR HB_WORD( void ) } -HARBOUR HB_ERRORBLOCK( void ) -{ - HB_ITEM oldError; - PHB_ITEM pNewErrorBlock = hb_param( 1, IT_BLOCK ); - - oldError.type = IT_NIL; - hb_itemCopy( &oldError, &errorBlock ); - - if( pNewErrorBlock ) - hb_itemCopy( &errorBlock, pNewErrorBlock ); - - hb_itemCopy( &stack.Return, &oldError ); - hb_itemClear( &oldError ); -} - -HARBOUR HB_PROCNAME(void) +HARBOUR HB_PROCNAME( void ) { int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */ PHB_ITEM pBase = stack.pBase; @@ -2813,7 +2876,7 @@ HARBOUR HB_PROCNAME(void) hb_retc( "" ); } -HARBOUR HB_PROCLINE(void) +HARBOUR HB_PROCLINE( void ) { int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */ PHB_ITEM pBase = stack.pBase; @@ -2829,29 +2892,29 @@ HARBOUR HB_PROCLINE(void) void hb_vmRequestQuit( void ) { - wActionRequest = HB_QUIT_REQUESTED; + s_wActionRequest = HB_QUIT_REQUESTED; } -HARBOUR HB___QUIT(void) +HARBOUR HB___QUIT( void ) { hb_vmRequestQuit(); } -HARBOUR HB_ERRORLEVEL(void) +HARBOUR HB_ERRORLEVEL( void ) { - BYTE byPrevValue = byErrorLevel; + BYTE byPrevValue = s_byErrorLevel; /* NOTE: This should be ISNUM( 1 ), but it's sort of a Clipper bug that it accepts other types also and consider them zero. */ if( hb_pcount() > 0 ) /* Only replace the error level if a parameter was passed */ - byErrorLevel = hb_parni( 1 ); + s_byErrorLevel = hb_parni( 1 ); hb_retni( byPrevValue ); } -HARBOUR HB_PCOUNT(void) +HARBOUR HB_PCOUNT( void ) { if( hb_pcount() == 0 ) { @@ -2864,7 +2927,7 @@ HARBOUR HB_PCOUNT(void) hb_errRT_BASE( EG_ARGCOUNT, 3000, NULL, "PCOUNT" ); /* NOTE: Clipper catches this at compile time! */ } -HARBOUR HB_PVALUE(void) /* PValue( ) */ +HARBOUR HB_PVALUE( void ) /* PValue( ) */ { WORD wParam = hb_parni( 1 ); /* Get parameter */ PHB_ITEM pBase = stack.pItems + stack.pBase->item.asSymbol.stackbase; @@ -2878,19 +2941,19 @@ HARBOUR HB_PVALUE(void) /* PValue( ) void hb_vmRequestBreak( PHB_ITEM pItem ) { - if( RecoverBase ) + if( s_lRecoverBase ) { if( pItem ) - hb_itemCopy( stack.pItems + RecoverBase + HB_RECOVER_VALUE, pItem ); - wActionRequest = HB_BREAK_REQUESTED; + hb_itemCopy( stack.pItems + s_lRecoverBase + HB_RECOVER_VALUE, pItem ); + s_wActionRequest = HB_BREAK_REQUESTED; } else - wActionRequest = HB_QUIT_REQUESTED; + s_wActionRequest = HB_QUIT_REQUESTED; } WORD hb_vmRequestQuery( void ) { - return wActionRequest; + return s_wActionRequest; } /* NOTE: This function should normally have a parameter count check. But diff --git a/harbour/tests/working/Makefile b/harbour/tests/working/Makefile index dc0af6af2d..01f45a8456 100644 --- a/harbour/tests/working/Makefile +++ b/harbour/tests/working/Makefile @@ -20,133 +20,25 @@ 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 \ - empty.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 \ - strsub.prg \ - syserror.prg \ - t1.prg \ - test.prg \ - test_all.prg \ - testbrw.prg \ - testcgi.prg \ - testcopy.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 \ +huh.prg \ +huh2.prg \ +rtl_test.prg \ +fileio.prg \ +and_or.prg \ +copyfile.prg \ +kej.prg \ +kejj.prg \ +inkeytst.prg \ +para.prg \ +rtl_test.prg \ +i.prg \ +j.prg \ +k.prg \ +ac_test.prg \ +fileio.prg \ +rtl_test.prg \ +testrdd.prg \ +testdbf.prg \ PRG_HEADERS=\ cgi.ch \ diff --git a/harbour/tests/working/empty.prg b/harbour/tests/working/empty.prg deleted file mode 100644 index 0a961123c1..0000000000 --- a/harbour/tests/working/empty.prg +++ /dev/null @@ -1,68 +0,0 @@ -// -// $Id$ -// - -// -// Testing Empty() function -// -// Date : 16/05/1999 -// Time : 21:00 -// -// Writte by Eddie Runia -// www - http://www.harbour-project.org -// -// Placed in the public domain -// - -#include "set.ch" - -function Main() - - __SETCENTURY ("ON") // SET CENTURY ON - SET (_SET_DATEFORMAT, "DD/MM/YYYY") // SET DATE BRITISH - QOut( "British date format with century on" ) - QOut( "C 'Hallo' ", empty( "Hallo" ) ) - QOut( "C '' ", empty( "" ) ) - QOut( "C ' ' ", empty( " " ) ) - QOut( "C ' \0' ", empty( " "+chr(0) ) ) - QOut( "C ' \n\t' ", empty( " "+chr(13)+chr(9) ) ) - QOut( "C ' A' ", empty( " A" ) ) - QOut( "C ' x ' ", empty( " x " ) ) - QOut( "C ' x\0' ", empty( " x"+chr(0) ) ) - QOut( "C ' \nx\t' ", empty( " "+chr(13)+"x"+chr(9) ) ) - - QOut( "N 0 ", empty( 0 ) ) - QOut( "N -0 ", empty( -0 ) ) - QOut( "N 0.0 ", empty( 0.0 ) ) - QOut( "N 70000-70000 ", empty( 70000-70000 ) ) - QOut( "N 1.5*1.5-2.25 ", empty( 1.5*1.5-2.25 ) ) - - QOut( "N 10 ", empty( 10 ) ) - QOut( "N 10.0 ", empty( 10.0 ) ) - QOut( "N 70000+70000 ", empty( 70000+70000 ) ) - QOut( "N 1.5*1.5*2.25 ", empty( 1.5*1.5*2.25 ) ) - - Pause() - - QOut( "D 10/10/1824 ", ctod("10/10/1824"), empty( ctod("10/10/1824") ) ) - QOut( "D 31/02/1825 ", ctod("31/02/1825"), empty( ctod("31/02/1825") ) ) - QOut( "D 99/99/9999 ", ctod("99/99/9999"), empty( ctod("99/99/9999") ) ) - QOut( "D / / ", ctod(" / / "), empty( ctod(" / / ") ) ) - QOut( "D ", ctod(""), empty( ctod("") ) ) - QOut( "L .T. ", empty( .T. ) ) - QOut( "L .F. ", empty( .F. ) ) - QOut( "U NIL ", empty( NIL ) ) - QOut( "A {1} ", empty( {1} ) ) - QOut( "A {} ", empty( {} ) ) - QOut( "A {0} ", empty( {0} ) ) - QOut( "B {|x|x+x} ", empty( {|x|x+x} ) ) - - QOut() -return nil - -function Pause() - - QOut() - __Accept( "Pause:" ) -return nil - diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index 6bc6951dbc..b91365d4a7 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -35,48 +35,321 @@ */ /* TRANSFORM() tests written by Eddie Runia */ +/* EMPTY() tests written by Eddie Runia */ /* NOTE: Always compile with /n switch */ +/* NOTE: It's worth to make tests with and without the /z switch */ +/* NOTE: Guard all Harbour extensions with __HARBOUR__ #ifdefs */ + /* TODO: Add checks for string parameters with embedded NUL character */ /* TODO: Add test cases for other string functions */ /* TODO: Incorporate tests from test/working/string*.prg */ +/* TODO: String overflow on + and - tests */ +/* TODO: Tests with MEMO type ? */ +/* TODO: Tests with Log(0) type of invalid values */ #include "error.ch" -#translate TEST_LINE( , ) => TEST_CALL(<(x)>, {|| }, ) +#translate TEST_LINE( , ) => TEST_CALL( <(x)>, {|| }, ) -STATIC snPass -STATIC snFail -STATIC scFileName -STATIC snFhnd -STATIC scNewLine -STATIC snCount -STATIC slShowAll +STATIC s_nPass +STATIC s_nFail +STATIC s_cFileName +STATIC s_nFhnd +STATIC s_cNewLine +STATIC s_nCount +STATIC s_lShowAll +STATIC s_lShortcut FUNCTION Main( cPar1 ) + /* NOTE: Some basic values we may need for some tests. + ( passing by reference, avoid preprocessor bugs, etc. ) */ + + LOCAL lcString := "HELLO" + LOCAL lcStringE := "" + LOCAL lcStringZ := "A" + Chr(0) + "B" + LOCAL lnIntZ := 0 + LOCAL lnDoubleZ := 0.0 + LOCAL lnIntP := 10 + LOCAL lnLongP := 100000 + LOCAL lnDoubleP := 10.567 + LOCAL lnIntN := -10 + LOCAL lnLongN := -100000 + LOCAL lnDoubleN := -10.567 + LOCAL lnDoubleI := Log( 0 ) + LOCAL ldDateE := SToD("") + LOCAL llFalse := .F. + LOCAL llTrue := .T. + LOCAL loObject := ErrorNew() + LOCAL luNIL := NIL + LOCAL lbBlock := {|| NIL } + LOCAL laArray := { 9898 } + + MEMVAR mxNotHere + MEMVAR mcString + MEMVAR mcStringE + MEMVAR mcStringZ + MEMVAR mnIntZ + MEMVAR mnDoubleZ + MEMVAR mnIntP + MEMVAR mnLongP + MEMVAR mnDoubleP + MEMVAR mnDoubleI + MEMVAR mnIntN + MEMVAR mnLongN + MEMVAR mnDoubleN + MEMVAR mdDateE + MEMVAR mlFalse + MEMVAR mlTrue + MEMVAR moObject + MEMVAR muNIL + MEMVAR mbBlock + MEMVAR maArray + + /* NOTE: mxNotHere intentionally not declared */ + PRIVATE mcString := "HELLO" + PRIVATE mcStringE := "" + PRIVATE mcStringZ := "A" + Chr(0) + "B" + PRIVATE mnIntZ := 0 + PRIVATE mnDoubleZ := 0.0 + PRIVATE mnIntP := 10 + PRIVATE mnLongP := 100000 + PRIVATE mnDoubleP := 10.567 + PRIVATE mnDoubleI := Log( 0 ) + PRIVATE mnIntN := -10 + PRIVATE mnLongN := -100000 + PRIVATE mnDoubleN := -10.567 + PRIVATE mdDateE := SToD("") + PRIVATE mlFalse := .F. + PRIVATE mlTrue := .T. + PRIVATE moObject := ErrorNew() + PRIVATE muNIL := NIL + PRIVATE mbBlock := {|| NIL } + PRIVATE maArray := { 9898 } + + /* Initialize test */ + +/* TODO: Need to add this, when multi language support will be available + to make sure all error messages comes in the original English + language. */ +/* SET LANGID TO EN */ + IF cPar1 == NIL cPar1 := "" ENDIF - /* Initialize test */ - -// SET LANGID TO EN - TEST_BEGIN( cPar1 ) +/* NOTE: CA-Cl*pper PP fails on these + TEST_LINE( "1" .AND. "2" , "E BASE 1066 Argument error conditional " ) + TEST_LINE( "1" .AND. .F. , .F. ) + TEST_LINE( "A" > 1 , "E BASE 1075 Argument error > F:S" ) +*/ + /* (operators) */ TEST_LINE( 1 + NIL , "E BASE 1081 Argument error + F:S" ) TEST_LINE( 1 - NIL , "E BASE 1082 Argument error - F:S" ) + + TEST_LINE( "A" - "B" , "AB" ) + TEST_LINE( "A " - "B" , "AB " ) + TEST_LINE( "A " - "B " , "AB " ) + TEST_LINE( "A " - " B" , "A B " ) + TEST_LINE( " " - "B " , "B " ) + TEST_LINE( 1 / NIL , "E BASE 1084 Argument error / F:S" ) TEST_LINE( 1 * NIL , "E BASE 1083 Argument error * F:S" ) -// PP fails to preprocess this line, so it's temporarly commented out + TEST_LINE( 1 ** NIL , "E BASE 1088 Argument error ^ F:S" ) +/* NOTE: Harbour PP fails to process this line, so it's temporarly commented out */ #ifndef __HARBOUR__ TEST_LINE( 1 ^ NIL , "E BASE 1088 Argument error ^ F:S" ) #endif TEST_LINE( 1 % NIL , "E BASE 1085 Argument error % F:S" ) + TEST_LINE( -(0) , 0 ) + TEST_LINE( -(10) , -10 ) + TEST_LINE( -(10.505) , -10.505 ) + TEST_LINE( -(100000) , -100000 ) + TEST_LINE( -(-10) , 10 ) + TEST_LINE( -("1") , "E BASE 1080 Argument error - F:S" ) + +/* NOTE: Harbour PP fails to process this line, so it's temporarly commented out */ +#ifndef __HARBOUR__ + TEST_LINE( "AA" $ 1 , "E BASE 1109 Argument error $ F:S" ) +#endif + TEST_LINE( lcString $ 1 , "E BASE 1109 Argument error $ F:S" ) + TEST_LINE( 1 $ "AA" , "E BASE 1109 Argument error $ F:S" ) + + IF TEST_OPT_Z() + + /* With the shortcut optimalization *ON* */ + + TEST_LINE( 1 .AND. 2 , "E BASE 1066 Argument error conditional " ) + TEST_LINE( NIL .AND. NIL , "E BASE 1066 Argument error conditional " ) + TEST_LINE( lcString .AND. lcString , "E BASE 1066 Argument error conditional " ) + TEST_LINE( .T. .AND. 1 , 1 ) + TEST_LINE( .T. .AND. 1.567 , 1.567 ) + TEST_LINE( .T. .AND. lcString , "HELLO" ) + TEST_LINE( .T. .AND. SToD("") , SToD(" ") ) + TEST_LINE( .T. .AND. NIL , NIL ) + TEST_LINE( .T. .AND. {} , "{.[0].}" ) + TEST_LINE( .T. .AND. {|| NIL } , "{||...}" ) + TEST_LINE( .F. .AND. 1 , .F. ) + TEST_LINE( .F. .AND. 1.567 , .F. ) + TEST_LINE( .F. .AND. lcString , .F. ) + TEST_LINE( .F. .AND. SToD("") , .F. ) + TEST_LINE( .F. .AND. NIL , .F. ) + TEST_LINE( .F. .AND. {} , .F. ) + TEST_LINE( .F. .AND. {|| NIL } , .F. ) + TEST_LINE( 1 .AND. .F. , .F. ) + TEST_LINE( 1.567 .AND. .F. , .F. ) + TEST_LINE( lcString .AND. .F. , .F. ) + + /* With the shortcut optimalization *OFF* (/z switch) */ + + TEST_LINE( 1 .OR. 2 , "E BASE 1066 Argument error conditional " ) + TEST_LINE( .F. .OR. 2 , 2 ) + TEST_LINE( .F. .OR. 1.678 , 1.678 ) + TEST_LINE( .F. .OR. lcString , "HELLO" ) + TEST_LINE( .T. .OR. 2 , .T. ) + TEST_LINE( .T. .OR. 1.678 , .T. ) + TEST_LINE( .T. .OR. lcString , .T. ) + TEST_LINE( 1 .OR. .F. , 1 ) + TEST_LINE( 1.0 .OR. .F. , 1.0 ) + TEST_LINE( lcString .OR. .F. , "HELLO" ) + + ELSE + + TEST_LINE( 1 .AND. 2 , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( NIL .AND. NIL , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( lcString .AND. lcString , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. 1 , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. 1.567 , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. lcString , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. SToD("") , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. NIL , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. {} , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .T. .AND. {|| NIL } , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. 1 , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. 1.567 , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. lcString , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. SToD("") , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. NIL , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. {} , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( .F. .AND. {|| NIL } , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( 1 .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( 1.567 .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) + TEST_LINE( lcString .AND. .F. , "E BASE 1078 Argument error .AND. F:S" ) + + TEST_LINE( 1 .OR. 2 , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .F. .OR. 2 , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .F. .OR. 1.678 , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .F. .OR. lcString , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .T. .OR. 2 , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .T. .OR. 1.678 , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( .T. .OR. lcString , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( 1 .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( 1.0 .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) + TEST_LINE( lcString .OR. .F. , "E BASE 1079 Argument error .OR. F:S" ) + + ENDIF + + TEST_LINE( .NOT. .T. , .F. ) + TEST_LINE( .NOT. .F. , .T. ) + TEST_LINE( .NOT. 1 , "E BASE 1077 Argument error .NOT. F:S" ) + + TEST_LINE( iif( "A", ":T:", ":F:" ) , "E BASE 1066 Argument error conditional " ) + TEST_LINE( iif( .T., ":T:", ":F:" ) , ":T:" ) + TEST_LINE( iif( .F., ":T:", ":F:" ) , ":F:" ) + + TEST_LINE( lcString++ , "E BASE 1086 Argument error ++ F:S" ) + TEST_LINE( lcString-- , "E BASE 1087 Argument error -- F:S" ) + + TEST_LINE( mxNotHere , "E BASE 1003 Variable does not exist MXNOTHERE F:R" ) + + TEST_LINE( laArray[ 0 ] , "E BASE 1132 Bound error array access " ) + TEST_LINE( laArray[ 0 ] := 1 , "E BASE 1133 Bound error array assign " ) + TEST_LINE( laArray[ 1000 ] , "E BASE 1132 Bound error array access " ) + TEST_LINE( laArray[ 1000 ] := 1 , "E BASE 1133 Bound error array assign " ) + TEST_LINE( laArray[ -1 ] , "E BASE 1132 Bound error array access " ) + TEST_LINE( laArray[ -1 ] := 1 , "E BASE 1133 Bound error array assign " ) + TEST_LINE( laArray[ "1" ] , "E BASE 1068 Argument error array access F:S" ) + TEST_LINE( laArray[ "1" ] := 1 , "E BASE 1069 Argument error array assign " ) + + TEST_LINE( lcString > 1 , "E BASE 1075 Argument error > F:S" ) + TEST_LINE( lcString >= 1 , "E BASE 1076 Argument error >= F:S" ) + TEST_LINE( lcString <> 1 , "E BASE 1072 Argument error <> F:S" ) + TEST_LINE( lcString == 1 , "E BASE 1070 Argument error == F:S" ) + TEST_LINE( {|| NIL } == {|| NIL } , "E BASE 1070 Argument error == F:S" ) + TEST_LINE( lcString = 1 , "E BASE 1071 Argument error = F:S" ) + TEST_LINE( lcString < 1 , "E BASE 1073 Argument error < F:S" ) + TEST_LINE( lcString <= 1 , "E BASE 1074 Argument error <= F:S" ) + +/* NOTE: Harbour RDD will GPF if commented out. */ +#ifndef __HARBOUR__ + +/* NOTE: TEST_CALL() should be used here, since CA-Cl*pper can't preprocess + the TEST_LINE() variation properly. */ +/* TEST_LINE( ("NOTHERE")->NOFIELD , "E BASE 1002 Alias does not exist NOTHERE F:R" ) */ + TEST_CALL( '("NOTHERE")->NOFIELD', {|| ("NOTHERE")->NOFIELD }, "E BASE 1002 Alias does not exist NOTHERE F:R" ) + TEST_LINE( NOTHERE->NOFIELD , "E BASE 1002 Alias does not exist NOTHERE F:R" ) + TEST_LINE( 200->NOFIELD , "E BASE 1003 Variable does not exist NOFIELD F:R" ) +#endif + + TEST_LINE( loObject:hello , "E BASE 1004 No exported method HELLO F:S" ) + TEST_LINE( loObject:hello := 1 , "E BASE 1005 No exported variable HELLO F:S" ) + + /* LEN() */ + + TEST_LINE( Len( NIL ) , "E BASE 1111 Argument error LEN F:S" ) + TEST_LINE( Len( 123 ) , "E BASE 1111 Argument error LEN F:S" ) + TEST_LINE( Len( "" ) , 0 ) + TEST_LINE( Len( "123" ) , 3 ) + TEST_LINE( Len( laArray ) , 1 ) +#ifdef __HARBOUR__ + TEST_LINE( Len( Space( 3000000000 ) ) , 3000000000 ) +#else + TEST_LINE( Len( Space( 40000 ) ) , 40000 ) +#endif + + /* EMPTY() */ + + TEST_LINE( Empty( @lcString ) , .T. ) /* Bug in CA-Cl*pper ? */ + TEST_LINE( Empty( @lcStringE ) , .T. ) + TEST_LINE( Empty( @lnIntP ) , .T. ) /* Bug in CA-Cl*pper ? */ + TEST_LINE( Empty( @lnIntZ ) , .T. ) + TEST_LINE( Empty( "Hallo" ) , .F. ) + TEST_LINE( Empty( "" ) , .T. ) + TEST_LINE( Empty( " " ) , .T. ) + TEST_LINE( Empty( " "+Chr(0) ) , .F. ) + TEST_LINE( Empty( " "+Chr(13)+Chr(9) ) , .T. ) + TEST_LINE( Empty( " A" ) , .F. ) + TEST_LINE( Empty( " x " ) , .F. ) + TEST_LINE( Empty( " x"+Chr(0) ) , .F. ) + TEST_LINE( Empty( " "+Chr(13)+"x"+Chr(9) ) , .F. ) + TEST_LINE( Empty( 0 ) , .T. ) + TEST_LINE( Empty( -0 ) , .T. ) + TEST_LINE( Empty( 0.0 ) , .T. ) + TEST_LINE( Empty( 70000-70000 ) , .T. ) + TEST_LINE( Empty( 1.5*1.5-2.25 ) , .T. ) + TEST_LINE( Empty( 10 ) , .F. ) + TEST_LINE( Empty( 10.0 ) , .F. ) + TEST_LINE( Empty( 70000+70000 ) , .F. ) + TEST_LINE( Empty( 1.5*1.5*2.25 ) , .F. ) + TEST_LINE( Empty( SToD("18241010") ) , .F. ) + TEST_LINE( Empty( SToD("18250231") ) , .T. ) + TEST_LINE( Empty( SToD("99999999") ) , .T. ) + TEST_LINE( Empty( SToD(" ") ) , .T. ) + TEST_LINE( Empty( SToD("") ) , .T. ) + TEST_LINE( Empty( .T. ) , .F. ) + TEST_LINE( Empty( .F. ) , .T. ) + TEST_LINE( Empty( NIL ) , .T. ) + TEST_LINE( Empty( {1} ) , .F. ) + TEST_LINE( Empty( {} ) , .T. ) + TEST_LINE( Empty( {0} ) , .F. ) + TEST_LINE( Empty( {|x|x+x} ) , .F. ) + /* ABS() */ TEST_LINE( Abs("A") , "E BASE 1089 Argument error ABS F:S" ) @@ -170,6 +443,14 @@ FUNCTION Main( cPar1 ) TEST_LINE( RAt("ABCDEFG", "ABCDEF") , 0 ) TEST_LINE( RAt("FI", "ABCDEF") , 0 ) + /* REPLICATE() */ + +#ifdef __HARBOUR__ + TEST_LINE( Replicate("XXX", 2000000000) , "E BASE 1234 String overflow REPLICATE F:S" ) +#else + TEST_LINE( Replicate("XXX", 30000) , "E BASE 1234 String overflow REPLICATE F:S" ) +#endif + /* SUBSTR() */ TEST_LINE( SubStr("abcdef", 0, -1) , "" ) @@ -255,6 +536,8 @@ FUNCTION Main( cPar1 ) TEST_LINE( PadC("abcdef", 10, "1") , "11abcdef11" ) TEST_LINE( PadC("abcdef", 10, "12") , "11abcdef11" ) + /* STUFF() */ + TEST_LINE( Stuff("ABCDEF", 0, 0, NIL) , "" ) TEST_LINE( Stuff("ABCDEF", 0, 0, "xyz") , "xyzABCDEF" ) TEST_LINE( Stuff("ABCDEF", 1, 0, "xyz") , "xyzABCDEF" ) @@ -525,8 +808,10 @@ FUNCTION Main( cPar1 ) TEST_LINE( Transform( 150 , "99,99" ) , " 1,50" ) TEST_LINE( Transform( 41 , "@Z 9999" ) , " 41" ) TEST_LINE( Transform( 0 , "@Z 9999" ) , " " ) - TEST_LINE( Transform( 41 , "@0 9999" ) , " 41" ) - TEST_LINE( Transform( 0 , "@0 9999" ) , " 0" ) +#ifdef __HARBOUR__ + TEST_LINE( Transform( 41 , "@0 9999" ) , "0041" ) /* Extension in Harbour, in CA-Cl*pper it should return: " 41" */ + TEST_LINE( Transform( 0 , "@0 9999" ) , "0000" ) /* Extension in Harbour, in CA-Cl*pper it should return: " 0" */ +#endif TEST_LINE( Transform( 41 , "@B 9999" ) , "41 " ) TEST_LINE( Transform( 41 , "@B 99.9" ) , "41.0" ) TEST_LINE( Transform( 7 , "@B 99.9" ) , "7.0 " ) @@ -570,7 +855,7 @@ FUNCTION Main( cPar1 ) #define TEST_RESULT_COL1_WIDTH 4 #define TEST_RESULT_COL2_WIDTH 30 -#define TEST_RESULT_COL3_WIDTH 40 +#define TEST_RESULT_COL3_WIDTH 55 #define TEST_RESULT_COL4_WIDTH 40 STATIC FUNCTION TEST_BEGIN( cParam ) @@ -578,42 +863,51 @@ STATIC FUNCTION TEST_BEGIN( cParam ) IF "OS/2" $ cOs .OR. ; "DOS" $ cOs - scNewLine := Chr( 13 ) + Chr( 10 ) + s_cNewLine := Chr( 13 ) + Chr( 10 ) ELSE - scNewLine := Chr( 10 ) + s_cNewLine := Chr( 10 ) ENDIF - slShowAll := "/ALL" $ Upper( cParam ) + s_lShowAll := "/ALL" $ Upper( cParam ) -/* -#ifdef __HARBOUR__ - scFileName := "rtl_test.hb" -#else - scFileName := "rtl_test.cl" -#endif -*/ + /* Detect presence of shortcutting optimalization */ - snFhnd := 1 /* FHND_STDOUT */ - scFileName := "(stdout)" + s_lShortcut := .T. + IF .T. .OR. Eval( {|| s_lShortcut := .F. } ) + /* Do nothing */ + ENDIF - snCount := 0 - snPass := 0 - snFail := 0 + /* Decide about output filename */ - fWrite( snFhnd, " Version: " + Version() + scNewLine +; - " OS: " + OS() + scNewLine +; - "Date, Time: " + DToS( Date() ) + " " + Time() + scNewLine +; - " Output: " + scFileName + scNewLine +; - " Switches: " + cParam + scNewLine +; - "===========================================================================" + scNewLine +; - scNewLine ) + DO CASE + CASE "HARBOUR" $ Upper( Version() ) ; s_cFileName := "rtl_test.hb" + CASE "CLIPPER (R)" $ Upper( Version() ) .AND. ; + "5.3" $ Version() ; s_cFileName := "rtl_test.c53" + CASE "CLIPPER (R)" $ Upper( Version() ) ; s_cFileName := "rtl_test.c5x" + ENDCASE - fWrite( snFhnd, PadL( "No", TEST_RESULT_COL1_WIDTH ) + ". " +; - PadR( "TestCall()", TEST_RESULT_COL2_WIDTH ) + " -> " +; - PadR( "Result", TEST_RESULT_COL3_WIDTH ) + " | " +; - PadR( "Expected", TEST_RESULT_COL4_WIDTH ) +; - " [! *FAIL* !]" + scNewLine ) - fWrite( snFhnd, "---------------------------------------------------------------------------" + scNewLine ) + s_nFhnd := 1 /* FHND_STDOUT */ + s_cFileName := "(stdout)" + + s_nCount := 0 + s_nPass := 0 + s_nFail := 0 + + fWrite( s_nFhnd, " Version: " + Version() + s_cNewLine +; + " OS: " + OS() + s_cNewLine +; + " Date, Time: " + DToS( Date() ) + " " + Time() + s_cNewLine +; + " Output: " + s_cFileName + s_cNewLine +; + "Shortcut opt.: " + iif( s_lShortcut, "ON", "OFF" ) + s_cNewLine +; + " Switches: " + cParam + s_cNewLine +; + "===========================================================================" + s_cNewLine +; + s_cNewLine ) + + fWrite( s_nFhnd, PadL( "No", TEST_RESULT_COL1_WIDTH ) + ". " +; + PadR( "TestCall()", TEST_RESULT_COL2_WIDTH ) + " -> " +; + PadR( "Result", TEST_RESULT_COL3_WIDTH ) + " | " +; + PadR( "Expected", TEST_RESULT_COL4_WIDTH ) +; + " [! *FAIL* !]" + s_cNewLine ) + fWrite( s_nFhnd, "---------------------------------------------------------------------------" + s_cNewLine ) RETURN NIL @@ -623,61 +917,83 @@ STATIC FUNCTION TEST_CALL( cBlock, bBlock, xResultExpected ) LOCAL bOldError LOCAL lFailed - bOldError := ErrorBlock( {|oError| Break( oError ) } ) + s_nCount++ - BEGIN SEQUENCE - xResult := Eval( bBlock ) - RECOVER USING oError - xResult := ErrorMessage( oError ) - END SEQUENCE + IF ValType( cBlock ) == "C" - ErrorBlock( bOldError ) + bOldError := ErrorBlock( {|oError| Break( oError ) } ) - snCount++ + BEGIN SEQUENCE + xResult := Eval( bBlock ) + RECOVER USING oError + xResult := ErrorMessage( oError ) + END SEQUENCE - lFailed := !( ValType( xResult ) == ValType( xResultExpected ) ) .OR. ; - !( xResult == xResultExpected ) + ErrorBlock( bOldError ) - IF slShowAll .OR. lFailed - - fWrite( snFhnd, Str( snCount, TEST_RESULT_COL1_WIDTH ) + ". " +; - PadR( StrTran( cBlock, Chr(0), "." ), TEST_RESULT_COL2_WIDTH ) + " -> " +; - PadR( StrTran( XToStr( xResult ), Chr(0), "." ), TEST_RESULT_COL3_WIDTH ) + " | " +; - PadR( StrTran( XToStr( xResultExpected ), Chr(0), "." ), TEST_RESULT_COL4_WIDTH ) ) - - IF lFailed - fWrite( snFhnd, " ! *FAIL* !" ) + IF !( ValType( xResult ) == ValType( xResultExpected ) ) + IF ValType( xResultExpected) == "C" .AND. ValType( xResult ) $ "ABM" + lFailed := !( XToStr( xResult ) == xResultExpected ) + ELSE + lFailed := .T. + ENDIF + ELSE + lFailed := !( xResult == xResultExpected ) ENDIF - fWrite( snFhnd, scNewLine ) + ELSE + + lFailed := .T. + cBlock := "!! Preprocessor error. Test skipped !!" + xResult := NIL + + ENDIF + + IF s_lShowAll .OR. lFailed + + fWrite( s_nFhnd, Str( s_nCount, TEST_RESULT_COL1_WIDTH ) + ". " +; + PadR( StrTran( cBlock, Chr(0), "." ), TEST_RESULT_COL2_WIDTH ) + " -> " +; + PadR( StrTran( XToStr( xResult ), Chr(0), "." ), TEST_RESULT_COL3_WIDTH ) + " | " +; + PadR( StrTran( XToStr( xResultExpected ), Chr(0), "." ), TEST_RESULT_COL4_WIDTH ) ) + + IF lFailed + fWrite( s_nFhnd, " ! *FAIL* !" ) + ENDIF + + fWrite( s_nFhnd, s_cNewLine ) ENDIF IF lFailed - snFail++ + s_nFail++ ELSE - snPass++ + s_nPass++ ENDIF RETURN NIL +STATIC FUNCTION TEST_OPT_Z() + RETURN s_lShortCut + STATIC FUNCTION TEST_END() - fWrite( snFhnd, scNewLine +; - "===========================================================================" + scNewLine +; - "Test calls passed: " + Str( snPass ) + scNewLine +; - "Test calls failed: " + Str( snFail ) + scNewLine +; - scNewLine ) + fWrite( s_nFhnd, s_cNewLine +; + "===========================================================================" + s_cNewLine +; + "Test calls passed: " + Str( s_nPass ) + s_cNewLine +; + "Test calls failed: " + Str( s_nFail ) + s_cNewLine +; + " ----------" + s_cNewLine +; + " Total: " + Str( s_nPass + s_nFail ) + s_cNewLine +; + s_cNewLine ) - IF snFail != 0 + IF s_nFail != 0 IF "CLIPPER (R)" $ Upper( Version() ) - fWrite( snFhnd, "WARNING ! Failures detected using CA-Clipper." + scNewLine +; - "Please fix those expected results which are not bugs in CA-Clipper itself." + scNewLine ) + fWrite( s_nFhnd, "WARNING ! Failures detected using CA-Clipper." + s_cNewLine +; + "Please fix those expected results which are not bugs in CA-Clipper itself." + s_cNewLine ) ELSE - fWrite( snFhnd, "WARNING ! Failures detected" + scNewLine ) + fWrite( s_nFhnd, "WARNING ! Failures detected" + s_cNewLine ) ENDIF ENDIF - ErrorLevel( iif( snFail != 0, 1, 0 ) ) + ErrorLevel( iif( s_nFail != 0, 1, 0 ) ) RETURN NIL @@ -687,13 +1003,13 @@ STATIC FUNCTION XToStr( xValue ) DO CASE CASE cType == "C" ; RETURN '"' + xValue + '"' CASE cType == "N" ; RETURN LTrim( Str( xValue ) ) - CASE cType == "D" ; RETURN DToC( xValue ) + CASE cType == "D" ; RETURN 'SToD("' + DToS( xValue ) + '")' CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." ) CASE cType == "O" ; RETURN xValue:className + " Object" CASE cType == "U" ; RETURN "NIL" - CASE cType == "B" ; RETURN "{||...}" - CASE cType == "A" ; RETURN "{...}" - CASE cType == "M" ; RETURN xValue + CASE cType == "B" ; RETURN '{||...}' + CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}' + CASE cType == "M" ; RETURN 'M:"' + xValue + '"' ENDCASE RETURN "" diff --git a/harbour/tests/working/strsub.prg b/harbour/tests/working/strsub.prg deleted file mode 100644 index 3d4831853b..0000000000 --- a/harbour/tests/working/strsub.prg +++ /dev/null @@ -1,42 +0,0 @@ -/* - * $Id$ - */ - -// Testing strings concat - -// Expected result: -// -// [STRINGSCONCAT ] -// [STRINGSCONCAT ] -// [STRINGSCONCAT ] -// >AB< -// >AB < -// >AB < -// >A B < -// >B < - -function main() - - LOCAL a := "STRINGS " - LOCAL b := "CONCAT" - LOCAL c - LOCAL i - - for i := 1 to 3 - a += " " - c := a - c -= b - QOut( "[" + c + "]" ) - next - - QOut( ">" + "A" - "B" + "<" ) // "AB" - QOut( ">" + "A " - "B" + "<" ) // "AB " - QOut( ">" + "A " - "B " + "<" ) // "AB " - QOut( ">" + "A " - " B" + "<" ) // "A B " - QOut( ">" + " " - "B " + "<" ) // "B " - - QOut() - __Accept( "Press to raise an error!" ) - QOut( a - i ) - -return nil