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

19991203-02:25 GMT+1 Victor Szel <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
1999-12-03 01:39:47 +00:00
parent cbd4d2ce9f
commit a9d06a6717
8 changed files with 70 additions and 198 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -1,3 +1,17 @@
19991203-02:25 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rdd/dbcmd.c
+ DBEVAL() doc added from dbeval.prg
! Error codes fixed in DBEVAL()
% Some optimization made in DBEVAL()
* source/rdd/Makefile
- source/rdd/dbeval.prg
rdd.b32
makefile.vc
- old bad_DBEVAL() removed
* include/hbextern.ch
source/runner/stdalone/external.prg
! PVALUE -> HB_PVALUE
19991202-18:00 GMT+1 Bruno Cantero <bruno@issnet.net>
* source/rdd/dbeval.prg
* Function dbEval() renamed to Bad_dbEval()

2
harbour/include/hbextern.ch
View File

@@ -75,7 +75,7 @@ EXTERNAL PROCLINE
EXTERNAL PROCFILE
EXTERNAL ERRORLEVEL
EXTERNAL PCOUNT
EXTERNAL PVALUE
EXTERNAL HB_PVALUE
EXTERNAL __QUIT
EXTERNAL BREAK
EXTERNAL __XHELP

7
harbour/makefile.vc
View File

@@ -211,7 +211,6 @@ RDD_OBJS = \
$(OBJ_DIR)\dbcmd.obj \
$(OBJ_DIR)\dbf0.obj \
$(OBJ_DIR)\dbf1.obj \
$(OBJ_DIR)\dbeval.obj \
$(OBJ_DIR)\dbnubs.obj \
$(OBJ_DIR)\dbstrux.obj \
$(OBJ_DIR)\sdf0.obj \
@@ -936,12 +935,6 @@ $(OBJ_DIR)\dbf0.obj : $(RDD_DIR)\dbf0.c
$(OBJ_DIR)\dbf1.obj : $(RDD_DIR)\dbf1.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(RDD_DIR)\dbeval.c : $(RDD_DIR)\dbeval.prg
$(HARBOUR_EXE) $** $(HARBOURFLAGS) -o$@
$(OBJ_DIR)\dbeval.obj : $(RDD_DIR)\dbeval.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\dbnubs.obj : $(RDD_DIR)\dbnubs.c
$(CC) $(CLIBFLAGS) -Fo$@ $**

4
harbour/rdd.b32
View File

@@ -14,7 +14,7 @@
lib\b32\rdd.lib : rddsys.obj dbcmd.obj dbfntx1.obj dbfntx0.obj \
dbf0.obj dbf1.obj delim0.obj delim1.obj \
sdf0.obj sdf1.obj dbfcdx1.obj dbfcdx0.obj \
dbnubs.obj rddord.obj dbeval.obj
dbnubs.obj rddord.obj
dbf0.c : dbf0.prg
dbfntx0.c : dbfntx0.prg
@@ -23,7 +23,6 @@ sdf0.c : sdf0.prg
delim0.c : delim0.prg
dbfcdx0.c : dbfcdx0.prg
rddord.c : rddord.prg
dbeval.c : dbeval.prg
dbcmd.obj : dbcmd.c
rddsys.obj : rddsys.c
@@ -38,7 +37,6 @@ delim1.obj : delim1.c
dbfcdx0.obj : dbfcdx0.c
dbfcdx1.obj : dbfcdx1.c
dbnubs.obj : dbnubs.c
dbeval.obj : dbeval.c
.c.obj :
bcc32 -c -O2 -Iinclude -o$@ -v $<

1
harbour/source/rdd/Makefile
View File

@@ -13,7 +13,6 @@ C_SOURCES=\
PRG_SOURCES=\
dbf0.prg \
dbeval.prg \
dbstrux.prg \
sdf0.prg \
delim0.prg \

64
harbour/source/rdd/dbcmd.c
View File

