From 6dde6b10fee1cab6beb4a2f00dd1374a6038e4e1 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 4 Oct 2012 15:18:50 +0000 Subject: [PATCH] 2012-10-04 17:11 UTC+0200 Viktor Szakats (harbour syenar.net) * tests/aliaslck.prg * tests/files.prg * tests/inherit.prg * tests/newrdd.prg * tests/omacro.prg * tests/testcdx.prg * tests/testdbf.prg * tests/testrdd.prg * tests/testrdd2.prg * tests/tstuse.prg * tests/wcecon.prg ! fixed to deleted test dbfs/indexes/dirs created along the way ! misc other corrections --- harbour/ChangeLog | 15 +++++++ harbour/tests/aliaslck.prg | 6 ++- harbour/tests/files.prg | 2 +- harbour/tests/inherit.prg | 2 +- harbour/tests/newrdd.prg | 4 ++ harbour/tests/omacro.prg | 8 ++-- harbour/tests/testcdx.prg | 3 ++ harbour/tests/testdbf.prg | 3 ++ harbour/tests/testrdd.prg | 1 + harbour/tests/testrdd2.prg | 88 +++++++++++++++++++------------------- harbour/tests/tstuse.prg | 9 +++- harbour/tests/wcecon.prg | 7 ++- 12 files changed, 94 insertions(+), 54 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 41ae5a946e..3a3606f036 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,21 @@ The license applies to all entries newer than 2009-04-28. */ +2012-10-04 17:11 UTC+0200 Viktor Szakats (harbour syenar.net) + * tests/aliaslck.prg + * tests/files.prg + * tests/inherit.prg + * tests/newrdd.prg + * tests/omacro.prg + * tests/testcdx.prg + * tests/testdbf.prg + * tests/testrdd.prg + * tests/testrdd2.prg + * tests/tstuse.prg + * tests/wcecon.prg + ! fixed to deleted test dbfs/indexes/dirs created along the way + ! misc other corrections + 2012-10-04 13:25 UTC+0200 Viktor Szakats (harbour syenar.net) * extras/httpsrv/uhttpd.prg * tests/db_brows.prg diff --git a/harbour/tests/aliaslck.prg b/harbour/tests/aliaslck.prg index d423edc752..c100d78432 100644 --- a/harbour/tests/aliaslck.prg +++ b/harbour/tests/aliaslck.prg @@ -16,7 +16,7 @@ proc main() local cFile := "_tst" if !dbExists( cFile ) - dbCreate( cFile, {{"F","C",10,0}} ) + dbCreate( cFile, { { "F", "C", 10, 0 } } ) use _tst exclusive while lastRec() < 100 dbAppend() @@ -98,6 +98,8 @@ proc main() setLock(9) dspLock() wait + dbCloseAll() + hb_dbDrop( cFile ) return proc setLock( n ) @@ -106,7 +108,7 @@ return proc dspLock() local n - ? alias(), "active locks:" + ? alias(), "active locks:" for each n in dbRLockList() ?? "", ltrim( str( n ) ) next diff --git a/harbour/tests/files.prg b/harbour/tests/files.prg index 535cd9330c..a352de9c43 100644 --- a/harbour/tests/files.prg +++ b/harbour/tests/files.prg @@ -72,7 +72,7 @@ PROCEDURE Main() DO WHILE n < NFILES n++ @ 14, 0 SAY "Deleting files.... " + Str( n ) - FErase( "file" + LTrim( Str( n ) ) + ".dbf" ) + hb_dbDrop( "file" + LTrim( Str( n ) ) + ".dbf" ) ENDDO RETURN diff --git a/harbour/tests/inherit.prg b/harbour/tests/inherit.prg index 7d42874932..418a3a7145 100644 --- a/harbour/tests/inherit.prg +++ b/harbour/tests/inherit.prg @@ -68,7 +68,7 @@ FUNCTION TEmpty() IF oEmpty == NIL oEmpty := HBClass():New( "TEmpty" ) // Create a new class def - oEmpty:AddInline( "New", {| self |self } ) + oEmpty:AddInline( "New", {| self | self } ) oEmpty:AddInline( "Run", {|| QOut( "Run !" ) } ) // Test command oEmpty:AddInline( "Set", {| self, xParam | ::Out := xParam } ) diff --git a/harbour/tests/newrdd.prg b/harbour/tests/newrdd.prg index 29c6cb47da..e259d24871 100644 --- a/harbour/tests/newrdd.prg +++ b/harbour/tests/newrdd.prg @@ -373,4 +373,8 @@ PROCEDURE Main() NEWRDD->( dbSkip() ) NEXT + dbCloseAll() + + hb_dbDrop( "newrdd",, "DBFCDX" ) + RETURN diff --git a/harbour/tests/omacro.prg b/harbour/tests/omacro.prg index 4679856c18..bac38f2fb2 100644 --- a/harbour/tests/omacro.prg +++ b/harbour/tests/omacro.prg @@ -19,7 +19,7 @@ PROCEDURE Main() obj:&send1 := "test" obj:tries += 1 - obj:tries ++ + obj:tries++ ++obj:tries WITH OBJECT obj @@ -35,17 +35,17 @@ PROCEDURE Main() To access the object variable using macro the '_' should be omitted */ :&send2 += 1 - :&send2 ++ + :&send2++ ++:&send2 ++:&( send2 ) - :&( send2 ) := :&( SubStr( send2,2 ) ) + 1 + :&( send2 ) := :&( SubStr( send2, 2 ) ) + 1 :&send1 += " description" :&( send1 ) += " of " ENDWITH - obj:&( "_" + SubStr( send1,2 ) ) += "Error object" + obj:&( "_" + SubStr( send1, 2 ) ) += "Error object" ? send1, "=", obj:&( SubStr( send1, 2 ) ) ? send2, "=", obj:tries diff --git a/harbour/tests/testcdx.prg b/harbour/tests/testcdx.prg index bc7566738d..bb9252f376 100644 --- a/harbour/tests/testcdx.prg +++ b/harbour/tests/testcdx.prg @@ -48,4 +48,7 @@ PROCEDURE Main() Select( "TESTCDX" ) ordCreate( "testcdx", "Character", "CHARACTER", FIELD->CHARACTER, .F. ) + dbCloseAll() + hb_dbDrop( "testcdx",, "DBFCDX" ) + RETURN diff --git a/harbour/tests/testdbf.prg b/harbour/tests/testdbf.prg index 0be38274a1..289afe07cf 100644 --- a/harbour/tests/testdbf.prg +++ b/harbour/tests/testdbf.prg @@ -183,4 +183,7 @@ PROCEDURE Main() CONTINUE ENDDO + dbCloseAll() + hb_dbDrop( "testdbf",, "DBFCDX" ) + RETURN diff --git a/harbour/tests/testrdd.prg b/harbour/tests/testrdd.prg index fb0d7bb032..b060b28ff5 100644 --- a/harbour/tests/testrdd.prg +++ b/harbour/tests/testrdd.prg @@ -38,5 +38,6 @@ PROCEDURE Main() dbSkip() dbCloseArea() dbCloseAll() + hb_dbDrop( "testdbf",, "DBFCDX" ) RETURN diff --git a/harbour/tests/testrdd2.prg b/harbour/tests/testrdd2.prg index 37ffd6cf48..ddadde3cb7 100644 --- a/harbour/tests/testrdd2.prg +++ b/harbour/tests/testrdd2.prg @@ -2,6 +2,7 @@ * $Id$ */ +#include "directry.ch" #include "ord.ch" #define MAX_TEST_RECS 100 @@ -10,13 +11,18 @@ #define INDEX_KEY_DATE DATE #define INDEX_KEY_LOG LOG +#ifdef WITH_ADS +#include "ads.ch" + EXTERNAL _ADS +#endif + EXTERNAL DBFNTX EXTERNAL DBFCDX PROCEDURE Main( cRDDType, cAdsMode ) - LOCAL cRDD, aStruct, xTemp, bMemoText + LOCAL cRDD := "", aStruct, xTemp, bMemoText FIELD CHAR, NUM, DATE, LOG @@ -37,25 +43,17 @@ PROCEDURE Main( cRDDType, cAdsMode ) CASE Empty( cRDDType ) - NotifyUser( "Usage: TESTRDD RDDTYPE [ADSMODE]" + hb_eol() + ; + NotifyUser( "Usage: TESTRDD2 RDDTYPE [ADSMODE]" + hb_eol() + ; hb_eol() + ; "RDDTYPE = DBFNTX, DBFCDX, ADSCDX, ADSNTX or ADSADT" + hb_eol() + ; hb_eol() + ; "ADSMODE = LOCAL or SERVER (only applies to ADSCDX, ADSNTX and ADSADT)" + hb_eol() + ; "(If specify SERVER, must be run from a drive suported by ADS server)", .T. ) +#ifdef WITH_ADS + CASE Left( cRDDType := Upper( AllTrim( cRDDType ) ), 3 ) == "ADS" - // Do not include ads.ch as don't want unintended affects when not using - // ADS - If need behavior from ads.ch, include defines and undefs in - // these areas. - -#define ADS_LOCAL_SERVER 1 -#define ADS_REMOTE_SERVER 2 -#define ADS_NTX 1 -#define ADS_CDX 2 -#define ADS_ADT 3 - rddRegister( "ADS", 1 ) rddSetDefault( "ADS" ) @@ -84,11 +82,7 @@ PROCEDURE Main( cRDDType, cAdsMode ) AdsSetDefault( "" ) AdsSetSearchPath( "" ) -#undef ADS_LOCAL_SERVER -#undef ADS_REMOTE_SERVER -#undef ADS_NTX -#undef ADS_CDX -#undef ADS_ADT +#endif CASE cRDDType == "DBFCDX" .OR. ; cRDDType == "DBFNTX" @@ -101,43 +95,41 @@ PROCEDURE Main( cRDDType, cAdsMode ) ENDCASE - // Delete test.* since may be changing RDD flavors (avoid conflicts) - AEval( Directory( "test.*" ), {| a | FErase( a[ 1 ] ) } ) - AEval( Directory( "test?.*" ), {| a | FErase( a[ 1 ] ) } ) + // Delete test_?.* since may be changing RDD flavors (avoid conflicts) + AEval( Directory( "test_?.*" ), {| a | FErase( a[ F_NAME ] ) } ) - IF File( "test.dbf" ) - NotifyUser( "Cannot delete test.dbf" ) + IF File( "test_2.dbf" ) + NotifyUser( "Cannot delete test_2.dbf" ) ENDIF - // TEST: DBCreate() + // TEST: dbCreate() - dbCreate( "test.dbf", ; - aStruct := { ; + dbCreate( "test_2.dbf", aStruct := { ; { "CHAR", "C", 30, 0 }, ; { "NUM", "N", 15, 3 }, ; { "DATE", "D", 8, 0 }, ; { "LOG", "L", 1, 0 }, ; { "MEMO", "M", 10, 0 } } ) - IF ! File( "test.dbf" ) - NotifyUser( "Failed to create test.dbf" ) + IF ! File( "test_2.dbf" ) + NotifyUser( "Failed to create test_2.dbf" ) ENDIF - // TEST: DBUseArea()/USE + // TEST: dbUseArea()/USE - USE test.dbf NEW shared ALIAS MYTEST + USE test_2.dbf NEW SHARED ALIAS mytest IF ! Alias() == "MYTEST" - NotifyUser( "Failed to open test.dbf" ) + NotifyUser( "Failed to open test_2.dbf" ) ENDIF - // TEST: RDDName() + // TEST: rddName() IF ! rddName() == cRDD NotifyUser( "Failed to set RDD to " + cRDD ) ENDIF - // TEST: DBStruct() + // TEST: dbStruct() IF ! CompareArray( aStruct, dbStruct() ) NotifyUser( "Resulting table structure is not what we asked for" ) @@ -159,7 +151,7 @@ PROCEDURE Main( cRDDType, cAdsMode ) // TEST: REPLACE - REPLACE CHAR WITH Chr( 65 + Val( SubStr( LTrim( Str( RecNo() ) ), 2, 1 ) ) ) + ; + REPLACE CHAR WITH Chr( Asc( "A" ) + Val( SubStr( LTrim( Str( RecNo() ) ), 2, 1 ) ) ) + ; " RECORD " + LTrim( Str( RecNo() ) ) // TEST: Direct field assigment @@ -216,10 +208,10 @@ PROCEDURE Main( cRDDType, cAdsMode ) // TEST: Index creation - INDEX ON INDEX_KEY_CHAR TO TESTC - INDEX ON INDEX_KEY_NUM TO TESTN ADDITIVE - INDEX ON INDEX_KEY_DATE TO TESTD ADDITIVE - INDEX ON INDEX_KEY_LOG TO TESTL ADDITIVE + INDEX ON INDEX_KEY_CHAR TO test_c.idx + INDEX ON INDEX_KEY_NUM TO test_n.idx ADDITIVE + INDEX ON INDEX_KEY_DATE TO test_d.idx ADDITIVE + INDEX ON INDEX_KEY_LOG TO test_l.idx ADDITIVE // TEST: IndexOrd() @@ -309,15 +301,15 @@ PROCEDURE Main( cRDDType, cAdsMode ) SET EXACT ON SET ORDER TO 0 COUNT for Trim( FIELD->CHAR ) = "A RECORD 1" TO xTemp // Get proper count - INDEX ON CHAR TO TESTE for Trim( FIELD->CHAR ) = "A RECORD 1" additive + INDEX ON CHAR TO test_e.idx FOR RTrim( FIELD->CHAR ) = "A RECORD 1" ADDITIVE IF ! dbOrderInfo( DBOI_KEYCOUNT ) == xTemp NotifyUser( "Bad conditional index count with EXACT ON" ) ENDIF SET EXACT OFF SET ORDER TO 0 - COUNT for Trim( FIELD->CHAR ) = "A RECORD 1" TO xTemp // Get proper count - INDEX ON CHAR TO TESTE for Trim( FIELD->CHAR ) = "A RECORD 1" additive + COUNT FOR RTrim( FIELD->CHAR ) = "A RECORD 1" TO xTemp // Get proper count + INDEX ON CHAR TO test_e.idx FOR RTrim( FIELD->CHAR ) = "A RECORD 1" ADDITIVE IF ! dbOrderInfo( DBOI_KEYCOUNT ) == xTemp NotifyUser( "Bad conditional index count with EXACT OFF" ) ENDIF @@ -331,7 +323,7 @@ PROCEDURE Main( cRDDType, cAdsMode ) // // - // TEST: DBCloseArea() + // TEST: dbCloseArea() MYTEST->( dbCloseArea() ) @@ -351,7 +343,8 @@ PROCEDURE ErrorSys() STATIC PROCEDURE MyError( e ) - LOCAL i := 1 /* Start are "real" error */, cErr + LOCAL i := 1 /* Start are "real" error */ + LOCAL cErr cErr := "Runtime error" + hb_eol() + ; hb_eol() + ; @@ -398,6 +391,15 @@ STATIC PROCEDURE NotifyUser( cErr, lNotError ) ? cErr - QUIT // If remove this, will display all error without stopping + dbCloseAll() + + hb_dbDrop( "test_2" ) + hb_dbDrop( "test_e.idx" ) + hb_dbDrop( "test_c.idx" ) + hb_dbDrop( "test_n.idx" ) + hb_dbDrop( "test_d.idx" ) + hb_dbDrop( "test_l.idx" ) + + QUIT RETURN diff --git a/harbour/tests/tstuse.prg b/harbour/tests/tstuse.prg index fd917fe53c..6c7fd69134 100644 --- a/harbour/tests/tstuse.prg +++ b/harbour/tests/tstuse.prg @@ -7,10 +7,10 @@ PROCEDURE Main() ? OS(), Version() - IF ! hb_FileExists( "_tst.dbf" ) + IF ! hb_dbExists( "_tst.dbf" ) dbCreate( "_tst", { { "F1", "C", 1, 0 } } ) ENDIF - IF ! hb_FileExists( "_tst2.dbf" ) + IF ! hb_dbExists( "_tst2.dbf" ) dbCreate( "_tst2", { { "F1", "C", 1, 0 } } ) ENDIF @@ -35,6 +35,11 @@ PROCEDURE Main() mkTest( .F., "NORDD", , "TWO", .T., .F. ) ? + dbCloseAll() + + hb_dbDrop( "_tst.dbf" ) + hb_dbDrop( "_tst2.dbf" ) + RETURN PROCEDURE mkTest( lNewArea, cRdd, cFile, cAlias, lShared, lReadOnly ) diff --git a/harbour/tests/wcecon.prg b/harbour/tests/wcecon.prg index 72610da6d1..5b6caf951b 100644 --- a/harbour/tests/wcecon.prg +++ b/harbour/tests/wcecon.prg @@ -66,7 +66,7 @@ proc main() dbCreate( cPath + "mydata", { { "F1", "C", 10, 0 }, ; { "F2", "=", 8, 0 }, ; { "FX", "M", 4, 0 } } ) - use ( cPath+"mydata" ) + use ( cPath + "mydata" ) index on F1 tag T1 index on F2 tag T2 while lastrec() < 10 @@ -102,4 +102,9 @@ proc main() ? ; devout( "key=" + str( k, 4 ) + ", char='" + chr( k ) + "'" ) enddo + dbCloseAll() + + hb_dbDrop( cPath + "mydata" ) + dirRemove( cPath ) + return