From ff8abbf18b4d4c2e3fb57ac2d109618a335114ea Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 4 Feb 2010 17:12:21 +0000 Subject: [PATCH] 2010-02-04 18:11 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbfbird/tests/test.prg ! Fixed to work at all. This code was complete nonsense. + Added more status display. ; Anyhow basic tests shows that recent FB changes are okay, but class wrapper never worked and tests were either dummies or wrong. Please test hbfbird with real life code. * contrib/hbfbird/tests/stress.prg * Formatting. * contrib/hbfbird/tests/testapi.c ! Fixed to not refer to env specific IP. The table name is still wrong though. * contrib/hbfbird/tfirebrd.prg + Added TOFIX about very old and very basic problem in the FB class wrapper. --- harbour/ChangeLog | 20 ++++++ harbour/contrib/hbfbird/tests/stress.prg | 44 ++++++------ harbour/contrib/hbfbird/tests/test.prg | 91 +++++++++++++++--------- harbour/contrib/hbfbird/tests/testapi.c | 2 +- harbour/contrib/hbfbird/tfirebrd.prg | 3 +- 5 files changed, 101 insertions(+), 59 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 33b576b5e6..e1b12ec3e6 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,26 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-02-04 18:11 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbfbird/tests/test.prg + ! Fixed to work at all. This code was complete nonsense. + + Added more status display. + ; Anyhow basic tests shows that recent FB changes are okay, + but class wrapper never worked and tests were either + dummies or wrong. Please test hbfbird with real life + code. + + * contrib/hbfbird/tests/stress.prg + * Formatting. + + * contrib/hbfbird/tests/testapi.c + ! Fixed to not refer to env specific IP. The table name is still + wrong though. + + * contrib/hbfbird/tfirebrd.prg + + Added TOFIX about very old and very basic problem in the + FB class wrapper. + 2010-02-04 12:56 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * utils/hbmk2/hbmk2.prg + Added hbmk2_PathMakeRelative(). The opposite of PathProc(). diff --git a/harbour/contrib/hbfbird/tests/stress.prg b/harbour/contrib/hbfbird/tests/stress.prg index 5363fa7f5d..2a160890e2 100644 --- a/harbour/contrib/hbfbird/tests/stress.prg +++ b/harbour/contrib/hbfbird/tests/stress.prg @@ -29,9 +29,9 @@ FUNCTION Main() QUIT ENDIF - IF oServer:TableExists("test") - ? oServer:Execute("DROP TABLE Test") - ? oServer:Execute("DROP DOMAIN boolean_field") + IF oServer:TableExists( "test" ) + ? oServer:Execute( "DROP TABLE Test" ) + ? oServer:Execute( "DROP DOMAIN boolean_field" ) ENDIF ? "Creating domain for boolean fields..." @@ -51,77 +51,77 @@ FUNCTION Main() cQuery += " Creation Date, " cQuery += " Description blob sub_type 1 segment size 40 ) " - ? oServer:Execute(cQuery) + ? "CREATE TABLE:", oServer:Execute( cQuery ) - oQuery := oServer:Query("SELECT code, dept, name, sales, salary, creation FROM test") + oQuery := oServer:Query( "SELECT code, dept, name, sales, salary, creation FROM test" ) oServer:StartTransaction() FOR i := 1 TO 10000 - @ 15,0 say "Inserting values...." + str(i) + @ 15, 0 say "Inserting values...." + hb_ntos( i ) oRow := oQuery:Blank() oRow:Fieldput(1, i) oRow:Fieldput(2, i+1) - oRow:Fieldput(3, "DEPARTMENT NAME " + strzero(i) ) - oRow:Fieldput(4, (mod(i,10) == 0) ) + oRow:Fieldput(3, "DEPARTMENT NAME " + strzero( i ) ) + oRow:Fieldput(4, (i % 10) == 0) ) oRow:Fieldput(5, 3000 + i ) oRow:fieldput(6, Date() ) - oServer:Append(oRow) + oServer:Append( oRow ) - IF mod(i,100) == 0 + IF i % 100 == 0 oServer:Commit() oServer:StartTransaction() ENDIF NEXT FOR i := 5000 TO 7000 - @ 16,0 say "Deleting values...." + str(i) + @ 16,0 say "Deleting values...." + str( i ) oRow := oQuery:Blank() - oServer:Delete(oRow, "code = " + str(i)) + oServer:Delete( oRow, "code = " + str( i ) ) - IF mod(i,100) == 0 + IF i % 100 == 0 oServer:Commit() oServer:StartTransaction() ENDIF NEXT FOR i := 2000 TO 3000 - @ 17,0 say "Updating values...." + str(i) + @ 17,0 say "Updating values...." + str( i ) oRow := oQuery:Blank() - oRow:Fieldput(5, 4000+i) - oServer:update(oRow, "code = " + str(i)) + oRow:Fieldput( 5, 4000 + i ) + oServer:update( oRow, "code = " + str( i ) ) - IF mod(i,100) == 0 + IF i % 100 == 0 oServer:Commit() oServer:StartTransaction() ENDIF NEXT - oQuery := oServer:Query("SELECT sum(salary) sum_salary FROM test WHERE code between 1 and 4000") + oQuery := oServer:Query( "SELECT sum(salary) sum_salary FROM test WHERE code between 1 and 4000" ) IF ! oQuery:Neterr() oQuery:Fetch() - @ 18,0 say "Sum values...." + Str(oQuery:Fieldget(1)) + @ 18,0 say "Sum values...." + Str( oQuery:Fieldget( 1 ) ) oQuery:Destroy() ENDIF x := 0 FOR i := 1 TO 4000 - oQuery := oServer:Query("SELECT * FROM test WHERE code = " + str(i)) + oQuery := oServer:Query( "SELECT * FROM test WHERE code = " + str( i ) ) IF ! oQuery:Neterr() oQuery:Fetch() oRow := oQuery:getrow() oQuery:destroy() - x += oRow:fieldget(oRow:fieldpos("salary")) + x += oRow:fieldget( oRow:fieldpos( "salary" ) ) - @ 19,0 say "Sum values...." + str(x) + @ 19,0 say "Sum values...." + str( x ) ENDIF NEXT diff --git a/harbour/contrib/hbfbird/tests/test.prg b/harbour/contrib/hbfbird/tests/test.prg index d189cf3e99..10720e8e0c 100644 --- a/harbour/contrib/hbfbird/tests/test.prg +++ b/harbour/contrib/hbfbird/tests/test.prg @@ -16,6 +16,7 @@ FUNCTION Main() LOCAL num_cols LOCAL columns LOCAL fetch_stat + LOCAL tmp hb_FNameSplit( hb_argv( 0 ), @cDir, @cName, NIL ) cDBName := hb_FNameMerge( cDir, cName, ".gdb" ) @@ -24,65 +25,85 @@ FUNCTION Main() FErase( cDBName ) ENDIF - ? FBCreateDB( cDBName, "sysdba", "masterkey", 1024, "ASCII", nDialect ) + ? tmp := FBCreateDB( cDBName, "sysdba", "masterkey", 1024, "ASCII", nDialect ), FBError( tmp ) /* Connect rdbms */ db := FBConnect( "127.0.0.1:" + cDBName, "sysdba", "masterkey" ) - IF ISNUMBER( db ) - ? "Error:", FBError( db ) + ? "Error:", db, FBError( db ) QUIT ENDIF - ? FBExecute( db, "sldjfs;ldjs;djf", nDialect ) - - ? FBClose( db ) + ? "Testing invalid request" + ? tmp := FBExecute( db, "sldjfs;ldjs;djf", nDialect ), FBError( tmp ) trans := FBStartTransaction( db ) - FBQuery( db, "create table teste (code smallint)", nDialect, trans ) - FBCommit( trans ) + IF ISNUMBER( trans ) + ? "Error:", trans, FBError( trans ) + ELSE + ? tmp := FBQuery( db, "create table teste (code smallint)", nDialect, trans ), FBError( tmp ) + ? tmp := FBCommit( trans ), FBError( tmp ) + ENDIF - - ? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 1")', nDialect, trans ) - - ? "Status no Rollback: ", FBRollback( trans ) + ? "===" + trans := FBStartTransaction( db ) + IF ISNUMBER( trans ) + ? "Error:", trans, FBError( trans ) + ELSE + ? tmp := FBQuery( db, "CREATE TABLE customer( customer VARCHAR(20) )", nDialect, trans ), FBError( tmp ) + ? tmp := FBCommit( trans ), FBError( tmp ) + ENDIF + ? "===" trans := FBStartTransaction( db ) - ? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 2")', nDialect, trans ) - ? "Status commit: ", FBCommit( trans ) + IF ISNUMBER( trans ) + ? "Error:", trans, FBError( trans ) + ELSE + ? "Status Execute: ", tmp := FBExecute( db, 'insert into customer(customer) values ("test 1")', nDialect, trans ), FBError( tmp ) + ? "Status Rollback: ", tmp := FBRollback( trans ), FBError( tmp ) + ENDIF + trans := FBStartTransaction( db ) + IF ISNUMBER( trans ) + ? "Error:", trans, FBError( trans ) + ELSE + ? "Status Execute: ", tmp := FBExecute( db, 'insert into customer(customer) values ("test 2")', nDialect, trans ), FBError( tmp ) + ? "Status Commit: ", tmp := FBCommit( trans ), FBError( tmp ) + ENDIF - ? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 3")', nDialect ) + ? "Status Execute: ", tmp := FBExecute( db, 'insert into customer(customer) values ("test 3")', nDialect ), FBError( tmp ) // FIX WINDOWS GPF BELOW - qry := FBQuery( db, "SELECT * FROM sales", nDialect ) + qry := FBQuery( db, "SELECT * FROM customer", nDialect ) + IF ISNUMBER( qry ) + ? "Error:", qry, FBError( qry ) + ELSE + num_cols := qry[ 4 ] + columns := qry[ 6 ] - num_cols := qry[ 4 ] - columns := qry[ 6 ] - - FOR x := 1 TO num_cols - ? x, "> " - FOR y := 1 TO Len( columns[ x ] ) - ?? columns[ x, y ], " " - NEXT - NEXT - - ? "---" - - DO WHILE ( fetch_stat := FBFetch( qry ) ) == 0 - ? fetch_stat FOR x := 1 TO num_cols - ?? FBGetData( qry, x ), ", " + ? x, "> " + FOR y := 1 TO Len( columns[ x ] ) + ?? columns[ x, y ], " " + NEXT NEXT - ENDDO - ? "Fetch code:", fetch_stat + ? "---" - ? "Status Free sql: ", FBFree( qry ) + DO WHILE ( fetch_stat := FBFetch( qry ) ) == 0 + ? fetch_stat + FOR x := 1 TO num_cols + ?? FBGetData( qry, x ), ", " + NEXT + ENDDO + ? "Fetch code:", fetch_stat + + ? "Status Free Query: ", FBFree( qry ) + ENDIF /* Close connection with rdbms */ - ? "Status Fechar Database: ", FBClose( db ) + ? "Status Close Database: ", tmp := FBClose( db ), FBError( tmp ) RETURN NIL diff --git a/harbour/contrib/hbfbird/tests/testapi.c b/harbour/contrib/hbfbird/tests/testapi.c index 9893830fa3..53b43bc41a 100644 --- a/harbour/contrib/hbfbird/tests/testapi.c +++ b/harbour/contrib/hbfbird/tests/testapi.c @@ -20,7 +20,7 @@ #define USER "sysdba" #define PASSWORD "masterkey" -#define DATABASE "192.168.1.33:d:\\fontes\\lixo\\test.gdb" +#define DATABASE "127.0.0.1:d:\\fontes\\lixo\\test.gdb" #define ERREXIT(status, rc) {isc_print_status(status); return rc;} #define MAX_BUFFER 1024 diff --git a/harbour/contrib/hbfbird/tfirebrd.prg b/harbour/contrib/hbfbird/tfirebrd.prg index 45d343cece..906b47fc64 100644 --- a/harbour/contrib/hbfbird/tfirebrd.prg +++ b/harbour/contrib/hbfbird/tfirebrd.prg @@ -550,6 +550,7 @@ METHOD Refresh() CLASS TFbQuery IF ISARRAY( qry ) ::numcols := qry[ 4 ] + /* TOFIX: This is faulty code. ::aStruct will become zero length, out of sync with ::numcols. */ ::aStruct := StructConvert( qry[ 6 ], ::db, ::dialect ) ::lError := .F. @@ -937,7 +938,7 @@ STATIC FUNCTION DataToSql( xField ) RETURN NIL -STATIC FUNCTION StructConvert( aStru, db, dialect) +STATIC FUNCTION StructConvert( aStru, db, dialect ) LOCAL aNew := {} LOCAL cField