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

2009-10-27 11:51 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/xhb/xhbarr.c
    + added XHB_AINS(), XHB_ADEL() functions which accept negative indexes.
      Warning I haven't replicated xHarbour bugs in AINS() so it's not
      exactly the same. Sooner or later someone will fix AINS() code in
      xHarbour CVS. This code illustrates the problem and also
      incompatibilities with Clipper:
         #ifdef __HARBOUR__
            #ifndef __XHARBOUR__
               #xtranslate adel(<x,...>) => xhb_adel(<x>)
               #xtranslate ains(<x,...>) => xhb_ains(<x>)
            #endif
         #endif
         proc main()
            local a := { 100, 200, 300 }
            ? ; aeval( a, { |x| qout( x ) } )
            adel( a, -1, .t. )
            ? ; aeval( a, { |x| qout( x ) } )
            ains( a, -1, 400, .t. )
            ? ; aeval( a, { |x| qout( x ) } )
            ains( a )
            ? ; aeval( a, { |x| qout( x ) } )
         return
This commit is contained in:
Przemyslaw Czerpak
2009-10-27 10:51:37 +00:00
parent abb4092d09
commit fa7562e992
2 changed files with 81 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
harbour/ChangeLog
View File

@@ -17,6 +17,30 @@
past entries belonging to author(s): Viktor Szakats.
*/
2009-10-27 11:51 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/xhb/xhbarr.c
+ added XHB_AINS(), XHB_ADEL() functions which accept negative indexes.
Warning I haven't replicated xHarbour bugs in AINS() so it's not
exactly the same. Sooner or later someone will fix AINS() code in
xHarbour CVS. This code illustrates the problem and also
incompatibilities with Clipper:
#ifdef __HARBOUR__
#ifndef __XHARBOUR__
#xtranslate adel(<x,...>) => xhb_adel(<x>)
#xtranslate ains(<x,...>) => xhb_ains(<x>)
#endif
#endif
proc main()
local a := { 100, 200, 300 }
? ; aeval( a, { |x| qout( x ) } )
adel( a, -1, .t. )
? ; aeval( a, { |x| qout( x ) } )
ains( a, -1, 400, .t. )
? ; aeval( a, { |x| qout( x ) } )
ains( a )
? ; aeval( a, { |x| qout( x ) } )
return
2009-10-27 10:34 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbapi.h
* harbour/src/vm/garbage.c

57
harbour/contrib/xhb/xhbarr.c
View File

@@ -231,3 +231,60 @@ HB_FUNC( AMERGE )
hb_errRT_BASE( EG_ARG, 1003, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
}
HB_FUNC( XHB_ADEL )
{
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
if( pArray )
{
long lPos = hb_parnl( 2 );
if( lPos == 0 )
lPos = 1;
else if( lPos < 0 )
lPos += hb_arrayLen( pArray ) + 1;
if( hb_arrayDel( pArray, lPos ) )
{
if( hb_parl( 3 ) )
hb_arraySize( pArray, hb_arrayLen( pArray ) - 1 );
}
hb_itemReturn( pArray ); /* ADel() returns the array itself */
}
}
HB_FUNC( XHB_AINS )
{
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
if( pArray )
{
long lPos = hb_parnl( 2 );
if( hb_parl( 4 ) )
{
ULONG ulLen = hb_arrayLen( pArray ) + 1;
if( lPos == 0 )
lPos = 1;
else if( lPos < 0 )
lPos += ulLen + 1;
if( lPos >= 1 && ( ULONG ) lPos <= ulLen )
hb_arraySize( pArray, ulLen );
}
else if( lPos == 0 )
lPos = 1;
else if( lPos < 0 )
lPos += hb_arrayLen( pArray ) + 1;
if( hb_arrayIns( pArray, lPos ) )
{
if( ! HB_ISNIL( 3 ) )
hb_arraySet( pArray, lPos, hb_param( 3, HB_IT_ANY ) );
}
hb_itemReturn( pArray ); /* AIns() returns the array itself */
}
}