2006-07-12 18:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

* harbour/include/hbextern.ch
    - removed ORDCOND() - it's not normal function

  * harbour/include/ord.ch
    + added documented by CL5.3 NG but not implemented in Clipper
      pseudofunction ORDCOND()

  * harbour/source/rdd/dbcmd.c
    + added __dbOpenSDF() function
      In Clipper dbCreate() can receive also 6-th undocumented
      parameter: cDelim. In [x]Harbour this parameter is used
      for code page ID. I'd like you decide if we should move
      it and keep exact Clipper parameters. I'm also not sure
      if __dbOpenSDF() is the exact Clipper's name. In Clipper
      the name has only 10 characters __dbOpenSD() and this
      function is used to open for import DELIMITED and SDF
      files so maybe SD is not from SDF. Can anyone confirm
      it's valid name. Maybe we should remove the last F.

  * harbour/source/rdd/dbstrux.prg
    * small speed optimization

  * harbour/source/rtl/dbdelim.prg
    * added alternatice Clipper like version of __dbDelim(). It executes
      internally the same functions as Clipper - if someone has a while
      and can check if it works correctly giving the same as Clipper
      results then I'll be helpfull.

  * harbour/source/rtl/dummy.prg
    - removed ORDCOND() and __dbOpenSDF()

  * harbour/source/vm/arrays.c
    * minor optimization

  * harbour/source/vm/cmdarg.c
  * harbour/source/vm/itemapi.c
    * formatting
This commit is contained in:
Przemyslaw Czerpak
2006-07-12 16:47:25 +00:00
parent 577e90d607
commit 482c47321d
10 changed files with 277 additions and 73 deletions

View File

@@ -8,6 +8,45 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
! errorlevel changed to int from byte.
* harbour/source/rtl/errorapi.c
* Minor formatting.
2006-07-12 18:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbextern.ch
- removed ORDCOND() - it's not normal function
* harbour/include/ord.ch
+ added documented by CL5.3 NG but not implemented in Clipper
pseudofunction ORDCOND()
* harbour/source/rdd/dbcmd.c
+ added __dbOpenSDF() function
In Clipper dbCreate() can receive also 6-th undocumented
parameter: cDelim. In [x]Harbour this parameter is used
for code page ID. I'd like you decide if we should move
it and keep exact Clipper parameters. I'm also not sure
if __dbOpenSDF() is the exact Clipper's name. In Clipper
the name has only 10 characters __dbOpenSD() and this
function is used to open for import DELIMITED and SDF
files so maybe SD is not from SDF. Can anyone confirm
it's valid name. Maybe we should remove the last F.
* harbour/source/rdd/dbstrux.prg
* small speed optimization
* harbour/source/rtl/dbdelim.prg
* added alternatice Clipper like version of __dbDelim(). It executes
internally the same functions as Clipper - if someone has a while
and can check if it works correctly giving the same as Clipper
results then I'll be helpfull.
* harbour/source/rtl/dummy.prg
- removed ORDCOND() and __dbOpenSDF()
* harbour/source/vm/arrays.c
* minor optimization
* harbour/source/vm/cmdarg.c
* harbour/source/vm/itemapi.c

View File

@@ -616,7 +616,6 @@ EXTERNAL MSETBOUNDS
EXTERNAL MSETCURSOR
EXTERNAL MSETPOS
EXTERNAL MSHOW
EXTERNAL ORDCOND
EXTERNAL ORDDESCEND
EXTERNAL ORDISUNIQUE
EXTERNAL ORDKEYADD

View File

