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

2007-01-17 03:55 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/libct/ctc.c
  * harbour/contrib/libct/files.c
  * harbour/contrib/libnf/ftattr.c
  * harbour/contrib/libnf/n2color.c
    * cleaned some BCC warnings

  * harbour/include/hbapi.h
  * harbour/include/hbexpra.c
  * harbour/include/hbexprb.c
  * harbour/include/hbsetup.ch
  * harbour/source/common/expropt1.c
  * harbour/source/common/expropt2.c
  * harbour/source/common/hbver.c
  * harbour/source/common/hbverdsp.c
  * harbour/source/compiler/hbcomp.c
  * harbour/source/vm/arrays.c
  * harbour/source/vm/arrayshb.c
  * harbour/source/vm/cmdarg.c
  * harbour/source/vm/hvm.c
    ! fixed Harbour support for accessing string characters with array
      index operators []
    + added support for #define HB_COMPAT_XHB - it's disabled by default.
      When set it enables some of xHarbour features like negative array
      indexes calculated from tail, accessing string characters with []
      operators (warning it's not compatible with default Harbour version
      enabled by -ks during compilation and //flags:s at runtime - in
      xHarbour compatibility mode "ABC"[2] returns "B" when in Harbour 66)
      and some other minor features.

  * harbour/source/compiler/cmdcheck.c
    * added support for optional setting C output type in -go switch
      Now it accepts optional digit [0123] after -go in the same way
      as -gc, f.e.: -go3

  * harbour/source/compiler/harbour.c
    * call hb_compExprLstDealloc() only when errors appeared during
      compilation - it disable automatic freeing all allocated expressions
      in clean compilation. I make it intentionally for easier detecting
      problems one some expressions are not freed. So far the final cleanup
      code always deallocated expressions what can hide some real bugs.

  * harbour/source/vm/hvm.c
    ! fixed very serious bug in HVM closing. The s_uiActionRequest flag
      was not cleared before hb_rddShutDown() so when RDD buffers were
      hot and flushing required some PCODE evaluation (f.e. index KEY
      or FOR expression) then they were not properly evaluated.

  * harbour/source/vm/macro.c
    * minor improvement

  * harbour/utils/hbtest/rt_misc.prg
    ! fixed one of expected result, it was neither Harbour nor Clipper
      result (I've just made some test with Clipper), I do not know why
      it existed
This commit is contained in:
Przemyslaw Czerpak
2007-01-17 02:55:14 +00:00
parent 56cb6bcd62
commit c13da799ef
22 changed files with 429 additions and 193 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
harbour/ChangeLog
View File

@@ -8,9 +8,66 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-01-17 03:55 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/libct/ctc.c
* harbour/contrib/libct/files.c
* harbour/contrib/libnf/ftattr.c
* harbour/contrib/libnf/n2color.c
* cleaned some BCC warnings
* harbour/include/hbapi.h
* harbour/include/hbexpra.c
* harbour/include/hbexprb.c
* harbour/include/hbsetup.ch
* harbour/source/common/expropt1.c
* harbour/source/common/expropt2.c
* harbour/source/common/hbver.c
* harbour/source/common/hbverdsp.c
* harbour/source/compiler/hbcomp.c
* harbour/source/vm/arrays.c
* harbour/source/vm/arrayshb.c
* harbour/source/vm/cmdarg.c
* harbour/source/vm/hvm.c
! fixed Harbour support for accessing string characters with array
index operators []
+ added support for #define HB_COMPAT_XHB - it's disabled by default.
When set it enables some of xHarbour features like negative array
indexes calculated from tail, accessing string characters with []
operators (warning it's not compatible with default Harbour version
enabled by -ks during compilation and //flags:s at runtime - in
xHarbour compatibility mode "ABC"[2] returns "B" when in Harbour 66)
and some other minor features.
* harbour/source/compiler/cmdcheck.c
* added support for optional setting C output type in -go switch
Now it accepts optional digit [0123] after -go in the same way
as -gc, f.e.: -go3
* harbour/source/compiler/harbour.c
* call hb_compExprLstDealloc() only when errors appeared during
compilation - it disable automatic freeing all allocated expressions
in clean compilation. I make it intentionally for easier detecting
problems one some expressions are not freed. So far the final cleanup
code always deallocated expressions what can hide some real bugs.
* harbour/source/vm/hvm.c
! fixed very serious bug in HVM closing. The s_uiActionRequest flag
was not cleared before hb_rddShutDown() so when RDD buffers were
hot and flushing required some PCODE evaluation (f.e. index KEY
or FOR expression) then they were not properly evaluated.
* harbour/source/vm/macro.c
* minor improvement
* harbour/utils/hbtest/rt_misc.prg
! fixed one of expected result, it was neither Harbour nor Clipper
result (I've just made some test with Clipper), I do not know why
it existed
2007-01-14 16:05 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/macro/macro.y
* formatting
* harbour/source/vm/macro.c
! fixed macrocompiler for proper compilation of string with embedded
ASCII NUL byte (chr(0)), f.e.:

4
harbour/contrib/libct/ctc.c
View File

@@ -137,9 +137,7 @@ PHB_ITEM ct_error_subst (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode,
va_start (va, uiArgCount);
for (uiArgPos = 1; uiArgPos <= uiArgCount; uiArgPos++)
{
PHB_ITEM pTemp;
hb_itemArrayPut (pArray, uiArgPos, pTemp = va_arg (va, PHB_ITEM));
HB_TRACE(HB_TR_DEBUG, ("\t%p,",pTemp));
hb_itemArrayPut (pArray, uiArgPos, va_arg (va, PHB_ITEM));
}
va_end (va);
HB_TRACE(HB_TR_DEBUG, (")"));

3
harbour/contrib/libct/files.c
View File

@@ -328,7 +328,7 @@ HB_FUNC(SETFATTR)
HB_FUNC(FILESEEK)
{
#if defined(HB_OS_WIN_32) && !defined(__CYGWIN__)
#if defined(HB_OS_WIN_32) && !defined(__CYGWIN__)
{
LPCTSTR szFile;
DWORD dwFlags=FILE_ATTRIBUTE_ARCHIVE;
@@ -352,6 +352,7 @@ HB_FUNC(FILESEEK)
if( iAttr & FA_SYSTEM )
dwFlags |= FILE_ATTRIBUTE_SYSTEM;
if( iAttr & FA_NORMAL )
dwFlags |= FILE_ATTRIBUTE_NORMAL;

12
harbour/contrib/libnf/ftattr.c
View File

@@ -181,7 +181,7 @@ HB_FUNC( FT_SAVEATT )
USHORT uiRight = ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol();
ULONG ulSize;
USHORT uiFor;
ULONG ulFor;
char * pBuffer;
char * pAttrib;
@@ -191,8 +191,8 @@ HB_FUNC( FT_SAVEATT )
hb_gtSave( uiTop, uiLeft, uiBottom, uiRight, pBuffer );
for( uiFor = 1; uiFor < ulSize; uiFor += 2 )
*(pAttrib + ((uiFor - 1) / 2)) = *(pBuffer + uiFor);
for( ulFor = 1; ulFor < ulSize; ulFor += 2 )
*(pAttrib + ((ulFor - 1) / 2)) = *(pBuffer + ulFor);
hb_xfree( pBuffer );
@@ -379,7 +379,7 @@ HB_FUNC( FT_RESTATT )
USHORT uiRight = ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol();
ULONG ulSize;
USHORT uiFor;
ULONG ulFor;
char * pBuffer;
char * pAttrib;
@@ -390,8 +390,8 @@ HB_FUNC( FT_RESTATT )
pAttrib = hb_parc( 5 );
for( uiFor = 1; uiFor < ulSize; uiFor += 2 )
*(pBuffer + uiFor) = *(pAttrib + ((uiFor - 1) / 2));
for( ulFor = 1; ulFor < ulSize; ulFor += 2 )
*(pBuffer + ulFor) = *(pAttrib + ((ulFor - 1) / 2));
hb_gtRest( uiTop, uiLeft, uiBottom, uiRight, pBuffer );

2
harbour/contrib/libnf/n2color.c
View File

@@ -87,7 +87,7 @@ HB_FUNC(FT_N2COLOR )
static void _ftI2Color( int iColor, char * cColor )
{
unsigned int iBack = 0, iFore = 0, i = 0;
unsigned int iBack, iFore, i = 0;
// check for blink attribute

16
harbour/include/hbapi.h
View File

@@ -452,6 +452,18 @@ extern HB_EXPORT void hb_retnll( LONGLONG lNumber );/* returns a long long num
extern HB_EXPORT void hb_retnlllen( LONGLONG lNumber, int iWidth ); /* returns a long long number, with specific width */
#endif
/*
* check if array/string index is in valid range, update it if necessary
* in xHarbour compatibility mode where negative indexes are used to access
* data from tail
*/
#if defined( HB_COMPAT_XHB )
# define HB_IS_VALID_INDEX( idx, max ) ( ( ( LONG ) (idx) < 0 ? (idx) += (max) + 1 : (idx) ) > 0 && ( ULONG ) (idx) <= (max) )
#else
# define HB_IS_VALID_INDEX( idx, max ) ( (idx) > 0 && ( ULONG ) (idx) <= (max) )
#endif
/* xHarbour compatible function */
#define hb_retcAdopt( szText ) hb_retc_buffer( (szText) )
#define hb_retclenAdopt( szText, ulLen ) hb_retclen_buffer( (szText), (ulLen) )
@@ -627,7 +639,7 @@ extern HB_EXPORT char * hb_arrayGetDS( PHB_ITEM pArray, ULONG ulIndex, char
extern HB_EXPORT long hb_arrayGetDL( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the date value contained in an array element, as a long integer */
extern HB_EXPORT HB_TYPE hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the type of an array item */
extern HB_EXPORT BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount ); /* fill an array with a given item */
extern HB_EXPORT ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount ); /* scan an array for a given item, or until code-block item returns TRUE */
extern HB_EXPORT ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount, BOOL fExact ); /* scan an array for a given item, or until code-block item returns TRUE */
extern HB_EXPORT BOOL hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG * pulStart, ULONG * pulCount ); /* execute a code-block for every element of an array item */
extern HB_EXPORT BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG * pulStart, ULONG * pulCount, ULONG * pulTarget ); /* copy items from one array to another */
extern HB_EXPORT PHB_ITEM hb_arrayClone( PHB_ITEM pArray ); /* returns a duplicate of an existing array, including all nested items */
@@ -819,7 +831,9 @@ extern void hb_idleShutDown( void ); /* closes all background tasks */
extern char * hb_verPlatform( void ); /* retrieves a newly allocated buffer containing platform version */
extern char * hb_verCompiler( void ); /* retrieves a newly allocated buffer containing compiler version */
extern char * hb_verHarbour( void ); /* retrieves a newly allocated buffer containing harbour version */
extern char * hb_verPCode( void ); /* retrieves a newly allocated buffer containing PCode version */
extern void hb_verBuildInfo( void ); /* display harbour, compiler, and platform versions to standard console */
extern HB_EXPORT BOOL hb_iswinnt(void); /* return .T. if OS == WinNt, 2000, XP */
/* environment variables access */

64
harbour/include/hbexpra.c
View File

@@ -654,70 +654,6 @@ HB_EXPR_PTR hb_compExprNewSend( HB_EXPR_PTR pObject, char * szMessage,
return pExpr;
}
/* In macro compiler strings should be automatically deallocated by
* the expression optimizer
* In harbour compiler strings are shared in the hash table then they
* cannot be deallocated by default
*/
HB_EXPR_PTR hb_compExprNewString( char *szValue, ULONG ulLen, BOOL fDealloc, HB_COMP_DECL )
{
HB_EXPR_PTR pExpr;
HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewString(%s)", szValue));
pExpr =hb_compExprNew( HB_ET_STRING, HB_COMP_PARAM );
pExpr->value.asString.string = szValue;
pExpr->value.asString.dealloc = fDealloc;
pExpr->ulLength = ulLen;
pExpr->ValType = HB_EV_STRING;
return pExpr;
}
/* Creates a new literal array { item1, item2, ... itemN }
* 'pArrList' is a list of array elements
*/
HB_EXPR_PTR hb_compExprNewArray( HB_EXPR_PTR pArrList, HB_COMP_DECL )
{
HB_EXPR_PTR pExpr;
HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewArray()"));
pArrList->ExprType = HB_ET_ARRAY; /* change type from ET_LIST */
pArrList->ValType = HB_EV_ARRAY;
pArrList->ulLength = 0;
pArrList->value.asList.reference = FALSE;
pExpr = pArrList->value.asList.pExprList; /* get first element on the list */
/* Now we need to replace all EO_NONE expressions with ET_NIL expressions
* If EO_NONE is the first expression and there is no more expressions
* then it is an empty array {} and ET_NIL cannot be used
*/
if( pExpr->ExprType == HB_ET_NONE && pExpr->pNext == NULL )
{
pArrList->value.asList.pExprList = NULL;
HB_EXPR_PCODE1( hb_compExprDelete, pExpr );
}
else
{
/* there are at least one non-empty element specified
*/
while( pExpr )
{
/* if empty element was specified replace it with NIL value */
if( pExpr->ExprType == HB_ET_NONE )
pExpr->ExprType = HB_ET_NIL;
pExpr = pExpr->pNext;
++pArrList->ulLength;
}
}
pArrList->value.asList.pIndex = NULL;
return pArrList;
}
/* Creates new array access expression
* pArray[ pIndex ]
* NOTE: In case of multiple indexes it is called recursively

78
harbour/include/hbexprb.c
View File

@@ -318,7 +318,8 @@ static HB_EXPR_FUNC( hb_compExprUseString )
case HB_EA_REDUCE:
break;
case HB_EA_ARRAY_AT:
hb_compErrorType( HB_COMP_PARAM, pSelf );
if( ! HB_SUPPORT_ARRSTR )
hb_compErrorType( HB_COMP_PARAM, pSelf );
break;
case HB_EA_ARRAY_INDEX:
hb_compErrorIndex( HB_COMP_PARAM, pSelf ); /* string cannot be used as index element */
@@ -1208,35 +1209,67 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt )
else
lIndex = ( LONG ) pIdx->value.asNum.val.d;
#if !defined( HB_COMPAT_XHB )
if( lIndex <= 0 )
hb_compErrorBound( HB_COMP_PARAM, pIdx ); /* index <= 0 - bound error */
else if( pExpr->ExprType == HB_ET_ARRAY ) /* is it a literal array */
else
#endif
if( pExpr->ExprType == HB_ET_ARRAY ) /* is it a literal array */
{
pExpr = pExpr->value.asList.pExprList; /* the first element in the array */
while( --lIndex && pExpr )
pExpr = pExpr->pNext;
ULONG ulSize = hb_compExprParamListCheck( HB_COMP_PARAM, pExpr );
if( pExpr ) /* found ? */
{
/* extract a single expression from the array
*/
HB_EXPR_PTR pNew = hb_compExprNew( HB_ET_NONE, HB_COMP_PARAM );
memcpy( pNew, pExpr, sizeof( HB_EXPR ) );
/* This will suppres releasing of memory occupied by components of
* the expression - we have just copied them into the new expression.
* This method is simpler then traversing the list and releasing all
* but this choosen one.
*/
pExpr->ExprType = HB_ET_NONE;
/* Here comes the magic */
HB_EXPR_PCODE1( hb_compExprDelete, pSelf );
pSelf = pNew;
}
if( pExpr->ExprType == HB_ET_MACROARGLIST )
/* restore original expression type */
pExpr->ExprType = HB_ET_ARRAY;
else if( !HB_IS_VALID_INDEX( lIndex, ulSize ) )
hb_compErrorBound( HB_COMP_PARAM, pIdx );
else
{
hb_compErrorBound( HB_COMP_PARAM, pIdx );
pExpr = pExpr->value.asList.pExprList; /* the first element in the array */
while( --lIndex && pExpr )
pExpr = pExpr->pNext;
if( pExpr ) /* found ? */
{
/* extract a single expression from the array
*/
HB_EXPR_PTR pNew = hb_compExprNew( HB_ET_NONE, HB_COMP_PARAM );
memcpy( pNew, pExpr, sizeof( HB_EXPR ) );
/* This will suppres releasing of memory occupied by components of
* the expression - we have just copied them into the new expression.
* This method is simpler then traversing the list and releasing all
* but this choosen one.
*/
pExpr->ExprType = HB_ET_NONE;
/* Here comes the magic */
HB_EXPR_PCODE1( hb_compExprDelete, pSelf );
pSelf = pNew;
}
else
hb_compErrorBound( HB_COMP_PARAM, pIdx );
}
}
else if( pExpr->ExprType == HB_ET_STRING && HB_SUPPORT_ARRSTR ) /* is it a literal string */
{
if( HB_IS_VALID_INDEX( lIndex, pExpr->ulLength ) )
{
#if defined( HB_COMPAT_XHB )
char * pszValue = ( char * ) hb_xgrab( 2 );
pszValue[ 0 ] = pExpr->value.asString.string[ lIndex - 1 ];
pszValue[ 1 ] = '\0';
HB_EXPR_PCODE1( hb_compExprDelete, pSelf );
pSelf = hb_compExprNewString( pszValue, 1, TRUE, HB_COMP_PARAM );
#else
UCHAR ucValue = ( UCHAR ) pExpr->value.asString.string[ lIndex - 1 ];
HB_EXPR_PCODE1( hb_compExprDelete, pSelf );
pSelf = hb_compExprNewLong( ucValue, HB_COMP_PARAM );
#endif
}
else
hb_compErrorBound( HB_COMP_PARAM, pIdx );
}
else
{
HB_EXPR_USE( pExpr, HB_EA_ARRAY_AT );
@@ -1281,6 +1314,7 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt )
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPUSH );
break;
}
case HB_EA_POP_PCODE:
{
BOOL fMacroIndex = FALSE, bRemoveRef = FALSE;

1
harbour/include/hbsetup.ch
View File

@@ -70,6 +70,7 @@
/* #define HB_COMPAT_FOXPRO */ /* Enable FoxPro extensions */
/* #define HB_COMPAT_DBASE */ /* Enable dBase extensions */
/* #define HB_COMPAT_CLIP */ /* Enable CLIP extensions */
/* #define HB_COMPAT_XHB */ /* Enable xHarbour extensions */
/* NOTE: HB_SHORTNAMES must be defined manually if the symbol name length is
set to 10 explicitly and not through the HB_C52_STRICT option

59
harbour/source/common/expropt1.c
View File

@@ -262,6 +262,65 @@ HB_EXPR_PTR hb_compExprNewDate( HB_LONG lValue, HB_COMP_DECL )
return pExpr;
}
HB_EXPR_PTR hb_compExprNewString( char *szValue, ULONG ulLen, BOOL fDealloc, HB_COMP_DECL )
{
HB_EXPR_PTR pExpr;
HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewString(%s)", szValue));
pExpr = hb_compExprNew( HB_ET_STRING, HB_COMP_PARAM );
pExpr->value.asString.string = szValue;
pExpr->value.asString.dealloc = fDealloc;
pExpr->ulLength = ulLen;
pExpr->ValType = HB_EV_STRING;
return pExpr;
}
/* Creates a new literal array { item1, item2, ... itemN }
* 'pArrList' is a list of array elements
*/
HB_EXPR_PTR hb_compExprNewArray( HB_EXPR_PTR pArrList, HB_COMP_DECL )
{
HB_EXPR_PTR pExpr;
HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewArray()"));
pArrList->ExprType = HB_ET_ARRAY; /* change type from ET_LIST */
pArrList->ValType = HB_EV_ARRAY;
pArrList->ulLength = 0;
pArrList->value.asList.reference = FALSE;
pExpr = pArrList->value.asList.pExprList; /* get first element on the list */
/* Now we need to replace all EO_NONE expressions with ET_NIL expressions
* If EO_NONE is the first expression and there is no more expressions
* then it is an empty array {} and ET_NIL cannot be used
*/
if( pExpr->ExprType == HB_ET_NONE && pExpr->pNext == NULL )
{
pArrList->value.asList.pExprList = NULL;
HB_EXPR_PCODE1( hb_compExprDelete, pExpr );
}
else
{
/* there are at least one non-empty element specified
*/
while( pExpr )
{
/* if empty element was specified replace it with NIL value */
if( pExpr->ExprType == HB_ET_NONE )
pExpr->ExprType = HB_ET_NIL;
pExpr = pExpr->pNext;
++pArrList->ulLength;
}
}
pArrList->value.asList.pIndex = NULL;
return pArrList;
}
HB_EXPR_PTR hb_compExprNewCodeBlock( char *string, int iLen, int iFlags, HB_COMP_DECL )
{
HB_EXPR_PTR pExpr;

3
harbour/source/common/expropt2.c
View File

@@ -1283,7 +1283,8 @@ BOOL hb_compExprReduceAT( HB_EXPR_PTR pSelf, HB_COMP_DECL )
if( pSub->ExprType == HB_ET_STRING && pText->ExprType == HB_ET_STRING )
{
if( pSub->value.asString.string[0] == '\0' )
/* This is CA-Clipper optimizer behavior */
if( pSub->ulLength == 0 )
{
pReduced = hb_compExprNewLong( 1, HB_COMP_PARAM );
}

14
harbour/source/common/hbver.c
View File

@@ -528,3 +528,17 @@ char * hb_verHarbour( void )
return pszVersion;
}
char * hb_verPCode( void )
{
char * pszPCode;
HB_TRACE(HB_TR_DEBUG, ("hb_verPCode()"));
pszPCode = ( char * ) hb_xgrab( 24 );
snprintf( pszPCode, 32, "PCode version: %d.%d",
HB_PCODE_VER >> 8, HB_PCODE_VER & 0xff );
return pszPCode;
}

15
harbour/source/common/hbverdsp.c
View File

@@ -75,6 +75,13 @@ void hb_verBuildInfo( void )
hb_xfree( pszVersion );
}
{
char * pszPCode = hb_verPCode();
hb_conOutErr( pszPCode, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszPCode );
}
{
char * pszVersion = hb_verCompiler();
hb_conOutErr( "Compiler: ", 0 );
@@ -162,6 +169,14 @@ void hb_verBuildInfo( void )
#endif
hb_conOutErr( hb_conNewLine(), 0 );
hb_conOutErr( "xHarbour compatible extensions: ", 0 );
#if defined( HB_COMPAT_XHB )
hb_conOutErr( "Yes", 0 );
#else
hb_conOutErr( "No", 0 );
#endif
hb_conOutErr( hb_conNewLine(), 0 );
hb_conOutErr( "Alaska Xbase++ compatible extensions: ", 0 );
#if defined( HB_COMPAT_XPP )
hb_conOutErr( "Yes", 0 );

33
harbour/source/compiler/cmdcheck.c
View File

@@ -243,6 +243,34 @@ static void hb_compChkEnvironVar( HB_COMP_DECL, char *szSwitch )
}
break;
case 'o':
case 'O':
HB_COMP_PARAM->iLanguage = LANG_OBJ_MODULE;
switch( *( s + 2 ) )
{
case '3':
HB_COMP_PARAM->iGenCOutput = HB_COMPGENC_REALCODE;
break;
case '2':
HB_COMP_PARAM->iGenCOutput = HB_COMPGENC_VERBOSE;
break;
case '1':
HB_COMP_PARAM->iGenCOutput = HB_COMPGENC_NORMAL;
break;
case '\0':
case '0':
HB_COMP_PARAM->iGenCOutput = HB_COMPGENC_COMPACT;
break;
default:
hb_compGenError( HB_COMP_PARAM, hb_comp_szErrors, 'F', HB_COMP_ERR_BADOPTION, s, NULL );
}
break;
case 'j':
case 'J':
HB_COMP_PARAM->iLanguage = LANG_JAVA;
@@ -258,11 +286,6 @@ static void hb_compChkEnvironVar( HB_COMP_DECL, char *szSwitch )
HB_COMP_PARAM->iLanguage = LANG_CLI;
break;
case 'o':
case 'O':
HB_COMP_PARAM->iLanguage = LANG_OBJ_MODULE;
break;
case 'w':
case 'W':
HB_COMP_PARAM->iLanguage = LANG_OBJ32;

18
harbour/source/compiler/harbour.c
View File

@@ -99,7 +99,8 @@ static void hb_compMainExit( HB_COMP_DECL )
{
hb_compCompileEnd( HB_COMP_PARAM );
hb_compParserStop( HB_COMP_PARAM );
hb_compExprLstDealloc( HB_COMP_PARAM );
if( HB_COMP_PARAM->iErrorCount != 0 )
hb_compExprLstDealloc( HB_COMP_PARAM );
hb_compIdentifierClose( HB_COMP_PARAM );
if( HB_COMP_PARAM->pOutPath )
@@ -761,7 +762,7 @@ void hb_compVariableAdd( HB_COMP_DECL, char * szVarName, BYTE cValueType )
/* check if we are declaring local/static variable after some
* executable statements
*/
if( HB_COMP_PARAM->functions.pLast->bFlags & FUN_STATEMENTS )
if( pFunc->bFlags & FUN_STATEMENTS )
{
char * szVarScope;
switch( HB_COMP_PARAM->iVarScope )
@@ -867,9 +868,9 @@ void hb_compVariableAdd( HB_COMP_DECL, char * szVarName, BYTE cValueType )
case ( VS_PARAMETER | VS_PRIVATE ):
{
if( ++HB_COMP_PARAM->functions.pLast->wParamNum > HB_COMP_PARAM->functions.pLast->wParamCount )
if( ++pFunc->wParamNum > pFunc->wParamCount )
{
HB_COMP_PARAM->functions.pLast->wParamCount = HB_COMP_PARAM->functions.pLast->wParamNum;
pFunc->wParamCount = pFunc->wParamNum;
}
pSym = hb_compSymbolFind( HB_COMP_PARAM, szVarName, &wPos, HB_SYM_MEMVAR ); /* check if symbol exists already */
@@ -880,7 +881,7 @@ void hb_compVariableAdd( HB_COMP_DECL, char * szVarName, BYTE cValueType )
/*printf( "\nAdded Symbol: %s Pos: %i\n", pSym->szName, wPos );*/
hb_compGenPCode4( HB_P_PARAMETER, HB_LOBYTE( wPos ), HB_HIBYTE( wPos ), HB_LOBYTE( HB_COMP_PARAM->functions.pLast->wParamNum ), HB_COMP_PARAM );
hb_compGenPCode4( HB_P_PARAMETER, HB_LOBYTE( wPos ), HB_HIBYTE( wPos ), HB_LOBYTE( pFunc->wParamNum ), HB_COMP_PARAM );
}
if ( HB_COMP_PARAM->iWarnings >= 3 )
@@ -1003,8 +1004,8 @@ void hb_compVariableAdd( HB_COMP_DECL, char * szVarName, BYTE cValueType )
}
if( HB_COMP_PARAM->iVarScope == VS_PARAMETER )
{
++HB_COMP_PARAM->functions.pLast->wParamCount;
HB_COMP_PARAM->functions.pLast->bFlags |= FUN_USES_LOCAL_PARAMS;
++pFunc->wParamCount;
pFunc->bFlags |= FUN_USES_LOCAL_PARAMS;
}
if( HB_COMP_PARAM->fDebugInfo )
{
@@ -4437,6 +4438,9 @@ void hb_compCodeBlockRewind( HB_COMP_DECL )
/* initialize support variables */
static void hb_compInitVars( HB_COMP_DECL )
{
if( HB_COMP_PARAM->iErrorCount != 0 )
hb_compExprLstDealloc( HB_COMP_PARAM );
HB_COMP_PARAM->functions.iCount = 0;
HB_COMP_PARAM->functions.pFirst = NULL;
HB_COMP_PARAM->functions.pLast = NULL;

3
harbour/source/compiler/hbcomp.c
View File

@@ -77,6 +77,9 @@ HB_COMP_PTR hb_comp_new( void )
HB_COMPFLAG_HB_INLINE |
HB_COMPFLAG_OPTJUMP |
HB_COMPFLAG_MACROTEXT |
#if defined( HB_COMPAT_XHB )
HB_COMPFLAG_ARRSTR |
#endif
HB_COMPFLAG_SHORTCUTS;
pComp->fTextSubst = ( pComp->supported & HB_COMPFLAG_MACROTEXT ) != 0;

22
harbour/source/vm/arrays.c
View File

@@ -340,12 +340,12 @@ HB_EXPORT BOOL hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex )
hb_itemMoveRef( pBaseArray->pItems + ulIndex - 1,
pBaseArray->pItems + ulIndex );
}
}
return TRUE;
return TRUE;
}
}
else
return FALSE;
return FALSE;
}
HB_EXPORT BOOL hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
@@ -370,12 +370,12 @@ HB_EXPORT BOOL hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
hb_itemMoveRef( pBaseArray->pItems + ulLen,
pBaseArray->pItems + ulLen - 1 );
}
}
return TRUE;
return TRUE;
}
}
else
return FALSE;
return FALSE;
}
HB_EXPORT BOOL hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
@@ -651,9 +651,9 @@ BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * p
return FALSE;
}
ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount )
ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount, BOOL fExact )
{
HB_TRACE(HB_TR_DEBUG, ("hb_arrayScan(%p, %p, %p, %p)", pArray, pValue, pulStart, pulCount));
HB_TRACE(HB_TR_DEBUG, ("hb_arrayScan(%p, %p, %p, %p, %d)", pArray, pValue, pulStart, pulCount, (int) fExact));
if( HB_IS_ARRAY( pArray ) )
{
@@ -701,7 +701,7 @@ ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG *
/* NOTE: The order of the pItem and pValue parameters passed to
hb_itemStrCmp() is significant, please don't change it. [vszakats] */
if( HB_IS_STRING( pItem ) && hb_itemStrCmp( pItem, pValue, FALSE ) == 0 )
if( HB_IS_STRING( pItem ) && hb_itemStrCmp( pItem, pValue, fExact ) == 0 )
return ulStart;
}
while( --ulCount > 0 );

50
harbour/source/vm/arrayshb.c
View File

@@ -175,8 +175,24 @@ HB_FUNC( AINS )
if( pArray )
{
if( ISNUM( 2 ) )
hb_arrayIns( pArray, hb_parnl( 2 ) );
long lPos = hb_parnl( 2 );
if( lPos == 0 )
lPos = 1;
#if defined( HB_COMPAT_XHB )
if( hb_pcount() >= 4 && ISLOG( 4 ) && hb_parl( 4 ) &&
lPos >= 1 && ( ULONG ) lPos <= pArray->item.asArray.value->ulLen + 1 )
hb_arraySize( pArray, pArray->item.asArray.value->ulLen + 1 );
if( hb_arrayIns( pArray, lPos ) )
{
if( hb_pcount() >= 3 && !ISNIL( 3 ) )
hb_arraySet( pArray, lPos, hb_param( 3, HB_IT_ANY ) );
}
#else
hb_arrayIns( pArray, lPos );
#endif
hb_itemReturn( pArray ); /* AIns() returns the array itself */
}
@@ -188,12 +204,21 @@ HB_FUNC( ADEL )
if( pArray )
{
long int ulPos = 1;
long lPos = hb_parnl( 2 );
if( ISNUM( 2 ) && hb_parnl( 2 ) )
ulPos = hb_parnl( 2 );
if( lPos == 0 )
lPos = 1;
#if defined( HB_COMPAT_XHB )
if( hb_arrayDel( pArray, lPos ) )
{
if( hb_pcount() >= 3 && ISLOG( 3 ) && hb_parl( 3 ) )
hb_arraySize( pArray, pArray->item.asArray.value->ulLen - 1 );
}
#else
hb_arrayDel( pArray, lPos );
#endif
hb_arrayDel( pArray, ulPos );
hb_itemReturn( pArray ); /* ADel() returns the array itself */
}
}
@@ -260,10 +285,17 @@ HB_FUNC( ASCAN )
ULONG ulStart = hb_parnl( 3 );
ULONG ulCount = hb_parnl( 4 );
hb_retnl( hb_arrayScan( pArray,
pValue,
#if defined( HB_COMPAT_XHB )
hb_retnl( hb_arrayScan( pArray, pValue,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL ) );
ISNUM( 4 ) ? &ulCount : NULL,
hb_parl( 5 ) ) );
#else
hb_retnl( hb_arrayScan( pArray, pValue,
ISNUM( 3 ) ? &ulStart : NULL,
ISNUM( 4 ) ? &ulCount : NULL,
FALSE ) );
#endif
}
else
hb_retnl( 0 );

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

