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
This commit is contained in:
Viktor Szakats
2012-10-04 15:18:50 +00:00
parent 87bfc2c1b1
commit 6dde6b10fe
12 changed files with 94 additions and 54 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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 } )

View File

@@ -373,4 +373,8 @@ PROCEDURE Main()
NEWRDD->( dbSkip() )
NEXT
dbCloseAll()
hb_dbDrop( "newrdd",, "DBFCDX" )
RETURN

View File

@@ -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

View File

@@ -48,4 +48,7 @@ PROCEDURE Main()
Select( "TESTCDX" )
ordCreate( "testcdx", "Character", "CHARACTER", FIELD->CHARACTER, .F. )
dbCloseAll()
hb_dbDrop( "testcdx",, "DBFCDX" )
RETURN

View File

@@ -183,4 +183,7 @@ PROCEDURE Main()
CONTINUE
ENDDO
dbCloseAll()
hb_dbDrop( "testdbf",, "DBFCDX" )
RETURN

View File

@@ -38,5 +38,6 @@ PROCEDURE Main()
dbSkip()
dbCloseArea()
dbCloseAll()
hb_dbDrop( "testdbf",, "DBFCDX" )
RETURN

View File

@@ -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

View File

@@ -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 )

View File

@@ -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