@@ -58,22 +58,44 @@
/* SCOPE commands: */
#command SET SCOPETOP TO => OrdScope( 0, nil )
#command SET SCOPETOP TO <x> => OrdScope( 0, <x> )
#command SET SCOPETOP TO => OrdScope( TOPSCOPE, nil )
#command SET SCOPETOP TO <x> => OrdScope( TOPSCOPE, <x> )
#command SET SCOPEBOTTOM TO => OrdScope( 1, nil )
#command SET SCOPEBOTTOM TO <x> => OrdScope( 1, <x> )
#command SET SCOPEBOTTOM TO => OrdScope( BOTTOMSCOPE, nil )
#command SET SCOPEBOTTOM TO <x> => OrdScope( BOTTOMSCOPE, <x> )
#command SET SCOPE TO => OrdScope( 0, );
; OrdScope( 1, )
#command SET SCOPE TO => OrdScope( TOPSCOPE, nil );
; OrdScope( BOTTOMSCOPE, nil )
#command SET SCOPE TO <x>, <y> => OrdScope( 0, <x> );
; OrdScope( 1, <y> )
#command SET SCOPE TO <x>, <y> => OrdScope( TOPSCOPE, <x> );
; OrdScope( BOTTOMSCOPE, <y> )
#command SET SCOPE TO <x> => OrdScope( 0, <x> );
; OrdScope( 1, <x> )
#command SET SCOPE TO <x> => OrdScope( TOPSCOPE, <x> );
; OrdScope( BOTTOMSCOPE, <x> )
#command SET SCOPE TO ,<x> => OrdScope( BOTTOMSCOPE, <x> )
/*
* This pseudofunction is only document in CL5.3 NG but not implemented
* in Clipper
*/
#include "hbsetup.ch"
#ifdef HB_COMPAT_C53
#xtranslate ORDCOND( [FOR <for>] ;
[<all:ALL>] [WHILE <while>] ;
[EVAL <eval>] [EVERY <every>] ;
[RECORD <rec>] [NEXT <next>] ;
[<rest:REST>] [<descend: DESCENDING>] ) ;
=> ordCondSet( <"for">, <{for}>, ;
[<.all.>], <{while}>, ;
<{eval}>, <every>, ;
RECNO(), <next>, <rec>, ;
[<.rest.>], [<.descend.>] )
#endif
#command SET SCOPE TO ,<x> => OrdScope( 1, <x> )
#include "dbinfo.ch"

View File

