fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2011-09-07 18:32 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2011-09-07 16:33:53 +00:00
parent 27fa4aab79
commit 58255adfe5
17 changed files with 411 additions and 336 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
harbour/ChangeLog
View File

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

3
harbour/contrib/hbcups/readme.txt
View File

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

24
harbour/contrib/hbcups/tests/test.prg
View File

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

2
harbour/contrib/hbpgsql/hbpgsql.h
View File

@@ -1,5 +1,5 @@
/*
* $Id: postgres.c 16949 2011-07-17 14:23:26Z vszakats $
* $Id$
*/
/*

2
harbour/contrib/hbpgsql/rddcopy.c
View File

@@ -1,5 +1,5 @@
/*
* $Id: postgres.c 16949 2011-07-17 14:23:26Z vszakats $
* $Id$
*/
/*

16
harbour/doc/howtosvn.txt
View File

@@ -100,7 +100,7 @@ by Viktor Szakats
YYYY-MM-DD HH:MM UTC[-|+]hhmm Your Full Name <your_email_address>
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
===========================================================

99
harbour/tests/testprof.prg
View File

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

17
harbour/tests/testrdd.prg
View File

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

32
harbour/tests/testread.prg
View File

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

10
harbour/tests/testrpt.prg
View File

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

195
harbour/tests/teststr.prg
View File

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

49
harbour/tests/testtok.prg
View File

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

38
harbour/tests/testvars.prg
View File

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

46
harbour/tests/ticktime.prg
View File

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

104
harbour/tests/tstasort.prg
View File

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

28
harbour/tests/tstblock.prg
View File

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

53
harbour/tests/tstchbx.prg
View File

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