@@ -308,7 +308,11 @@ ULONG hb_cmdargProcessVM( int *pCancelKey, int *pCancelKeyEx )
{
char * cFlags;
ULONG ulFlags = HB_VMFLAG_HARBOUR;
#if defined( HB_COMPAT_XHB )
ulFlags |= HB_VMFLAG_ARRSTR;
#endif
if( hb_cmdargCheck( "INFO" ) )
{
{
@@ -339,7 +343,7 @@ ULONG hb_cmdargProcessVM( int *pCancelKey, int *pCancelKeyEx )
if( (cFlags = hb_cmdargString( "FLAGS" )) != NULL )
{
int i = 1;
int i = 0;
while( cFlags[ i ] )
{
switch( cFlags[ i++ ] )

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

@@ -539,6 +539,8 @@ HB_EXPORT int hb_vmQuit( void )
hb_pp_Free();
#endif
hb_idleShutDown();
/* process AtExit registered functions */
hb_vmDoModuleExitFunctions();
hb_vmCleanModuleFunctions();
@@ -546,6 +548,7 @@ HB_EXPORT int hb_vmQuit( void )
/* release all known items stored in subsystems */
hb_itemClear( hb_stackReturnItem() );
hb_stackRemove( 1 ); /* clear stack items, leave only initial symbol item */
hb_memvarsClear(); /* clear all PUBLIC (and PRIVATE if any) variables */
/* intentionally here to allow executing object destructors for all
@@ -553,8 +556,11 @@ HB_EXPORT int hb_vmQuit( void )
*/
hb_gcCollectAll();
/* Clear any pending actions so RDD shutdown process
* can be cleanly executed
*/
s_uiActionRequest = 0;
hb_rddShutDown();
hb_idleShutDown();
hb_errExit();
hb_clsReleaseAll();
@@ -3063,6 +3069,17 @@ static void hb_vmInstring( void )
else if( hb_objOperatorCall( HB_OO_OP_INSTRING, pItem1, pItem1, pItem2, NULL ) )
hb_stackPop();
#if defined( HB_COMPAT_XHB )
else if( HB_IS_ARRAY( pItem2 ) )
{
BOOL fResult = hb_arrayScan( pItem2, pItem1, NULL, NULL, TRUE );
hb_stackPop();
hb_stackPop();
hb_vmPushLogical( fResult );
}
#endif
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1109, NULL, "$", 2, pItem1, pItem2 );
@@ -3665,7 +3682,7 @@ static void hb_vmArrayPush( void )
return;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
{
if( hb_gcRefCount( pArray->item.asArray.value ) > 1 )
{
@@ -3691,16 +3708,20 @@ static void hb_vmArrayPush( void )
/* #ifndef HB_C52_STRICT */
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
BYTE b = 0;
if( ulIndex > 0 && ulIndex <= pArray->item.asString.length )
b = ( BYTE ) pArray->item.asString.value[ ulIndex - 1 ];
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
UCHAR uc = ( UCHAR ) pArray->item.asString.value[ ulIndex - 1 ];
#if defined( HB_COMPAT_XHB )
hb_itemPutCL( pArray, hb_vm_acAscii[ uc ], 1 );
#else
hb_itemPutNI( pArray, uc );
#endif
hb_stackPop();
}
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
2, pArray, pIndex );
hb_itemPutNI( pArray, b );
hb_stackPop();
return;
}
/* #endif */
@@ -3759,7 +3780,7 @@ static void hb_vmArrayPushRef( void )
return;
}
#endif
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
{
/* This function is safe for overwriting passed array, [druzus] */
hb_arrayGetItemRef( pArray, ulIndex, pArray );
@@ -3797,6 +3818,9 @@ static void hb_vmArrayPop( void )
return;
}
if( HB_IS_BYREF( pArray ) )
pArray = hb_itemUnRef( pArray );
if( HB_IS_ARRAY( pArray ) )
{
if( HB_IS_OBJECT( pArray ) &&
@@ -3808,7 +3832,7 @@ static void hb_vmArrayPop( void )
return;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
{
pValue->type &= ~HB_IT_MEMOFLAG;
hb_itemMove( pArray->item.asArray.value->pItems + ulIndex - 1, pValue );
@@ -3822,14 +3846,22 @@ static void hb_vmArrayPop( void )
/* #ifndef HB_C52_STRICT */
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
if( ulIndex > 0 && ulIndex <= pArray->item.asString.length )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
#if defined( HB_COMPAT_XHB )
char cValue = HB_IS_STRING( pValue ) ? pValue->item.asString.value[ 0 ] :
hb_itemGetNI( pValue );
#else
char cValue = hb_itemGetNI( pValue );
#endif
if( pArray->item.asString.length == 1 )
hb_itemPutCL( pArray, hb_vm_acAscii[ ( unsigned char ) hb_itemGetNI( pValue ) ], 1 );
{
hb_itemPutCL( pArray, hb_vm_acAscii[ ( unsigned char ) cValue ], 1 );
}
else
{
hb_itemUnShareString( pArray );
pArray->item.asString.value[ ulIndex - 1 ] = ( char ) hb_itemGetNI( pValue );
pArray->item.asString.value[ ulIndex - 1 ] = ( char ) cValue;
}
hb_stackPop();
@@ -6002,7 +6034,7 @@ HB_EXPORT PHB_SYMB hb_vmProcessSymbolsEx( PHB_SYMB pSymbols, USHORT uiModuleSymb
if( uiPCodeVer != 0 )
{
if( uiPCodeVer > HB_PCODE_VER || /* the module is compiled with newer compiler version then HVM */
uiPCodeVer < HB_PCODE_VER_MIN ) /* the module is compiled with olde compiler version */
uiPCodeVer < HB_PCODE_VER_MIN ) /* the module is compiled with old not longer supported by HVM compiler version */
{
char szPCode[ 10 ];
snprintf( szPCode, sizeof( szPCode ), "%i.%i", uiPCodeVer>>8, uiPCodeVer &0xff );
@@ -7992,7 +8024,7 @@ static void hb_vmArrayItemPush( ULONG ulIndex )
return;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
{
if( hb_gcRefCount( pArray->item.asArray.value ) > 1 )
{
@@ -8022,19 +8054,21 @@ static void hb_vmArrayItemPush( ULONG ulIndex )
/* #ifndef HB_C52_STRICT */
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
BYTE b = 0;
if( ulIndex > 0 && ulIndex <= pArray->item.asString.length )
b = pArray->item.asString.value[ ulIndex - 1 ];
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
UCHAR uc = ( UCHAR ) pArray->item.asString.value[ ulIndex - 1 ];
#if defined( HB_COMPAT_XHB )
hb_itemPutCL( pArray, hb_vm_acAscii[ uc ], 1 );
#else
hb_itemPutNI( pArray, uc );
#endif
}
else
{
hb_vmPushNumInt( ulIndex );
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
2, pArray, hb_stackItemFromTop( -1 ) );
hb_stackPop();
}
hb_stackPop();
hb_vmPushInteger( b );
return;
}
/* #endif */
@@ -8062,6 +8096,9 @@ static void hb_vmArrayItemPop( ULONG ulIndex )
pValue = hb_stackItemFromTop( -2 );
pArray = hb_stackItemFromTop( -1 );
if( HB_IS_BYREF( pArray ) )
pArray = hb_itemUnRef( pArray );
if( HB_IS_ARRAY( pArray ) )
{
if( HB_IS_OBJECT( pArray ) && hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
@@ -8075,7 +8112,7 @@ static void hb_vmArrayItemPop( ULONG ulIndex )
return;
}
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
{
pValue->type &= ~HB_IT_MEMOFLAG;
hb_itemMove( pArray->item.asArray.value->pItems + ulIndex - 1, pValue );
@@ -8089,16 +8126,24 @@ static void hb_vmArrayItemPop( ULONG ulIndex )
}
}
/* #ifndef HB_C52_STRICT */
else if( hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) && HB_IS_STRING( pArray ) )
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
if( ulIndex > 0 && ulIndex <= pArray->item.asString.length )
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
#if defined( HB_COMPAT_XHB )
char cValue = HB_IS_STRING( pValue ) ? pValue->item.asString.value[ 0 ] :
hb_itemGetNI( pValue );
#else
char cValue = hb_itemGetNI( pValue );
#endif
if( pArray->item.asString.length == 1 )
hb_itemPutCL( pArray, hb_vm_acAscii[ ( BYTE ) hb_itemGetNI( pValue ) ], 1 );
{
hb_itemPutCL( pArray, hb_vm_acAscii[ ( unsigned char ) cValue ], 1 );
}
else
{
hb_itemUnShareString( pArray );
pArray->item.asString.value[ ulIndex - 1 ] = hb_itemGetNI( pValue );
pArray->item.asString.value[ ulIndex - 1 ] = ( char ) cValue;
}
hb_stackPop();
hb_stackPop(); /* remove the value from the stack just like other POP operations */

52
harbour/source/vm/macro.c
View File

@@ -76,14 +76,9 @@ static ULONG s_macroFlags = HB_SM_SHORTCUTS;
* 'iFlag' - specifies if compiled code should generate pcodes either for push
* operation (for example: var :=&macro) or for pop operation (&macro :=var)
*/
static int hb_macroParse( HB_MACRO_PTR pMacro, char * szString, ULONG ulLen )
static int hb_macroParse( HB_MACRO_PTR pMacro )
{
/* initialize the input buffer - it will be scanned by lex */
pMacro->string = szString;
pMacro->length = ulLen;
pMacro->pError = NULL;
HB_TRACE(HB_TR_DEBUG, ("hb_macroParse(%p, %s, %lu)", pMacro, szString, ulLen));
HB_TRACE(HB_TR_DEBUG, ("hb_macroParse(%p)", pMacro));
/* initialize the output (pcode) buffer - it will be filled by yacc */
pMacro->pCodeInfo = (HB_PCODE_INFO_PTR ) hb_xgrab( sizeof( HB_PCODE_INFO ) );
@@ -97,8 +92,10 @@ static int hb_macroParse( HB_MACRO_PTR pMacro, char * szString, ULONG ulLen )
/* reset the type of compiled expression - this should be filled after
* successfully compilation
*/
pMacro->pError = NULL;
pMacro->uiListElements = 0;
pMacro->exprType = HB_ET_NONE;
return hb_macroYYParse( pMacro );
}
@@ -414,8 +411,6 @@ void hb_macroGetValue( HB_ITEM_PTR pItem, BYTE iContext, BYTE flags )
{
HB_MACRO struMacro;
int iStatus;
char * szString = pItem->item.asString.value;
ULONG ulLen = pItem->item.asString.length;
#ifdef HB_MACRO_STATEMENTS
char * pText;
char * pOut;
@@ -425,6 +420,8 @@ void hb_macroGetValue( HB_ITEM_PTR pItem, BYTE iContext, BYTE flags )
struMacro.Flags = HB_MACRO_GEN_PUSH;
struMacro.uiNameLen = HB_SYMBOL_NAME_LEN;
struMacro.status = HB_MACRO_CONT;
struMacro.string = pItem->item.asString.value;
struMacro.length = pItem->item.asString.length;
if( iContext != 0 )
{
@@ -457,8 +454,8 @@ void hb_macroGetValue( HB_ITEM_PTR pItem, BYTE iContext, BYTE flags )
pText = ( char * ) hb_xgrab( HB_PP_STR_SIZE );
pOut = ( char * ) hb_xgrab( HB_PP_STR_SIZE );
ptr = pText;
slen = HB_MIN( strlen( szString ), HB_PP_STR_SIZE - 1 );
memcpy( pText, szString, slen );
slen = HB_MIN( strlen( struMacro.string ), HB_PP_STR_SIZE - 1 );
memcpy( pText, struMacro.string, slen );
pText[ slen ] = 0;
memset( pOut, 0, HB_PP_STR_SIZE );
@@ -470,12 +467,12 @@ void hb_macroGetValue( HB_ITEM_PTR pItem, BYTE iContext, BYTE flags )
}
hb_pp_ParseExpression( ptr, pOut );
szString = pText;
ulLen = strlen( pText );
struMacro.string = pText;
struMacro.length = strlen( pText );
}
#endif
iStatus = hb_macroParse( &struMacro, szString, ulLen );
iStatus = hb_macroParse( &struMacro );
#ifdef HB_MACRO_STATEMENTS
if( struMacro.supported & HB_SM_PREPROC )
{
@@ -510,8 +507,6 @@ void hb_macroSetValue( HB_ITEM_PTR pItem, BYTE flags )
if( hb_macroCheckParam( pItem ) )
{
char * szString = pItem->item.asString.value;
ULONG ulLen = pItem->item.asString.length;
HB_MACRO struMacro;
int iStatus;
@@ -520,7 +515,10 @@ void hb_macroSetValue( HB_ITEM_PTR pItem, BYTE flags )
struMacro.Flags = HB_MACRO_GEN_POP;
struMacro.uiNameLen = HB_SYMBOL_NAME_LEN;
struMacro.status = HB_MACRO_CONT;
iStatus = hb_macroParse( &struMacro, szString, ulLen );
struMacro.string = pItem->item.asString.value;
struMacro.length = pItem->item.asString.length;
iStatus = hb_macroParse( &struMacro );
hb_stackPop(); /* remove compiled string */
if( iStatus == HB_MACRO_OK && ( struMacro.status & HB_MACRO_CONT ) )
@@ -568,7 +566,9 @@ static void hb_macroUseAliased( HB_ITEM_PTR pAlias, HB_ITEM_PTR pVar, int iFlag,
struMacro.Flags = iFlag;
struMacro.uiNameLen = HB_SYMBOL_NAME_LEN;
struMacro.status = HB_MACRO_CONT;
iStatus = hb_macroParse( &struMacro, szString, ulLen );
struMacro.string = szString;
struMacro.length = ulLen;
iStatus = hb_macroParse( &struMacro );
hb_xfree( szString );
struMacro.string = NULL;
@@ -589,15 +589,15 @@ static void hb_macroUseAliased( HB_ITEM_PTR pAlias, HB_ITEM_PTR pVar, int iFlag,
*/
HB_MACRO struMacro;
int iStatus;
char * szString = pVar->item.asString.value;
ULONG ulLen = pVar->item.asString.length;
struMacro.mode = HB_MODE_MACRO;
struMacro.supported = (bSupported & HB_SM_RT_MACRO) ? s_macroFlags : bSupported;
struMacro.Flags = iFlag | HB_MACRO_GEN_ALIASED;
struMacro.uiNameLen = HB_SYMBOL_NAME_LEN;
struMacro.status = HB_MACRO_CONT;
iStatus = hb_macroParse( &struMacro, szString, ulLen );
struMacro.string = pVar->item.asString.value;
struMacro.length = pVar->item.asString.length;
iStatus = hb_macroParse( &struMacro );
hb_stackPop(); /* remove compiled string */
@@ -670,8 +670,10 @@ HB_MACRO_PTR hb_macroCompile( char * szString )
HB_MACRO_GEN_LIST | HB_MACRO_GEN_PARE;
pMacro->uiNameLen = HB_SYMBOL_NAME_LEN;
pMacro->status = HB_MACRO_CONT;
pMacro->string = szString;
pMacro->length = strlen( szString );
iStatus = hb_macroParse( pMacro, szString, strlen( szString ) );
iStatus = hb_macroParse( pMacro );
if( ! ( iStatus == HB_MACRO_OK && ( pMacro->status & HB_MACRO_CONT ) ) )
{
hb_macroDelete( pMacro );
@@ -761,15 +763,15 @@ char * hb_macroGetType( HB_ITEM_PTR pItem )
{
HB_MACRO struMacro;
int iStatus;
char * szString = pItem->item.asString.value;
ULONG ulLen = pItem->item.asString.length;
struMacro.mode = HB_MODE_MACRO;
struMacro.supported = s_macroFlags;
struMacro.Flags = HB_MACRO_GEN_PUSH | HB_MACRO_GEN_TYPE;
struMacro.uiNameLen = HB_SYMBOL_NAME_LEN;
struMacro.status = HB_MACRO_CONT;
iStatus = hb_macroParse( &struMacro, szString, ulLen );
struMacro.string = pItem->item.asString.value;
struMacro.length = pItem->item.asString.length;
iStatus = hb_macroParse( &struMacro );
if( iStatus == HB_MACRO_OK )
{

9
harbour/utils/hbtest/rt_misc.prg
View File

@@ -237,16 +237,11 @@ FUNCTION Main_MISC()
TEST_LINE( Eval( NIL ) , "E BASE 1004 No exported method EVAL A:1:U:NIL F:S" )
TEST_LINE( Eval( 1 ) , "E BASE 1004 No exported method EVAL A:1:N:1 F:S" )
#ifdef __HARBOUR__
TEST_LINE( Eval( @sbBlock ) , NIL ) /* Bug in CA-Cl*pper, it will return: "E BASE 1004 No exported method EVAL F:S" */
#endif
TEST_LINE( Eval( @sbBlock ) , "E BASE 1004 No exported method EVAL A:1:B:{||...} F:S" ) /* CA-Cl*pper returns "E BASE 1004 No exported method EVAL A:1:U:{||...} F:S" */
TEST_LINE( Eval( {|p1| p1 },"A","B") , "A" )
TEST_LINE( Eval( {|p1,p2| p1+p2 },"A","B") , "AB" )
TEST_LINE( Eval( {|p1,p2,p3| p1 },"A","B") , "A" )
/* Harbour compiler not yet handles these */
#ifndef __HARBOUR__
TEST_LINE( suNIL:Eval() , "E BASE 1004 No exported method EVAL A:1:U:NIL F:S" )
#endif
TEST_LINE( scString:Eval() , "E BASE 1004 No exported method EVAL A:1:C:HELLO F:S" )
TEST_LINE( snIntP:Eval() , "E BASE 1004 No exported method EVAL A:1:N:10 F:S" )
TEST_LINE( sdDateE:Eval() , "E BASE 1004 No exported method EVAL A:1:D: F:S" )
@@ -254,9 +249,7 @@ FUNCTION Main_MISC()
TEST_LINE( sbBlock:Eval() , NIL )
TEST_LINE( saArray:Eval() , "E BASE 1004 No exported method EVAL A:1:A:{.[1].} F:S" )
TEST_LINE( soObject:Eval() , "E BASE 1004 No exported method EVAL A:1:O:ERROR Object F:S" )
#ifndef __HARBOUR__
TEST_LINE( suNIL:Eval , "E BASE 1004 No exported method EVAL A:1:U:NIL F:S" )
#endif
TEST_LINE( scString:Eval , "E BASE 1004 No exported method EVAL A:1:C:HELLO F:S" )
TEST_LINE( snIntP:Eval , "E BASE 1004 No exported method EVAL A:1:N:10 F:S" )
TEST_LINE( sdDateE:Eval , "E BASE 1004 No exported method EVAL A:1:D: F:S" )