@@ -1600,7 +1600,7 @@ static ERRCODE hb_rddOpenTable( char * szFileName, char * szDriver,
USHORT uiArea, char *szAlias,
BOOL fShared, BOOL fReadonly,
char * szCpId, ULONG ulConnection,
PHB_ITEM pStruct )
PHB_ITEM pStruct, PHB_ITEM pDelim )
{
char szDriverBuffer[ HARBOUR_MAX_RDD_DRIVERNAME_LENGTH + 1 ];
DBOPENINFO pInfo;
@@ -1664,16 +1664,26 @@ static ERRCODE hb_rddOpenTable( char * szFileName, char * szDriver,
if( errCode == SUCCESS )
{
/* Open file */
errCode = SELF_OPEN( pArea, &pInfo );
if( pDelim && !HB_IS_NIL( pDelim ) )
errCode = SELF_INFO( pArea, DBI_SETDELIMITER, pDelim );
if( errCode != SUCCESS )
if( errCode == SUCCESS )
{
hb_rddReleaseCurrentArea();
hb_rddSelectWorkAreaNumber( uiPrevArea );
/* Open file */
errCode = SELF_OPEN( pArea, &pInfo );
if( errCode != SUCCESS )
{
hb_rddReleaseCurrentArea();
hb_rddSelectWorkAreaNumber( uiPrevArea );
}
}
}
/*
* Warning: this is not Clipper compatible. NETERR() should be set by
* error handler not here
*/
s_bNetError = errCode != SUCCESS;
return errCode;
@@ -1682,6 +1692,7 @@ static ERRCODE hb_rddOpenTable( char * szFileName, char * szDriver,
static ERRCODE hb_rddCreateTable( char * szFileName, PHB_ITEM pStruct,
char * szDriver,
BOOL fKeepOpen, USHORT uiArea, char *szAlias,
PHB_ITEM pDelim,
char * szCpId, ULONG ulConnection )
{
char szDriverBuffer[ HARBOUR_MAX_RDD_DRIVERNAME_LENGTH + 1 ];
@@ -1733,9 +1744,17 @@ static ERRCODE hb_rddCreateTable( char * szFileName, PHB_ITEM pStruct,
pInfo.ulConnection = ulConnection;
pInfo.lpdbHeader = NULL;
errCode = SELF_CREATEFIELDS( pArea, pStruct );
if( pDelim && !HB_IS_NIL( pDelim ) )
errCode = SELF_INFO( pArea, DBI_SETDELIMITER, pDelim );
else
errCode = SUCCESS;
if( errCode == SUCCESS )
errCode = SELF_CREATE( pArea, &pInfo );
{
errCode = SELF_CREATEFIELDS( pArea, pStruct );
if( errCode == SUCCESS )
errCode = SELF_CREATE( pArea, &pInfo );
}
if( !fKeepOpen || errCode != SUCCESS )
{
@@ -1743,17 +1762,28 @@ static ERRCODE hb_rddCreateTable( char * szFileName, PHB_ITEM pStruct,
hb_rddSelectWorkAreaNumber( uiPrevArea );
}
/*
* Warning: this is not Clipper compatible. NETERR() should be set by
* error handler not here
*/
s_bNetError = errCode != SUCCESS;
return errCode;
}
/*
* In Clipper the arguments are:
* dbCreate( cFile, aStruct, cRDD, lKeepOpen, cAlias, cDelimArg )
* In Harbour:
* dbCreate( cFile, aStruct, cRDD, lKeepOpen, cAlias, cCodePage, nConnection, cDelimArg )
*/
HB_FUNC( DBCREATE )
{
char * szFileName;
char * szFileName, * szAlias, * szDriver, * szCpId;
USHORT uiSize, uiLen;
PHB_ITEM pStruct, pFieldDesc;
PHB_ITEM pStruct, pFieldDesc, pDelim;
BOOL fKeepOpen, fCurrArea;
ULONG ulConnection;
/*
* NOTE: 4-th and 5-th parameters are undocumented Clipper ones
@@ -1762,9 +1792,14 @@ HB_FUNC( DBCREATE )
*/
szFileName = hb_parc( 1 );
pStruct = hb_param( 2 , HB_IT_ARRAY );
pStruct = hb_param( 2, HB_IT_ARRAY );
szDriver = hb_parc( 3 );
fKeepOpen = ISLOG( 4 );
fCurrArea = fKeepOpen && !hb_parl( 4 );
szAlias = hb_parc( 5 );
szCpId = hb_parc( 6 );
ulConnection = hb_parnl( 7 );
pDelim = hb_param( 8, HB_IT_ANY );
/*
* Clipper allows to use empty struct array for RDDs which does not
@@ -1800,11 +1835,80 @@ HB_FUNC( DBCREATE )
}
}
hb_rddCreateTable( szFileName, pStruct, hb_parc( 3 ), fKeepOpen,
hb_rddCreateTable( szFileName, pStruct, szDriver, fKeepOpen,
fCurrArea ? hb_rddGetCurrentWorkAreaNumber() : 0,
hb_parc( 5 ), hb_parc( 6 ), hb_parnl( 7 ) );
szAlias, pDelim, szCpId, ulConnection );
}
/*
* I'm not sure if lKeepOpen open works exactly like in DBCREATE, I haven't
* tested it with Clipper yet. If it doesn't then please inform me about it
* and I'll update the code. [druzus]
*/
/* __dbopensdf( cFile, aStruct, cRDD, lKeepOpen, cAlias, cDelimArg, cCodePage, nConnection ) */
HB_FUNC( __DBOPENSDF )
{
char * szFileName, * szAlias, * szDriver, * szCpId;
USHORT uiSize, uiLen;
PHB_ITEM pStruct, pFieldDesc, pDelim;
BOOL fKeepOpen, fCurrArea;
ULONG ulConnection;
ERRCODE errCode;
/*
* NOTE: 4-th and 5-th parameters are undocumented Clipper ones
* 4-th is boolean flag indicating if file should stay open and
* 5-th is alias - if not given then WA is open without alias
*/
szFileName = hb_parc( 1 );
pStruct = hb_param( 2, HB_IT_ARRAY );
szDriver = hb_parc( 3 );
fKeepOpen = ISLOG( 4 );
fCurrArea = fKeepOpen && !hb_parl( 4 );
szAlias = hb_parc( 5 );
pDelim = hb_param( 6, HB_IT_ANY );
szCpId = hb_parc( 7 );
ulConnection = hb_parnl( 8 );
if( !pStruct ||
hb_arrayLen( pStruct ) == 0 ||
!szFileName || !szFileName[ 0 ] )
{
hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, "__DBOPENSDF" );
return;
}
uiLen = ( USHORT ) hb_arrayLen( pStruct );
for( uiSize = 1; uiSize <= uiLen; ++uiSize )
{
pFieldDesc = hb_arrayGetItemPtr( pStruct, uiSize );
/* Validate items types of fields */
if( hb_arrayLen( pFieldDesc ) < 4 ||
!( hb_arrayGetType( pFieldDesc, 1 ) & HB_IT_STRING ) ||
!( hb_arrayGetType( pFieldDesc, 2 ) & HB_IT_STRING ) ||
!( hb_arrayGetType( pFieldDesc, 3 ) & HB_IT_NUMERIC ) ||
!( hb_arrayGetType( pFieldDesc, 4 ) & HB_IT_NUMERIC ) )
{
hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, "__DBOPENSDF" );
return;
}
}
errCode = hb_rddOpenTable( szFileName, szDriver,
fCurrArea ? hb_rddGetCurrentWorkAreaNumber() : 0,
szAlias, TRUE, TRUE,
szCpId, ulConnection,
pStruct, pDelim );
if( !fKeepOpen && errCode == SUCCESS )
hb_rddReleaseCurrentArea();
hb_retl( errCode == SUCCESS );
}
HB_FUNC( DBDELETE )
{
HB_THREAD_STUB
@@ -2270,7 +2374,7 @@ HB_FUNC( DBUSEAREA )
hb_parl( 1 ) ? 0 : hb_rddGetCurrentWorkAreaNumber(),
hb_parc( 4 ),
ISLOG( 5 ) ? hb_parl( 5 ) : !hb_set.HB_SET_EXCLUSIVE,
hb_parl( 6 ), hb_parc( 7 ), hb_parnl( 8 ), NULL );
hb_parl( 6 ), hb_parc( 7 ), hb_parnl( 8 ), NULL, NULL );
}
HB_FUNC( __DBZAP )
@@ -4359,15 +4463,12 @@ static ERRCODE hb_rddTransRecords( AREAP pArea,
if( errCode == SUCCESS )
{
errCode = hb_rddCreateTable( szFileName, pStruct, szDriver,
TRUE, 0, "", szCpId, ulConnection );
TRUE, 0, "", pDelim, szCpId,
ulConnection );
if( errCode == SUCCESS )
{
dbTransInfo.lpaDest = lpaClose =
( AREAP ) hb_rddGetCurrentWorkAreaPointer();
if( pDelim )
{
SELF_INFO( dbTransInfo.lpaDest, DBI_SETDELIMITER, pDelim );
}
}
}
}
@@ -4399,22 +4500,18 @@ static ERRCODE hb_rddTransRecords( AREAP pArea,
if( errCode == SUCCESS )
{
errCode = hb_rddOpenTable( szFileName, szDriver, 0, "", TRUE, TRUE,
szCpId, ulConnection, pStruct );
szCpId, ulConnection, pStruct, pDelim );
if( errCode == SUCCESS )
{
lpaClose = dbTransInfo.lpaSource =
( AREAP ) hb_rddGetCurrentWorkAreaPointer();
if( pDelim )
{
SELF_INFO( dbTransInfo.lpaSource, DBI_SETDELIMITER, pDelim );
}
}
}
}
else
{
errCode = hb_rddOpenTable( szFileName, szDriver, 0, "", TRUE, TRUE,
szCpId, ulConnection, NULL );
szCpId, ulConnection, NULL, pDelim );
if( errCode == SUCCESS )
{
lpaClose = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();

View File

@@ -175,10 +175,11 @@ FUNCTION __dbStructFilter( aStruct, aFieldList )
/* Build a filtered list of the requested fields. */
aStructFiltered := {}
bFindName := {| aField | aField[ DBS_NAME ] == RTrim( Upper(cName ) ) }
bFindName := {| aField | aField[ DBS_NAME ] == cName }
AEval( aFieldList, {| cFieldName, nIndex | cName := cFieldName, nIndex := aScan( aStruct, bFindName ),;
iif( nIndex == 0, NIL, AAdd( aStructFiltered, aStruct[ nIndex] ) ) } )
AEval( aFieldList, {| cFieldName, nIndex | ;
cName := RTrim( Upper( cFieldName ) ), ;
nIndex := aScan( aStruct, bFindName ),;
iif( nIndex == 0, NIL, AAdd( aStructFiltered, aStruct[ nIndex] ) ) } )
RETURN aStructFiltered

View File

@@ -69,6 +69,55 @@ PROCEDURE __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nR
RETURN
#ifdef __DBDELIM_STRICT_CLIPPER_CODE__
function __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRecord, lRest )
local nSrcArea, nDstArea, aStruct, cRDD := "DELIM"
if lExport
nSrcArea := Select()
else
nDstArea := Select()
endif
if Empty( aStruct := __fledit( dbstruct(), aFields ) )
return .F.
endif
if lExport
dbcreate( cFile, aStruct, cRDD, .T., "", , , cDelimArg )
nDstArea := Select()
if nDstArea == nSrcArea
nDstArea := Nil
endif
select( nSrcArea )
else
if !__dbopensdf( cFile, aStruct, cRDD, .T., "", cDelimArg )
return .F.
endif
nSrcArea := Select()
endif
if nDstArea != nil
__dbtrans( nDstArea, aStruct, bFor, bWhile, nNext, nRecord, lRest )
endif
if lExport
if nDstArea != Nil
select( nDstArea )
close
endif
select( nSrcArea )
else
select( nSrcArea )
close
select( nDstArea )
endif
return .T.
#endif /* __DBDELIM_STRICT_CLIPPER_CODE__ */
#ifdef __DBDELIM_OLD_CODE__
#include "hbcommon.ch"