@@ -1396,18 +1396,58 @@ HARBOUR HB_ALIAS( void )
hb_retc( "" );
}
/* $DOC$
* $FUNCNAME$
* DBEVAL()
* $CATEGORY$
* $ONELINER$
* Performs a code block operation on the current data base
* $SYNTAX$
* DBEVAL( <bBlock>, [<bFor>], [<bWhile>], [<nNext>], [<nRecord>], [<lRest>] ) --> NIL
* $ARGUMENTS$
* <bBlock> Operation that is to be performed
* <bFor> Code block for the For condition
* <bWhile> Code block for the WHILE condition
* <nNext> Number of NEXT records to process
* <nRecord> Record number to work on exactly
* <lRest> Toggle to rewind record pointer
* $RETURNS$
* NIL
* $DESCRIPTION$
* Performs a code block operation on the current data base
* $EXAMPLES$
* FUNCTION Main()
* LOCAL nCount
*
* USE Test
*
* dbGoto( 4 )
* ? RecNo()
* COUNT TO nCount
* ? RecNo(), nCount
* COUNT TO nCount NEXT 10
* ? RecNo(), nCount
*
* RETURN NIL
* $TESTS$
* $STATUS$
* S
* $COMPLIANCE$
* DBEVAL is fully CA-Clipper compliant.
* $SEEALSO$
* $END$
*/
HARBOUR HB_DBEVAL( void )
{
DBEVALINFO pEvalInfo;
if( !pCurrArea )
hb_errRT_DBCMD( EG_NOTABLE, 2001, NULL, "DBEVAL" );
else
if( pCurrArea )
{
DBEVALINFO pEvalInfo;
pEvalInfo.itmBlock = hb_param( 1, IT_BLOCK );
if( !pEvalInfo.itmBlock )
{
hb_errRT_DBCMD( EG_ARG, 12019, NULL, "DBEVAL" );
hb_errRT_DBCMD( EG_ARG, 2019, NULL, "DBEVAL" );
return;
}
@@ -1416,7 +1456,7 @@ HARBOUR HB_DBEVAL( void )
{
if( !ISNIL( 2 ) )
{
hb_errRT_DBCMD( EG_ARG, 22019, NULL, "DBEVAL" );
hb_errRT_DBCMD( EG_ARG, 2019, NULL, "DBEVAL" );
return;
}
}
@@ -1426,7 +1466,7 @@ HARBOUR HB_DBEVAL( void )
{
if( !ISNIL( 3 ) )
{
hb_errRT_DBCMD( EG_ARG, 32019, NULL, "DBEVAL" );
hb_errRT_DBCMD( EG_ARG, 2019, NULL, "DBEVAL" );
return;
}
}
@@ -1436,7 +1476,7 @@ HARBOUR HB_DBEVAL( void )
{
if( !ISNIL( 4 ) )
{
hb_errRT_DBCMD( EG_ARG, 42019, NULL, "DBEVAL" );
hb_errRT_DBCMD( EG_ARG, 2019, NULL, "DBEVAL" );
return;
}
}
@@ -1446,7 +1486,7 @@ HARBOUR HB_DBEVAL( void )
{
if( !ISNIL( 5 ) )
{
hb_errRT_DBCMD( EG_ARG, 52019, NULL, "DBEVAL" );
hb_errRT_DBCMD( EG_ARG, 2019, NULL, "DBEVAL" );
return;
}
}
@@ -1456,13 +1496,15 @@ HARBOUR HB_DBEVAL( void )
{
if( !ISNIL( 6 ) )
{
hb_errRT_DBCMD( EG_ARG, 62019, NULL, "DBEVAL" );
hb_errRT_DBCMD( EG_ARG, 2019, NULL, "DBEVAL" );
return;
}
}
SELF_DBEVAL( ( AREAP ) pCurrArea->pArea, &pEvalInfo );
}
else
hb_errRT_DBCMD( EG_NOTABLE, 2001, NULL, "DBEVAL" );
}
HARBOUR HB_DBF( void )

174
harbour/source/rdd/dbeval.prg
View File

