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

2010-02-26 00:22 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* contrib/hbxpp/xppop.prg
  * contrib/hbxpp/xppopc.c
    ! Restored stupport for negative indexes in 'string[ n ]' syntax.
    * Two reported RTE made XPP compatible regarding 'string[ n ]' syntax.
      Left marked as TODO. I hope one day an XPP user will complete them.
    ! Fixed names of an internal function to not be the same as in xhb lib.
This commit is contained in:
Viktor Szakats
2010-02-25 23:24:10 +00:00
parent e0392d950d
commit 043a74384e
3 changed files with 26 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
harbour/ChangeLog
View File

@@ -17,6 +17,14 @@
past entries belonging to author(s): Viktor Szakats.
*/
2010-02-26 00:22 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbxpp/xppop.prg
* contrib/hbxpp/xppopc.c
! Restored stupport for negative indexes in 'string[ n ]' syntax.
* Two reported RTE made XPP compatible regarding 'string[ n ]' syntax.
Left marked as TODO. I hope one day an XPP user will complete them.
! Fixed names of an internal function to not be the same as in xhb lib.
2010-02-25 20:52 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/gtwvg/gtwvg.c
* contrib/gtwvg/gtwvg.h

2
harbour/contrib/hbxpp/xppop.prg
View File

@@ -69,5 +69,5 @@ INIT PROCEDURE xpp_Init()
CREATE CLASS Character FUNCTION xpp_op_Character
OPTIONAL INHERIT HBCharacter
OPERATOR "[]" FUNCTION XHB_INDEX()
OPERATOR "[]" FUNCTION XPP_INDEX()
ENDCLASS

26
harbour/contrib/hbxpp/xppopc.c
View File

@@ -55,7 +55,15 @@
#include "hbapilng.h"
#include "hbstack.h"
HB_FUNC( XHB_INDEX )
/*
* check if array/string index is in valid range, update it if necessary
* in Xbase++ compatibility mode where negative indexes are used to access
* data from tail
*/
#undef HB_IS_VALID_INDEX
#define HB_IS_VALID_INDEX( idx, max ) ( ( ( HB_ISIZ ) (idx) < 0 ? (idx) += (max) + 1 : (idx) ) > 0 && ( HB_SIZE ) (idx) <= (max) )
HB_FUNC( XPP_INDEX )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pIndex = hb_param( 1, HB_IT_ANY );
@@ -72,7 +80,7 @@ HB_FUNC( XHB_INDEX )
if( HB_IS_VALID_INDEX( ulIndex, ulLen ) )
hb_itemMoveRef( hb_arrayGetItemPtr( pSelf, ulIndex ), pValue );
else
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
hb_errRT_BASE( EG_BOUND, 1012, "Error in array index", hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
}
else if( HB_IS_STRING( pSelf ) )
{
@@ -92,13 +100,13 @@ HB_FUNC( XHB_INDEX )
}
}
else
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
hb_errRT_BASE( EG_BOUND, 1012, "Error in array index", hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
}
else
hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex ); /* TODO: Emulate exact XPP error msg */
}
else
hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex );
hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex ); /* TODO: Emulate exact XPP error msg */
hb_itemReturn( pSelf );
}
@@ -113,7 +121,7 @@ HB_FUNC( XHB_INDEX )
if( HB_IS_VALID_INDEX( ulIndex, ulLen ) )
hb_itemReturn( hb_arrayGetItemPtr( pSelf, ulIndex ) );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex );
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex ); /* TODO: Emulate exact XPP error msg */
}
else if( HB_IS_STRING( pSelf ) )
{
@@ -121,14 +129,14 @@ HB_FUNC( XHB_INDEX )
if( HB_IS_VALID_INDEX( ulIndex, ulLen ) )
hb_retclen( hb_itemGetCPtr( pSelf ) + ulIndex - 1, 1 );
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex );
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex ); /* TODO: Emulate exact XPP error msg */
}
else
hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex );
hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex ); /* TODO: Emulate exact XPP error msg */
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex );
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pSelf, pIndex ); /* TODO: Emulate exact XPP error msg */
if( pResult )
hb_itemReturnRelease( pResult );
}