View File

@@ -54,13 +54,8 @@
/* TODO: Dummy functions, should be removed when implemented. */
#ifdef HB_COMPAT_C53
FUNCTION ordCond() ; RETURN NIL
#endif
FUNCTION __dbJoin() ; RETURN NIL
/* NOTE: Internal functions */
FUNCTION __dbFList() ; RETURN {}
FUNCTION __dbOpenSDF() ; RETURN NIL
FUNCTION __dbTransRec() ; RETURN NIL

View File

@@ -555,23 +555,25 @@ BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * p
ULONG ulStart;
ULONG ulCount;
if( pulStart && ( *pulStart >= 1 ) )
ulStart = *pulStart;
if( pulStart && *pulStart )
ulStart = *pulStart - 1;
else
ulStart = 1;
ulStart = 0;
if( ulStart <= ulLen )
if( ulStart < ulLen )
{
if( pulCount && ( *pulCount <= ulLen - ulStart ) )
ulCount = ulLen - ulStart;
if( pulCount && *pulCount < ulCount )
ulCount = *pulCount;
else
ulCount = ulLen - ulStart + 1;
if( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
for( ; ulCount > 0; ulCount--, ulStart++ ) /* set value items */
hb_itemCopy( pBaseArray->pItems + ( ulStart - 1 ), pValue );
if( ulCount > 0 )
{
do
{
hb_itemCopy( pBaseArray->pItems + ulStart++, pValue );
}
while( --ulCount > 0 );
}
}
return TRUE;

View File

@@ -322,8 +322,8 @@ HB_FUNC( HB_ARGV )
/* Check for command line internal arguments */
ULONG hb_cmdargProcessVM( int *pCancelKey, int *pCancelKeyEx )
{
char * cFlags;
ULONG ulFlags = HB_VMFLAG_HARBOUR;
char * cFlags;
ULONG ulFlags = HB_VMFLAG_HARBOUR;
if( hb_cmdargCheck( "INFO" ) )
{

View File

@@ -213,23 +213,23 @@ HB_EXPORT PHB_ITEM hb_itemPutC( PHB_ITEM pItem, const char * szText )
if( ulLen == 0 )
{
pItem->item.asString.value = hb_vm_sNull;
pItem->item.asString.length = 0;
pItem->item.asString.allocated = 0;
pItem->item.asString.value = hb_vm_sNull;
}
else if( ulLen == 1 )
{
pItem->item.asString.value = hb_vm_acAscii[ (unsigned char) ( szText[0] ) ];
pItem->item.asString.length = 1;
pItem->item.asString.allocated = 0;
pItem->item.asString.value = hb_vm_acAscii[ (unsigned char) ( szText[0] ) ];
}
else
{
pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
/* we used strlen() above so we know it's 0-ended string */
hb_xmemcpy( pItem->item.asString.value, szText, ulLen + 1 );
pItem->item.asString.length = ulLen;
pItem->item.asString.allocated = ulLen + 1;
pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
/* we used strlen() above so we no it's 0-ended string */
hb_xmemcpy( pItem->item.asString.value, szText, ulLen + 1 );
}
pItem->type = HB_IT_STRING;
@@ -254,13 +254,13 @@ HB_EXPORT PHB_ITEM hb_itemPutCConst( PHB_ITEM pItem, const char * szText )
if( szText == NULL )
{
pItem->item.asString.length = 0;
pItem->item.asString.value = "";
pItem->item.asString.length = 0;
}
else
{
pItem->item.asString.length = strlen( szText );
pItem->item.asString.value = ( char * ) szText;
pItem->item.asString.length = strlen( szText );
}
return pItem;
@@ -284,23 +284,23 @@ HB_EXPORT PHB_ITEM hb_itemPutCL( PHB_ITEM pItem, const char * szText, ULONG ulLe
if( szText == NULL || ulLen == 0 )
{
pItem->item.asString.value = hb_vm_sNull;
pItem->item.asString.length = 0;
pItem->item.asString.allocated = 0;
pItem->item.asString.value = hb_vm_sNull;
}
else if( ulLen == 1 )
{
pItem->item.asString.value = hb_vm_acAscii[ (unsigned char) ( szText[0] ) ];
pItem->item.asString.length = 1;
pItem->item.asString.allocated = 0;
pItem->item.asString.value = hb_vm_acAscii[ (unsigned char) ( szText[0] ) ];
}
else
{
pItem->item.asString.length = ulLen;
pItem->item.asString.allocated = ulLen + 1;
pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
hb_xmemcpy( pItem->item.asString.value, szText, ulLen );
pItem->item.asString.value[ ulLen ] = '\0';
pItem->item.asString.length = ulLen;
pItem->item.asString.allocated = ulLen + 1;
}
pItem->type = HB_IT_STRING;
@@ -884,7 +884,7 @@ HB_EXPORT PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, int iWidth,
{
#if (__BORLANDC__ > 1040) /* Use this only above Borland C++ 3.1 */
/* Borland C compiled app crashes if a "NaN" double is compared with another double [martin vogel] */
if (_isnan (dNumber))
if( _isnan( dNumber ) )
{
iWidth = 20;
}
@@ -1443,7 +1443,7 @@ PHB_ITEM hb_itemUnRefOnce( PHB_ITEM pItem )
pItem->item.asEnum.valuePtr = hb_itemNew( NULL );
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
2, pItem->item.asEnum.basePtr, hb_stackItemFromTop( -1 ) );
2, pItem->item.asEnum.basePtr, hb_stackItemFromTop( -1 ) );
/* break() was executed by error block */
}
return pItem->item.asEnum.valuePtr;