@@ -1,174 +0,0 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* DBEVAL() function
*
* Copyright 1999 Luiz Rafael Culik <Culik@sl.conex.net>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "common.ch"
#include "error.ch"
/* TODO: Optimize for speed (C rewrite?) */
/* $DOC$
* $FUNCNAME$
* DBEVAL()
* $CATEGORY$
* $ONELINER$
* Performs a code block operation on the current data base
* $SYNTAX$
* DBEVAL( <bBlock>, [<bFor>], [<bWhile>], [<nNext>], [<nRecord>], [<lRest>] ) --> NIL
* $ARGUMENTS$
* <bBlock> Operation that is to be performed
* <bFor> Code block for the For condition
* <bWhile> Code block for the WHILE condition
* <nNext> Number of NEXT records to process
* <nRecord> Record number to work on exactly
* <lRest> Toggle to rewind record pointer
* $RETURNS$
* NIL
* $DESCRIPTION$
* Performs a code block operation on the current data base
* $EXAMPLES$
* FUNCTION Main()
* LOCAL nCount
*
* USE Test
*
* dbGoto( 4 )
* ? RecNo()
* COUNT TO nCount
* ? RecNo(), nCount
* COUNT TO nCount NEXT 10
* ? RecNo(), nCount
*
* RETURN NIL
* $TESTS$
* $STATUS$
* S
* $COMPLIANCE$
* DBEVAL is fully CA-Clipper compliant.
* $SEEALSO$
* $END$
*/
FUNCTION Bad_dbEval( bBlock, bFor, bWhile, nNext, nRecord, lRest )
LOCAL oError
LOCAL nCounter
IF !Used()
oError := ErrorNew()
oError:severity := ES_ERROR
oError:SubSystem := "DBCMD"
oError:genCode := EG_ARG
oError:subCode := 2019
oError:operation := "DBEVAL"
oError:canDefault := .T.
Eval( ErrorBlock(), oError )
ENDIF
IF Used()
IF !ISBLOCK( bBlock )
oError := ErrorNew()
oError:severity := ES_ERROR
oError:SubSystem := "DBCMD"
oError:genCode := EG_ARG
oError:subCode := 2019
oError:operation := "DBEVAL"
Eval( ErrorBlock(), oError )
RETURN NIL
ENDIF
IF ISNUMBER( nRecord )
IF nRecord >= 1 .AND. nRecord <= LastRec()
dbGoto( nRecord )
IF bFor == NIL .OR. Eval( bFor )
Eval( bBlock )
ENDIF
ENDIF
ELSE
nCounter := 0
IF lRest == NIL .OR. !lRest
dbGoTop()
ENDIF
DO CASE
CASE bFor != NIL .AND. bWhile == NIL
WHILE !Eof()
IF nNext == NIL .OR. ++nCounter <= nNext
IF Eval( bFor )
Eval( bBlock )
ENDIF
ENDIF
dbSkip()
ENDDO
CASE bFor == NIL .AND. bWhile != NIL
WHILE !Eof() .AND. Eval( bWhile )
IF nNext == NIL .OR. ++nCounter <= nNext
Eval( bBlock )
ENDIF
dbSkip()
ENDDO
CASE bFor != NIL .AND. bWhile != NIL
WHILE !Eof() .AND. Eval( bWhile )
IF nNext == NIL .OR. ++nCounter <= nNext
IF Eval( bFor )
Eval( bBlock )
ENDIF
ENDIF
dbSkip()
ENDDO
OTHERWISE
WHILE !Eof()
IF nNext == NIL .OR. ++nCounter <= nNext
Eval( bBlock )
ENDIF
dbSkip()
ENDDO
ENDCASE
ENDIF
ENDIF
RETURN NIL

2
harbour/source/runner/stdalone/external.prg
View File

@@ -72,7 +72,7 @@ EXTERNAL PROCLINE
EXTERNAL PROCFILE
EXTERNAL ERRORLEVEL
EXTERNAL PCOUNT
EXTERNAL PVALUE
EXTERNAL HB_PVALUE
EXTERNAL __QUIT
EXTERNAL BREAK
EXTERNAL __XHELP