From 58255adfe5cb532bdbfbf17e6657eca4a89c0ebd Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 7 Sep 2011 16:33:53 +0000 Subject: [PATCH] 2011-09-07 18:32 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * doc/howtosvn.txt + added extra rules to "1.3 Here's how to format your ChangeLog entries" section. * Change markup is not optional anymore, pls stick to it. * contrib/hbcups/tests/test.prg * contrib/hbcups/readme.txt + Added more test code and extra info to hbcups. Update provided by Dr. Claudia Neumann (with my minor fixes/formatting). Many thanks! * contrib/hbpgsql/rddcopy.c * contrib/hbpgsql/hbpgsql.h ! svn props * tests/testtok.prg * tests/testrdd.prg * tests/tstchbx.prg * tests/tstblock.prg * tests/ticktime.prg * tests/testvars.prg * tests/tstasort.prg * tests/testprof.prg * tests/testread.prg * tests/testrpt.prg * tests/teststr.prg * formatting. --- harbour/ChangeLog | 29 ++++ harbour/contrib/hbcups/readme.txt | 3 +- harbour/contrib/hbcups/tests/test.prg | 24 +++- harbour/contrib/hbpgsql/hbpgsql.h | 2 +- harbour/contrib/hbpgsql/rddcopy.c | 2 +- harbour/doc/howtosvn.txt | 16 ++- harbour/tests/testprof.prg | 99 ++++++------- harbour/tests/testrdd.prg | 17 ++- harbour/tests/testread.prg | 32 ++--- harbour/tests/testrpt.prg | 10 +- harbour/tests/teststr.prg | 195 +++++++++++++------------- harbour/tests/testtok.prg | 49 ++++--- harbour/tests/testvars.prg | 38 ++--- harbour/tests/ticktime.prg | 46 +++--- harbour/tests/tstasort.prg | 104 +++++++------- harbour/tests/tstblock.prg | 28 ++-- harbour/tests/tstchbx.prg | 53 ++++--- 17 files changed, 411 insertions(+), 336 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 436b3074f8..eeef38078f 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,35 @@ The license applies to all entries newer than 2009-04-28. */ +2011-09-07 18:32 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + * doc/howtosvn.txt + + added extra rules to "1.3 Here's how to format your ChangeLog entries" + section. + * Change markup is not optional anymore, pls stick to it. + + * contrib/hbcups/tests/test.prg + * contrib/hbcups/readme.txt + + Added more test code and extra info to hbcups. + Update provided by Dr. Claudia Neumann (with my minor fixes/formatting). + Many thanks! + + * contrib/hbpgsql/rddcopy.c + * contrib/hbpgsql/hbpgsql.h + ! svn props + + * tests/testtok.prg + * tests/testrdd.prg + * tests/tstchbx.prg + * tests/tstblock.prg + * tests/ticktime.prg + * tests/testvars.prg + * tests/tstasort.prg + * tests/testprof.prg + * tests/testread.prg + * tests/testrpt.prg + * tests/teststr.prg + * formatting. + 2011-09-06 11:03 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbqt/qtcore/hbqt_hbqevents.cpp + patch for implementation of events handling according to Qt docs. diff --git a/harbour/contrib/hbcups/readme.txt b/harbour/contrib/hbcups/readme.txt index 2b8044e853..036eec960b 100644 --- a/harbour/contrib/hbcups/readme.txt +++ b/harbour/contrib/hbcups/readme.txt @@ -8,7 +8,8 @@ Function Reference ===================================== cupsGetDefault() --> cPrinterName - Returns the CUPS name of the default printer on the default server. + Returns the CUPS name of the default printer on the default server, + or an empty string if no printer is configured as default printer. cupsGetDests() --> aPrinterNames Returns a list of all CUPS printers on the default server. diff --git a/harbour/contrib/hbcups/tests/test.prg b/harbour/contrib/hbcups/tests/test.prg index 69256b3112..b9d778115f 100644 --- a/harbour/contrib/hbcups/tests/test.prg +++ b/harbour/contrib/hbcups/tests/test.prg @@ -4,14 +4,32 @@ PROCEDURE Main() LOCAL i + LOCAL aPrinter - ? "Default printer:", cupsGetDefault() + IF Empty( cupsGetDefault() ) + ? "No default printer configured" + ELSE + ? "Default printer:", cupsGetDefault() + ENDIF + + ? + ? "Cups Printer List:" FOR EACH i IN cupsGetDests() ? i:__enumIndex(), i NEXT - ? "Printing... Job ID:", cupsPrintFile( cupsGetDefault(), "test.prg", "Harbour CUPS Printing", { "sides=one-sided" } ) -/* ? "Printing... Job ID:", cupsPrintFile( cupsGetDefault(), "test.prg", "Harbour CUPS Printing", { "sides" => "one-sided" } ) */ + IF Empty( cupsGetDefault() ) + WAIT + CLEAR SCREEN + aPrinter := cupsGetDests() + i := AChoice( 2, 5, 30, Len( aPrinter ) + 2, aPrinter ) + ? "Printing... Job ID:", cupsPrintFile( aPrinter[ i ], "test.prg", "Harbour CUPS Printing" ) +/* for duplex printing, tested on OKI B410 */ +/* ? "Printing... Job ID:", cupsPrintFile( aPrinter[ i ], "../../../tests/speedstr.prg", "Harbour CUPS Printing", { "sides=two-sided-short-edge" } ) */ + ELSE + ? "Printing... Job ID:", cupsPrintFile( cupsGetDefault(), "test.prg", "Harbour CUPS Printing", { "sides=one-sided" } ) +/* ? "Printing... Job ID:", cupsPrintFile( cupsGetDefault(), "test.prg", "Harbour CUPS Printing", { "sides" => "one-sided" } ) */ + ENDIF RETURN diff --git a/harbour/contrib/hbpgsql/hbpgsql.h b/harbour/contrib/hbpgsql/hbpgsql.h index 939b10df24..ec93695c2e 100644 --- a/harbour/contrib/hbpgsql/hbpgsql.h +++ b/harbour/contrib/hbpgsql/hbpgsql.h @@ -1,5 +1,5 @@ /* - * $Id: postgres.c 16949 2011-07-17 14:23:26Z vszakats $ + * $Id$ */ /* diff --git a/harbour/contrib/hbpgsql/rddcopy.c b/harbour/contrib/hbpgsql/rddcopy.c index 23001a4739..a7a4442655 100644 --- a/harbour/contrib/hbpgsql/rddcopy.c +++ b/harbour/contrib/hbpgsql/rddcopy.c @@ -1,5 +1,5 @@ /* - * $Id: postgres.c 16949 2011-07-17 14:23:26Z vszakats $ + * $Id$ */ /* diff --git a/harbour/doc/howtosvn.txt b/harbour/doc/howtosvn.txt index e553919495..2867984edb 100644 --- a/harbour/doc/howtosvn.txt +++ b/harbour/doc/howtosvn.txt @@ -100,7 +100,7 @@ by Viktor Szakats YYYY-MM-DD HH:MM UTC[-|+]hhmm Your Full Name For example: - 2000-05-27 23:12 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + 2011-05-27 23:12 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) - Add a entry body which lists all filenames changed, all of them with full path spec. Mention the name of the changed function or @@ -122,8 +122,16 @@ by Viktor Szakats - Removed ; Comment - Note that using these specific marks is preferred although not a - requirement. +- In case of incompatible changes, add the word 'INCOMPATIBLE' to + the text. + +- Mark comments suggesting further fixes with '[TOFIX]', further + todos as '[TODO]', and update these to '[DONE]' when implemented. + +- Mark things to merge with different branch as '[TOMERGE x.0]'. + Changes these to '[MERGED x.0]' when merge is completed. + +- Do not use tabs and non-ASCII chars. Remove trailing spaces. - Leave an empty line between the header and body and one after the body. @@ -131,7 +139,7 @@ by Viktor Szakats ================================================================ Please read the following FAQ entry: -http://harbour-project.org/faq/harbour25.html + http://harbour-project.org/faq/harbour25.html 1.5 Things to do to avoid damaging the SourceForge SVN tree =========================================================== diff --git a/harbour/tests/testprof.prg b/harbour/tests/testprof.prg index 62d3a73f3e..ec4f792518 100644 --- a/harbour/tests/testprof.prg +++ b/harbour/tests/testprof.prg @@ -6,10 +6,11 @@ #include "inkey.ch" -Function Main() -Local oProfile := HBProfile():new() -Local oGet := GetNew() -Local n +PROCEDURE Main() + + LOCAL oProfile := HBProfile():new() + LOCAL oGet := GetNew() + LOCAL n // Turn on profiling. __setProfiler( .T. ) @@ -19,96 +20,98 @@ Local n DoNothingForTwoSeconds() // Make sure we've got something to see callwise. - For n := 1 To 500 + FOR n := 1 TO 500 CallMe500Times() - Next + NEXT // Generate some object oriented (oriented? ) entries. - For n := 1 To 500 + FOR n := 1 TO 500 oGet:row := 0 - Next + NEXT // Take a profile snapshot. oProfile:gather() // Report on calls greater than 0 DrawScreen( "All methods/functions called one or more times" ) - memoedit( HBProfileReportToString():new( oProfile:callSort() ):generate( {|o| o:nCalls > 0 } ), 1,,,, .F. ) + MemoEdit( HBProfileReportToString():new( oProfile:callSort() ):generate( {| o | o:nCalls > 0 } ), 1, , , , .F. ) // Sorted by name DrawScreen( "All methods/functions called one or more times, sorted by name" ) - memoedit( HBProfileReportToString():new( oProfile:nameSort() ):generate( {|o| o:nCalls > 0 } ), 1,,,, .F. ) + MemoEdit( HBProfileReportToString():new( oProfile:nameSort() ):generate( {| o | o:nCalls > 0 } ), 1, , , , .F. ) // Sorted by time DrawScreen( "All methods/functions taking measurable time, sorted by time" ) - memoedit( HBProfileReportToString():new( oProfile:timeSort() ):generate( {|o| o:nTicks > 0 } ), 1,,,, .F. ) + MemoEdit( HBProfileReportToString():new( oProfile:timeSort() ):generate( {| o | o:nTicks > 0 } ), 1, , , , .F. ) // TBrowse all calls greater than 0 DrawScreen( "TBrowse all methods/functions called one or more times" ) - Browser( HBProfileReportToTBrowse():new( oProfile:callSort() ):generate( {|o| o:nCalls > 0 }, 1 ) ) + Browser( HBProfileReportToTBrowse():new( oProfile:callSort() ):generate( {| o | o:nCalls > 0 }, 1 ) ) // Some closing stats DrawScreen( "Totals" ) - @ 2, 0 Say " Total Calls: " + str( oProfile:totalCalls() ) - @ 3, 0 Say " Total Ticks: " + str( oProfile:totalTicks() ) - @ 4, 0 Say "Total Seconds: " + str( oProfile:totalSeconds() ) + @ 2, 0 SAY " Total Calls: " + Str( oProfile:totalCalls() ) + @ 3, 0 SAY " Total Ticks: " + Str( oProfile:totalTicks() ) + @ 4, 0 SAY "Total Seconds: " + Str( oProfile:totalSeconds() ) -Return( NIL ) + RETURN -Static Function DrawScreen( cTitle ) +STATIC FUNCTION DrawScreen( cTitle ) - scroll() + Scroll() - @ 0, 0 Say padr( cTitle, maxcol() + 1 ) Color "n/w" + @ 0, 0 SAY PadR( cTitle, MaxCol() + 1 ) COLOR "N/W" -Return( NIL ) + RETURN NIL -Function DoNothingForTwoSeconds() +FUNCTION DoNothingForTwoSeconds() - inkey( 2 ) + Inkey( 2 ) -Return( NIL ) + RETURN NIL -Function CallMe500Times() -Return( NIL ) +FUNCTION CallMe500Times() -Static Function Browser( oBrowse ) -Local lBrowsing := .T. -Local nKey + RETURN NIL - Do While lBrowsing +STATIC FUNCTION Browser( oBrowse ) + + LOCAL lBrowsing := .T. + LOCAL nKey + + DO WHILE lBrowsing oBrowse:forceStable() - nKey := inkey( 0 ) + nKey := Inkey( 0 ) - Do Case + DO CASE - Case nKey == K_ESC - lBrowsing := .F. + CASE nKey == K_ESC + lBrowsing := .F. - Case nKey == K_DOWN - oBrowse:down() + CASE nKey == K_DOWN + oBrowse:down() - Case nKey == K_UP - oBrowse:up() + CASE nKey == K_UP + oBrowse:up() - Case nKey == K_LEFT - oBrowse:left() + CASE nKey == K_LEFT + oBrowse:Left() - Case nKey == K_RIGHT - oBrowse:right() + CASE nKey == K_RIGHT + oBrowse:Right() - Case nKey == K_PGDN - oBrowse:pageDown() + CASE nKey == K_PGDN + oBrowse:pageDown() - Case nKey == K_PGUP - oBrowse:pageUp() + CASE nKey == K_PGUP + oBrowse:pageUp() // And so on.... (not really necessary for this test) - EndCase + ENDCASE - EndDo + ENDDO -Return( NIL ) + RETURN NIL diff --git a/harbour/tests/testrdd.prg b/harbour/tests/testrdd.prg index 728e7ce5ba..fb0d7bb032 100644 --- a/harbour/tests/testrdd.prg +++ b/harbour/tests/testrdd.prg @@ -2,10 +2,10 @@ * $Id$ */ -function main() +PROCEDURE Main() - local aRdd := rddList() - local aStruct := { { "CHARACTER", "C", 25, 0 }, ; + LOCAL aRdd := rddList() + LOCAL aStruct := { { "CHARACTER", "C", 25, 0 }, ; { "NUMERIC", "N", 8, 0 }, ; { "DOUBLE", "N", 8, 2 }, ; { "DATE", "D", 8, 0 }, ; @@ -16,11 +16,11 @@ function main() SET EXCLUSIVE OFF QOut( "Registered RDD's:", LTrim( Str( Len( aRdd ) ) ), "=>" ) - aEval( aRdd, { | cDriver | QQOut( "", cDriver ) } ) + AEval( aRdd, {| cDriver | QQOut( "", cDriver ) } ) QOut() - rddSetDefault("DBFCDX") + rddSetDefault( "DBFCDX" ) dbCreate( "testdbf", aStruct, "DBFCDX" ) - dbUseArea( ,, "testdbf.dbf", "ALIAS_1" ) + dbUseArea( , , "testdbf.dbf", "ALIAS_1" ) ? Bof() dbSelectArea( 2 ) dbUseArea( , "SDF", "testdbf.dbf", "ALIAS_2" ) @@ -31,7 +31,7 @@ function main() dbUseArea( , "DBFNTX", "testdbf.dbf", "ALIAS_4" ) ? Found() dbGoBottom() - dbGoTo( 1 ) + dbGoto( 1 ) dbSelectArea( 5 ) dbUseArea( , "DBF", "testdbf.dbf", "ALIAS_5" ) dbGoTop() @@ -39,5 +39,4 @@ function main() dbCloseArea() dbCloseAll() -return nil - + RETURN diff --git a/harbour/tests/testread.prg b/harbour/tests/testread.prg index 34307ae1c2..8b38698adf 100644 --- a/harbour/tests/testread.prg +++ b/harbour/tests/testread.prg @@ -4,16 +4,16 @@ // Harbour Get System sample -function Main() +PROCEDURE Main() - local cName := "Harbour " - local cWish := "Power " - local cEffort := "Join us! " - local acVars := { { "Hello", "World" } }, Counter + LOCAL cName := "Harbour " + LOCAL cWish := "Power " + LOCAL cEffort := "Join us! " + LOCAL acVars := { { "Hello", "World" } }, Counter - local GetList := {} + LOCAL GetList := {} - SET COLOR TO GR+/B, W+/BG + SET COLOR TO GR +/ B, W +/ BG CLS SET KEY -1 TO ShowVar() @@ -21,10 +21,10 @@ function Main() @ 2, 2 SAY "Enter your name :" GET cName PICTURE "@K!" @ 4, 2 SAY "Enter your wish :" GET cWish @ 6, 2 SAY "Enter your effort:" GET cEffort - @ 8, 2 SAY "Object Data :" GET GetList[1]:Picture + @ 8, 2 SAY "Object Data :" GET GetList[ 1 ]:Picture - FOR Counter := 1 TO Len( acVars[1] ) - @ Row() + 2, 2 SAY "Array Element[1][" + Str( Counter, 1 ) + "]: " GET acVars[1][ Counter ] + FOR Counter := 1 TO Len( acVars[ 1 ] ) + @ Row() + 2, 2 SAY "Array Element[1][" + Str( Counter, 1 ) + "]: " GET acVars[ 1 ][ Counter ] NEXT READ @@ -33,13 +33,13 @@ function Main() ? cName ? cWish ? cEffort - ? acVars[1][1] - ? acVars[1][2] + ? acVars[ 1 ][ 1 ] + ? acVars[ 1 ][ 2 ] -return nil + RETURN -function ShowVar() +PROCEDURE ShowVar() - Alert( Readvar() ) + Alert( ReadVar() ) -return nil + RETURN diff --git a/harbour/tests/testrpt.prg b/harbour/tests/testrpt.prg index 56e333ce93..30efac5c2f 100644 --- a/harbour/tests/testrpt.prg +++ b/harbour/tests/testrpt.prg @@ -2,12 +2,12 @@ * $Id$ */ -FUNCTION MAIN() +PROCEDURE Main() - USE test New + USE test NEW - Report FORM test + REPORT FORM test - USE + USE -RETURN NIL + RETURN diff --git a/harbour/tests/teststr.prg b/harbour/tests/teststr.prg index bbdfa3b746..b574b836b8 100644 --- a/harbour/tests/teststr.prg +++ b/harbour/tests/teststr.prg @@ -1,125 +1,126 @@ -// -// $Id$ -// +/* + * $Id$ + */ -STATIC cNewLine +STATIC s_cNewLine -function main( cParam ) +PROCEDURE Main( cParam ) - IF EMPTY( cParam ) - cNewLine := CHR(13)+CHR(10) + IF Empty( cParam ) + s_cNewLine := Chr( 13 ) + Chr( 10 ) ELSE - cNewLine := CHR(10) - END IF + s_cNewLine := Chr( 10 ) + ENDIF - outstd (cNewLine) - outstd ("Running with SET FIXED OFF (the default setting): ") - outstd (cNewLine) + OutStd( s_cNewLine ) + OutStd( "Running with SET FIXED OFF (the default setting): " ) + OutStd( s_cNewLine ) test() - __ACCEPT ("Pause before running again with SET FIXED ON: ") - outstd (cNewLine) - outstd ("Running with SET FIXED ON: ") - outstd (cNewLine) - SET (_SET_FIXED, "ON") + __ACCEPT( "Pause before running again with SET FIXED ON: " ) + OutStd( s_cNewLine ) + OutStd( "Running with SET FIXED ON: " ) + OutStd( s_cNewLine ) + Set( _SET_FIXED, "ON" ) test() -return nil + RETURN -procedure test() -local a := 15.1 -local b := 10.0002575 -local nI, c, d +PROCEDURE test() - outstd( "1: " ) - outstd (10) - outstd (a) - outstd (-a) - outstd (b) - outstd (-b) - outstd (cNewLine) - outstd( "2: " ) - outstd (a + b) - outstd (a - b) - outstd (a * b) - outstd (a / b) - outstd (cNewLine) - outstd( "3: " ) - outstd (a % b) - outstd (a ** b) - outstd (cNewLine) + LOCAL a := 15.1 + LOCAL b := 10.0002575 + LOCAL nI, c, d + + OutStd( "1: " ) + OutStd( 10 ) + OutStd( a ) + OutStd( - a ) + OutStd( b ) + OutStd( - b ) + OutStd( s_cNewLine ) + OutStd( "2: " ) + OutStd( a + b ) + OutStd( a - b ) + OutStd( a * b ) + OutStd( a / b ) + OutStd( s_cNewLine ) + OutStd( "3: " ) + OutStd( a % b ) + OutStd( a ** b ) + OutStd( s_cNewLine ) c := a * b d := b * a - outstd (cNewLine) - outstd( "4: " ) - outstd (str (c)) - outstd (str (d)) - outstd (cNewLine) - outstd( "5: " ) - outstd (str (c + d)) - outstd (str (c - d)) - outstd (str (c * d)) - outstd (str (c / d)) - outstd (cNewLine) + OutStd( s_cNewLine ) + OutStd( "4: " ) + OutStd( Str( c ) ) + OutStd( Str( d ) ) + OutStd( s_cNewLine ) + OutStd( "5: " ) + OutStd( Str( c + d ) ) + OutStd( Str( c - d ) ) + OutStd( Str( c * d ) ) + OutStd( Str( c / d ) ) + OutStd( s_cNewLine ) - outstd (cNewLine) - outstd( "6: " ) - outstd (a + b + c) - outstd (c - b - a) - outstd (b * a * c) - outstd (b * a * c * d) + OutStd( s_cNewLine ) + OutStd( "6: " ) + OutStd( a + b + c ) + OutStd( c - b - a ) + OutStd( b * a * c ) + OutStd( b * a * c * d ) b := 1.000213 - outstd (b * b * b * b * b * b * b) - outstd (cNewLine) + OutStd( b * b * b * b * b * b * b ) + OutStd( s_cNewLine ) - FOR nI := 1 to 20 - outstd (cNewLine) - outstd( LTRIM( STR( 6 + nI ) ) + ": " ) - outstd (10 ** nI + (1.02 * 1.02)) - NEXT nI - outstd (cNewLine) + FOR nI := 1 TO 20 + OutStd( s_cNewLine ) + OutStd( LTrim( Str( 6 + nI ) ) + ": " ) + OutStd( 10 ** nI + ( 1.02 * 1.02 ) ) + NEXT + OutStd( s_cNewLine ) - outstd (cNewLine) - outstd( "27: " ) - outstd (str (a), a) - outstd (cNewLine) + OutStd( s_cNewLine ) + OutStd( "27: " ) + OutStd( Str( a ), a ) + OutStd( s_cNewLine ) - outstd( "28: " ) - outstd (str (b), b) - outstd (cNewLine) + OutStd( "28: " ) + OutStd( Str( b ), b ) + OutStd( s_cNewLine ) - outstd( "29: " ) - outstd (str (b, 15)) - outstd (cNewLine) + OutStd( "29: " ) + OutStd( Str( b, 15 ) ) + OutStd( s_cNewLine ) - outstd( "30: " ) - outstd (str (b, 20, 5)) - outstd (cNewLine) + OutStd( "30: " ) + OutStd( Str( b, 20, 5 ) ) + OutStd( s_cNewLine ) - outstd( "31: " ) - outstd (str (b, 20, 10)) - outstd (cNewLine) + OutStd( "31: " ) + OutStd( Str( b, 20, 10 ) ) + OutStd( s_cNewLine ) - outstd( "32: " ) - outstd (str (b, 5, 10)) - outstd (cNewLine) + OutStd( "32: " ) + OutStd( Str( b, 5, 10 ) ) + OutStd( s_cNewLine ) - outstd( "33: " ) - outstd (str (b, 20, -10)) - outstd (cNewLine) + OutStd( "33: " ) + OutStd( Str( b, 20, - 10 ) ) + OutStd( s_cNewLine ) - outstd( "34: " ) - outstd (str (b, -12, 7)) - outstd (cNewLine) + OutStd( "34: " ) + OutStd( Str( b, - 12, 7 ) ) + OutStd( s_cNewLine ) - outstd( "35: " ) - outstd (str (b, 0)) - outstd (cNewLine) + OutStd( "35: " ) + OutStd( Str( b, 0 ) ) + OutStd( s_cNewLine ) - outstd (cNewLine) + OutStd( s_cNewLine ) a := 15.1004 - outstd( "36: " ) - outstd (str (a), a) - outstd (cNewLine) + OutStd( "36: " ) + OutStd( Str( a ), a ) + OutStd( s_cNewLine ) -return + RETURN diff --git a/harbour/tests/testtok.prg b/harbour/tests/testtok.prg index ec7837e156..a0b581d592 100644 --- a/harbour/tests/testtok.prg +++ b/harbour/tests/testtok.prg @@ -1,29 +1,34 @@ -// -// $Id$ -// +/* + * $Id$ + */ #include "set.ch" -procedure main() - local a - local i +PROCEDURE main() - set( _SET_EXACT, .T. ) - a := strtoarray("this is a great big test of strtoken") - for i := 1 to len(a) - qout( a[i] ) - next i -return + LOCAL a + LOCAL i -function strtoarray(s) - local aResult := {} - local t, l + SET( _SET_EXACT, .T. ) - while( s <> "" ) - t := strtoken(s, 1,, @l) - aadd(aResult, t) - s := substr(s, l + 2) // skip the delimiter + a := strtoarray( "this is a great big test of strtoken" ) + FOR i := 1 TO Len( a ) + QOut( a[ i ] ) + NEXT - qout( t, str(l), s ) - end -return aResult + RETURN + +FUNCTION strtoarray( s ) + + LOCAL aResult := {} + LOCAL t, l + + DO WHILE s != "" + t := StrToken( s, 1, , @l ) + AAdd( aResult, t ) + s := SubStr( s, l + 2 ) /* skip the delimiter */ + + QOut( t, Str( l ), s ) + ENDDO + + RETURN aResult diff --git a/harbour/tests/testvars.prg b/harbour/tests/testvars.prg index 60e990fb6d..7bf7d0e5dd 100644 --- a/harbour/tests/testvars.prg +++ b/harbour/tests/testvars.prg @@ -1,33 +1,33 @@ -// -// $Id$ -// +/* + * $Id$ + */ -MEMVAR I +MEMVAR i -Function Main(Param1) +PROCEDURE Main( Param1 ) - local i, j, k + LOCAL i, j, k - i := 1 - j := 2 + i := 1 + j := 2 - Sub( @j ) + Sub( @j ) - QOut( j ) + QOut( j ) -return NIL + RETURN -Function Sub( j ) +FUNCTION Sub( j ) - m->i := 1 - j := 3 + m->i := 1 + j := 3 -return NIL + RETURN NIL -Function arrvar() +FUNCTION arrvar() - //local i := {1} +// LOCAL i := { 1 } - i[1] := 2 + i[ 1 ] := 2 -return NIL + RETURN NIL diff --git a/harbour/tests/ticktime.prg b/harbour/tests/ticktime.prg index 86179a4ac5..4f5003af38 100644 --- a/harbour/tests/ticktime.prg +++ b/harbour/tests/ticktime.prg @@ -1,25 +1,27 @@ /* -* $Id$ -*/ + * $Id$ + */ -PROC main() -LOCAL nTime0, nTime, nTimeLast, nMin := 9999, nMax := -9999, nTick := 0, nLoop := 0 +PROCEDURE Main() - ? "Wait for 10 seconds..." - nTimeLast := nTime0 := HB_MILLISECONDS() - DO WHILE ( nTime := HB_MILLISECONDS() ) - nTime0 < 10000 - IF nTimeLast != nTime - nTick++ - nMin := MIN(nMin, nTime - nTimeLast) - nMax := MAX(nMax, nTime - nTimeLast) - nTimeLast := nTime - ENDIF - nLoop++ - ENDDO - nTime := nTimeLast - nTime0 - ? "Ticks per second:", LTRIM(STR(nTick * 1000/ nTime, 12, 3)) - ? "Min/avg/max interval (ms):", LTRIM(STR(nMin, 9, 3)), "/", ; - LTRIM(STR(nTime / nTick, 9, 3)), "/", ; - LTRIM(STR(nMax, 9, 3)) - ? "Loops per tick:", nLoop / nTick -RETURN + LOCAL nTime0, nTime, nTimeLast, nMin := 9999, nMax := - 9999, nTick := 0, nLoop := 0 + + ? "Wait for 10 seconds..." + nTimeLast := nTime0 := HB_MILLISECONDS() + DO WHILE ( nTime := HB_MILLISECONDS() ) - nTime0 < 10000 + IF nTimeLast != nTime + nTick++ + nMin := Min( nMin, nTime - nTimeLast ) + nMax := Max( nMax, nTime - nTimeLast ) + nTimeLast := nTime + ENDIF + nLoop++ + ENDDO + nTime := nTimeLast - nTime0 + ? "Ticks per second:", LTrim( Str( nTick * 1000/ nTime, 12, 3 ) ) + ? "Min/avg/max interval (ms):", LTrim( Str( nMin, 9, 3 ) ), "/", ; + LTrim( Str( nTime / nTick, 9, 3 ) ), "/", ; + LTrim( Str( nMax, 9, 3 ) ) + ? "Loops per tick:", nLoop / nTick + + RETURN diff --git a/harbour/tests/tstasort.prg b/harbour/tests/tstasort.prg index 95d2a87fb3..9cd98a7b55 100644 --- a/harbour/tests/tstasort.prg +++ b/harbour/tests/tstasort.prg @@ -1,65 +1,65 @@ -// -// $Id$ -// +/* + * $Id$ + */ -function main() +FUNCTION main() - local oError := ErrorNew() + LOCAL oError := ErrorNew() - local a := { 3, 2, 1 } - local b := { 10 } - local c := { 2, .T., "B", NIL, { 1 }, {|| b }, oError, Date(), 1, .F., "A", NIL, Date() - 1, { 0 }, {|| a }, oError } - local t + LOCAL a := { 3, 2, 1 } + LOCAL b := { 10 } + LOCAL c := { 2, .T. , "B", NIL, { 1 }, {|| b }, oError, Date(), 1, .F. , "A", NIL, Date() - 1, { 0 }, {|| a }, oError } + LOCAL t - ? - ? - ? "Original.....:", aDump( t := a ) - ? "Asort.c......:", aDump( aSort( t := aClone( a ) ) ) - ? "Asort.c.block:", aDump( aSort( t := aClone( a ), , , {| x, y | x < y } ) ) - ? - ? "Original.....:", aDump( t := b ) - ? "Asort.c......:", aDump( aSort( t := aClone( b ) ) ) - ? "Asort.c.block:", aDump( aSort( t := aClone( b ), , , {| x, y | x < y } ) ) - ? - ? "Original.....:", aDump( t := c ) - ? "Asort.c......:", aDump( aSort( t := aClone( c ) ) ) - ? "Asort.c.block:", aDump( aSort( t := aClone( c ), , , {| x, y | xToStr(x) < xToStr(y) } ) ) + ? + ? + ? "Original.....:", aDump( t := a ) + ? "Asort.c......:", aDump( ASort( t := AClone( a ) ) ) + ? "Asort.c.block:", aDump( ASort( t := AClone( a ), , , {| x, y | x < y } ) ) + ? + ? "Original.....:", aDump( t := b ) + ? "Asort.c......:", aDump( ASort( t := AClone( b ) ) ) + ? "Asort.c.block:", aDump( ASort( t := AClone( b ), , , {| x, y | x < y } ) ) + ? + ? "Original.....:", aDump( t := c ) + ? "Asort.c......:", aDump( ASort( t := AClone( c ) ) ) + ? "Asort.c.block:", aDump( ASort( t := AClone( c ), , , {| x, y | xToStr( x ) < xToStr( y ) } ) ) -return nil + RETURN nil -function aDump( a ) +FUNCTION aDump( a ) - local cStr := "" - local n := len( a ) - local i + LOCAL cStr := "" + LOCAL n := Len( a ) + LOCAL i - for i := 1 to n - cStr += alltrim( xToStr( a[i] ) ) + " " - next + FOR i := 1 TO n + cStr += AllTrim( xToStr( a[ i ] ) ) + " " + NEXT -return cStr + RETURN cStr -function xToStr( xValue ) +FUNCTION xToStr( xValue ) - LOCAL cType := ValType( xValue ) + LOCAL cType := ValType( xValue ) - do case - case cType == "C" .or. cType == "M" - return xValue - case cType == "N" - return AllTrim( Str( xValue ) ) - case cType == "D" - return DToC( xValue ) - case cType == "L" - return iif( xValue, ".T.", ".F." ) - case cType == "U" - return "NIL" - case cType == "A" - return "{.}" - case cType == "B" - return "{|| }" - case cType == "O" - return "[O]" - endcase + DO CASE + CASE cType == "C" .OR. cType == "M" + RETURN xValue + CASE cType == "N" + RETURN AllTrim( Str( xValue ) ) + CASE cType == "D" + RETURN DToC( xValue ) + CASE cType == "L" + RETURN iif( xValue, ".T.", ".F." ) + CASE cType == "U" + RETURN "NIL" + CASE cType == "A" + RETURN "{.}" + CASE cType == "B" + RETURN "{|| }" + CASE cType == "O" + RETURN "[O]" + ENDCASE -return xValue + RETURN xValue diff --git a/harbour/tests/tstblock.prg b/harbour/tests/tstblock.prg index 4e79299096..22a8bc2274 100644 --- a/harbour/tests/tstblock.prg +++ b/harbour/tests/tstblock.prg @@ -4,50 +4,50 @@ PROCEDURE Main() - LOCAL i, bBlock[3] + LOCAL i, bBlock[ 3 ] MEMVAR Var1, Var2, Var3, Macro PRIVATE Var1, Var2, Var3, Macro - M->Var1 := "Var1" - M->Var2 := "Var2" - M->Var3 := "Var3" + M -> Var1 := "Var1" + M -> Var2 := "Var2" + M -> Var3 := "Var3" CLS FOR i := 1 TO 3 - M->Macro := "Var" + Str( i, 1 ) - bBlock[i] := {|| &Macro } + M -> Macro := "Var" + Str( i, 1 ) + bBlock[ i ] := { || &Macro } NEXT ? "Early (Simple):" FOR i := 1 TO 3 - ? Eval( bBlock[i] ) + ? Eval( bBlock[ i ] ) NEXT FOR i := 1 TO 3 - M->Macro := "Var" + Str( i, 1 ) - bBlock[i] := {|| &Macro + "!" } + M -> Macro := "Var" + Str( i, 1 ) + bBlock[ i ] := { || &Macro + "!" } NEXT ? ? "Early (Complex):" FOR i := 1 TO 3 - ? Eval( bBlock[i] ) + ? Eval( bBlock[ i ] ) NEXT FOR i := 1 TO 3 - M->Macro := "Var" + Str( i, 1 ) - bBlock[i] := {|| &(Macro) } + M -> Macro := "Var" + Str( i, 1 ) + bBlock[ i ] := { || &( Macro ) } NEXT ? ? "Late:" FOR i := 1 TO 3 - ? Eval( bBlock[i] ) + ? Eval( bBlock[ i ] ) NEXT -RETURN + RETURN diff --git a/harbour/tests/tstchbx.prg b/harbour/tests/tstchbx.prg index 90f5b101d3..2c960c2804 100644 --- a/harbour/tests/tstchbx.prg +++ b/harbour/tests/tstchbx.prg @@ -1,27 +1,36 @@ /* * $Id$ */ -#include "hbgetcmt.ch" -function Main -Local lx :=.f. -local ly :=.f. -Local citem:="Windows NT/2000" -Local aitems[4] -aitems[1]:=RADIOBUTTO( 3,3,"&Windows NT/2000") -aitems[2]:=RADIOBUTTO( 4,3,"W&indows 9x") -aitems[3]:=RADIOBUTTO( 5,3,"&Linux") -aitems[4]:=RADIOBUTTO( 6,3,"&Mac OS") +FUNCTION Main() -cls -Setcolor('w/b+,r/b,g+/r,b+/r+,bg/n+,w/bg,rb/bg') -@ 2,2,7,40 get citem radiogroup aitems color 'w/b+,r/b,g/b+' MESSAGE "Select Your Os" -@ 8,3 Say "Married" -@ 8,12 Get lx CHECKBOX color 'w/b+,w/b,w+/r,w/g+' MESSAGE "Is You Married?" -@ 9,3 Say "Singer" -@ 9,12 Get ly CHECKBOX color 'w/b+,w/b,w+/r,w/g+' MESSAGE "Are You a Singer" -read MSG AT maxrow(), 0, maxcol() MSG Color "w/b+" -? "Is the Person Married",iif(lx," Yes ", " No ") -? "Is the Person a Singer",iif(ly," Yes ", " No ") -? "Your Os is ",cItem -return Nil + LOCAL GetList := {} + + LOCAL lx := .F. + LOCAL ly := .F. + LOCAL cItem := "Windows NT/2000" + + LOCAL aItems[ 4 ] + + aItems[ 1 ] := RADIOBUTTO( 3, 3, "&Windows NT/2000" ) + aItems[ 2 ] := RADIOBUTTO( 4, 3, "W&indows 9x" ) + aItems[ 3 ] := RADIOBUTTO( 5, 3, "&Linux" ) + aItems[ 4 ] := RADIOBUTTO( 6, 3, "&Mac OS" ) + + CLS + SetColor( "W/B+,R/B,G+/R,B+/R+,BG/N+,W/BG,RB/BG" ) + + @ 2, 2, 7,40 GET cItem RADIOGROUP aItems COLOR "W/B+,R/B,G/B+" MESSAGE "Select your OS" + + @ 8, 3 SAY "Married" + @ 8,12 GET lx CHECKBOX COLOR "W/B+,W/B,W+/R,W/G+" MESSAGE "Is you married?" + @ 9, 3 SAY "Singer" + @ 9,12 GET ly CHECKBOX COLOR "W/B+,W/B,W+/R,W/G+" MESSAGE "Are you a singer" + + READ MSG AT MaxRow(), 0, MaxCol() MSG COLOR "W/B+" + + ? "Is the person married:", iif( lx, "Yes", "No" ) + ? "Is the person a singer:", iif( ly, "Yes", "No" ) + ? "Your OS is", cItem + + RETURN NIL