From 043a74384e51f8f29e855f81d149030073310e2d Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 25 Feb 2010 23:24:10 +0000 Subject: [PATCH] 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. --- harbour/ChangeLog | 8 ++++++++ harbour/contrib/hbxpp/xppop.prg | 2 +- harbour/contrib/hbxpp/xppopc.c | 26 +++++++++++++++++--------- 3 files changed, 26 insertions(+), 10 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 72c74a7fec..27249b22cf 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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 diff --git a/harbour/contrib/hbxpp/xppop.prg b/harbour/contrib/hbxpp/xppop.prg index ab729700e4..241756884c 100644 --- a/harbour/contrib/hbxpp/xppop.prg +++ b/harbour/contrib/hbxpp/xppop.prg @@ -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 diff --git a/harbour/contrib/hbxpp/xppopc.c b/harbour/contrib/hbxpp/xppopc.c index 5e6180d006..d85c37d2ce 100644 --- a/harbour/contrib/hbxpp/xppopc.c +++ b/harbour/contrib/hbxpp/xppopc.c @@ -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 ); }