diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 0b34f91a08..5d67902be8 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +19991203-02:25 GMT+1 Victor Szel + * 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 * source/rdd/dbeval.prg * Function dbEval() renamed to Bad_dbEval() diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index ce44c3d6af..7a751122cc 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -75,7 +75,7 @@ EXTERNAL PROCLINE EXTERNAL PROCFILE EXTERNAL ERRORLEVEL EXTERNAL PCOUNT -EXTERNAL PVALUE +EXTERNAL HB_PVALUE EXTERNAL __QUIT EXTERNAL BREAK EXTERNAL __XHELP diff --git a/harbour/makefile.vc b/harbour/makefile.vc index 0eb2dbf19a..7b6633ae64 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -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$@ $** diff --git a/harbour/rdd.b32 b/harbour/rdd.b32 index 2fc20c7287..4c2675c677 100644 --- a/harbour/rdd.b32 +++ b/harbour/rdd.b32 @@ -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 $< diff --git a/harbour/source/rdd/Makefile b/harbour/source/rdd/Makefile index 4d00c8a6ca..e4fda7aadb 100644 --- a/harbour/source/rdd/Makefile +++ b/harbour/source/rdd/Makefile @@ -13,7 +13,6 @@ C_SOURCES=\ PRG_SOURCES=\ dbf0.prg \ - dbeval.prg \ dbstrux.prg \ sdf0.prg \ delim0.prg \ diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index f9312956b8..35d25d6600 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -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( , [], [], [], [], [] ) --> NIL + * $ARGUMENTS$ + * Operation that is to be performed + * Code block for the For condition + * Code block for the WHILE condition + * Number of NEXT records to process + * Record number to work on exactly + * 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 ) diff --git a/harbour/source/rdd/dbeval.prg b/harbour/source/rdd/dbeval.prg deleted file mode 100644 index 9cb55b16ce..0000000000 --- a/harbour/source/rdd/dbeval.prg +++ /dev/null @@ -1,174 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * DBEVAL() function - * - * Copyright 1999 Luiz Rafael Culik - * 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( , [], [], [], [], [] ) --> NIL - * $ARGUMENTS$ - * Operation that is to be performed - * Code block for the For condition - * Code block for the WHILE condition - * Number of NEXT records to process - * Record number to work on exactly - * 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 - diff --git a/harbour/source/runner/stdalone/external.prg b/harbour/source/runner/stdalone/external.prg index f49c616c30..aa13549424 100644 --- a/harbour/source/runner/stdalone/external.prg +++ b/harbour/source/runner/stdalone/external.prg @@ -72,7 +72,7 @@ EXTERNAL PROCLINE EXTERNAL PROCFILE EXTERNAL ERRORLEVEL EXTERNAL PCOUNT -EXTERNAL PVALUE +EXTERNAL HB_PVALUE EXTERNAL __QUIT EXTERNAL BREAK EXTERNAL __XHELP