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

2012-07-17 22:29 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbct/tests/addascii.prg
  * contrib/hbct/tests/afteratn.prg
  * contrib/hbct/tests/asciisum.prg
  * contrib/hbct/tests/ascpos.prg
  * contrib/hbct/tests/atadjust.prg
  * contrib/hbct/tests/atnum.prg
  * contrib/hbct/tests/atrepl.prg
  * contrib/hbct/tests/attoken.prg
  * contrib/hbct/tests/beforatn.prg
  * contrib/hbct/tests/charadd.prg
  * contrib/hbct/tests/charand.prg
  * contrib/hbct/tests/chareven.prg
  * contrib/hbct/tests/charhist.prg
  * contrib/hbct/tests/charlist.prg
  * contrib/hbct/tests/charmirr.prg
  * contrib/hbct/tests/charmix.prg
  * contrib/hbct/tests/charnlst.prg
  * contrib/hbct/tests/charnot.prg
  * contrib/hbct/tests/charodd.prg
  * contrib/hbct/tests/charone.prg
  * contrib/hbct/tests/charonly.prg
  * contrib/hbct/tests/charor.prg
  * contrib/hbct/tests/charrem.prg
  * contrib/hbct/tests/charrepl.prg
  * contrib/hbct/tests/charrll.prg
  * contrib/hbct/tests/charrlr.prg
  * contrib/hbct/tests/charshl.prg
  * contrib/hbct/tests/charshr.prg
  * contrib/hbct/tests/charslst.prg
  * contrib/hbct/tests/charsort.prg
  * contrib/hbct/tests/charsub.prg
  * contrib/hbct/tests/charswap.prg
  * contrib/hbct/tests/charxor.prg
  * contrib/hbct/tests/csetarge.prg
  * contrib/hbct/tests/csetatmu.prg
  * contrib/hbct/tests/csetref.prg
  * contrib/hbct/tests/ctwtest.prg
  * contrib/hbct/tests/datetime.prg
  * contrib/hbct/tests/expomant.prg
  * contrib/hbct/tests/finan.prg
  * contrib/hbct/tests/math.prg
  * contrib/hbct/tests/num1.prg
  * contrib/hbct/tests/numtoken.prg
  * contrib/hbct/tests/rangerem.prg
  * contrib/hbct/tests/rangerep.prg
  * contrib/hbct/tests/setatlik.prg
  * contrib/hbct/tests/strdiff.prg
  * contrib/hbct/tests/tab.prg
  * contrib/hbct/tests/token.prg
  * contrib/hbct/tests/token2.prg
  * contrib/hbct/tests/tokenlow.prg
  * contrib/hbct/tests/tokensep.prg
  * contrib/hbct/tests/tokenupp.prg
  * contrib/hbct/tests/trig.prg
  * contrib/hbct/tests/valpos.prg
  * contrib/hbct/tests/wordone.prg
  * contrib/hbct/tests/wordonly.prg
  * contrib/hbct/tests/wordrem.prg
  * contrib/hbct/tests/wordrepl.prg
  * contrib/hbct/tests/wordswap.prg
  * tests/stripem.prg
  * tests/testbrw.prg
    * formatting
    ! deleted relative directory in #include directive
This commit is contained in:
Viktor Szakats
2012-07-17 20:34:29 +00:00
parent 5b55527dfa
commit 62b27c73bb
63 changed files with 3349 additions and 3557 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
harbour/ChangeLog
View File

@@ -16,6 +16,72 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-07-17 22:29 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbct/tests/addascii.prg
* contrib/hbct/tests/afteratn.prg
* contrib/hbct/tests/asciisum.prg
* contrib/hbct/tests/ascpos.prg
* contrib/hbct/tests/atadjust.prg
* contrib/hbct/tests/atnum.prg
* contrib/hbct/tests/atrepl.prg
* contrib/hbct/tests/attoken.prg
* contrib/hbct/tests/beforatn.prg
* contrib/hbct/tests/charadd.prg
* contrib/hbct/tests/charand.prg
* contrib/hbct/tests/chareven.prg
* contrib/hbct/tests/charhist.prg
* contrib/hbct/tests/charlist.prg
* contrib/hbct/tests/charmirr.prg
* contrib/hbct/tests/charmix.prg
* contrib/hbct/tests/charnlst.prg
* contrib/hbct/tests/charnot.prg
* contrib/hbct/tests/charodd.prg
* contrib/hbct/tests/charone.prg
* contrib/hbct/tests/charonly.prg
* contrib/hbct/tests/charor.prg
* contrib/hbct/tests/charrem.prg
* contrib/hbct/tests/charrepl.prg
* contrib/hbct/tests/charrll.prg
* contrib/hbct/tests/charrlr.prg
* contrib/hbct/tests/charshl.prg
* contrib/hbct/tests/charshr.prg
* contrib/hbct/tests/charslst.prg
* contrib/hbct/tests/charsort.prg
* contrib/hbct/tests/charsub.prg
* contrib/hbct/tests/charswap.prg
* contrib/hbct/tests/charxor.prg
* contrib/hbct/tests/csetarge.prg
* contrib/hbct/tests/csetatmu.prg
* contrib/hbct/tests/csetref.prg
* contrib/hbct/tests/ctwtest.prg
* contrib/hbct/tests/datetime.prg
* contrib/hbct/tests/expomant.prg
* contrib/hbct/tests/finan.prg
* contrib/hbct/tests/math.prg
* contrib/hbct/tests/num1.prg
* contrib/hbct/tests/numtoken.prg
* contrib/hbct/tests/rangerem.prg
* contrib/hbct/tests/rangerep.prg
* contrib/hbct/tests/setatlik.prg
* contrib/hbct/tests/strdiff.prg
* contrib/hbct/tests/tab.prg
* contrib/hbct/tests/token.prg
* contrib/hbct/tests/token2.prg
* contrib/hbct/tests/tokenlow.prg
* contrib/hbct/tests/tokensep.prg
* contrib/hbct/tests/tokenupp.prg
* contrib/hbct/tests/trig.prg
* contrib/hbct/tests/valpos.prg
* contrib/hbct/tests/wordone.prg
* contrib/hbct/tests/wordonly.prg
* contrib/hbct/tests/wordrem.prg
* contrib/hbct/tests/wordrepl.prg
* contrib/hbct/tests/wordswap.prg
* tests/stripem.prg
* tests/testbrw.prg
* formatting
! deleted relative directory in #include directive
2012-07-17 13:17 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)
* contrib/hbqt/qtgui/hbqtgui.ch
+ Added: QTreeWidgetItem_* constants.

98
harbour/contrib/hbct/tests/addascii.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function ADDASCII()
* Test CT3 function ADDASCII()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,63 +52,57 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := "This is a test!"
procedure main
ctinit()
local cStr := "This is a test!"
QOut( "Begin test of ADDASCII()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ This should be "1000": ] + addascii( "0000", 1, 1 ) )
QOut( [ This should be "0001": ] + addascii( "0000", 1 ) )
QOut( [ This should be "BAAA": ] + addascii( "AAAA", - 255, 1 ) )
QOut( [ This should be "AAAB": ] + addascii( "AAAA", - 255 ) )
ctinit()
qout ("Begin test of ADDASCII()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ This should be "1000": ]+addascii ("0000", 1, 1))
qout ([ This should be "0001": ]+addascii ("0000", 1))
qout ([ This should be "BAAA": ]+addascii ("AAAA", -255, 1))
qout ([ This should be "AAAB": ]+addascii ("AAAA", -255))
// csetref() tests
qout ()
qout ("CSETREF tests:")
qout (" current csetref setting (should be .f.)................: ", csetref())
qout (" return value of addascii ([A],1,1) call (should be 'B'): ", addascii("A",1,1))
qout (" value of cStr..........................................: ", cStr)
qout (" return value of addascii (cStr,1,1) call...............: ", addascii(cStr,1,1))
qout (" value of cStr is now...................................: ", cStr)
qout (" return value of addascii (@cStr,1,1) call..............: ", addascii(@cStr,1,1))
qout (" value of cStr is now...................................: ", cStr)
qout (" return value of addascii (@cStr,-1,1) call.............: ", addascii(@cStr,-1,1))
qout (" value of cStr is now...................................: ", cStr)
qout (" return value of csetref (.t.)..........................: ", csetref (.t.))
qout (" return value of addascii ([A],1,1) call................: ", addascii("A",1,1))
qout (" return value of addascii (cStr,1,1) call...............: ", addascii(cStr,1,1))
qout (" value of cStr is now...................................: ", cStr)
qout (" return value of addascii (@cStr,1,1) call..............: ", addascii(@cStr,1,1))
qout (" value of cStr is now...................................: ", cStr)
qout (" return value of addascii (@cStr,-1,1) call.............: ", addascii(@cStr,-1,1))
qout (" value of cStr is now...................................: ", cStr)
qout (" return value of csetref (.f.)..........................: ", csetref (.f.))
// tests for the new 4th parameter
qout ()
qout ("Carryover tests (new 4th parameter):")
qout (" return value of addascii([AAAA],1,2,.T.) call ('ABAA')....:", addascii("AAAA",1,2,.T.))
qout (" return value of addascii([AAAA],257,2,.T.) call ('BBAA')..:", addascii("AAAA",257,2,.T.))
qout (" return value of addascii([AAAA],257,2,.F.) call ('ABAA')..:", addascii("AAAA",257,2,.F.))
qout (" return value of addascii([AAAA],258,,.T.) call ('AABC')...:", addascii("AAAA",258,,.T.))
qout (" return value of addascii([ABBA],-257,3,.T.) call ('AAAA').:", addascii("ABBA",-257,3,.T.))
qout ("End test of ADDASCII()")
qout ("")
ctexit()
return
// csetref() tests
QOut()
QOut( "CSETREF tests:" )
QOut( " current csetref setting(should be .f.)................: ", csetref() )
QOut( " return value of addascii([A],1,1) call(should be 'B'): ", addascii( "A",1,1 ) )
QOut( " value of cStr..........................................: ", cStr )
QOut( " return value of addascii(cStr,1,1) call...............: ", addascii( cStr,1,1 ) )
QOut( " value of cStr is now...................................: ", cStr )
QOut( " return value of addascii(@cStr,1,1) call..............: ", addascii( @cStr,1,1 ) )
QOut( " value of cStr is now...................................: ", cStr )
QOut( " return value of addascii(@cStr,-1,1) call.............: ", addascii( @cStr, - 1,1 ) )
QOut( " value of cStr is now...................................: ", cStr )
QOut( " return value of csetref(.t.)..........................: ", csetref( .T. ) )
QOut( " return value of addascii([A],1,1) call................: ", addascii( "A",1,1 ) )
QOut( " return value of addascii(cStr,1,1) call...............: ", addascii( cStr,1,1 ) )
QOut( " value of cStr is now...................................: ", cStr )
QOut( " return value of addascii(@cStr,1,1) call..............: ", addascii( @cStr,1,1 ) )
QOut( " value of cStr is now...................................: ", cStr )
QOut( " return value of addascii(@cStr,-1,1) call.............: ", addascii( @cStr, - 1,1 ) )
QOut( " value of cStr is now...................................: ", cStr )
QOut( " return value of csetref(.f.)..........................: ", csetref( .F. ) )
// tests for the new 4th parameter
QOut()
QOut( "Carryover tests(new 4th parameter):" )
QOut( " return value of addascii([AAAA],1,2,.T.) call('ABAA')....:", addascii( "AAAA",1,2, .T. ) )
QOut( " return value of addascii([AAAA],257,2,.T.) call('BBAA')..:", addascii( "AAAA",257,2, .T. ) )
QOut( " return value of addascii([AAAA],257,2,.F.) call('ABAA')..:", addascii( "AAAA",257,2, .F. ) )
QOut( " return value of addascii([AAAA],258,,.T.) call('AABC')...:", addascii( "AAAA",258,, .T. ) )
QOut( " return value of addascii([ABBA],-257,3,.T.) call('AAAA').:", addascii( "ABBA", - 257,3, .T. ) )
QOut( "End test of ADDASCII()" )
QOut( "" )
ctexit()
RETURN

97
harbour/contrib/hbct/tests/afteratn.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 functions AFTERATNUM()
* Test CT3 functions AFTERATNUM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,63 +52,58 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := "...This...is...a...test!"
procedure main
ctinit()
local cStr := "...This...is...a...test!"
QOut( "Begin test of AFTERATNUM()" )
QOut( "" )
QOut( " Value of cStr is:" + Chr( 34 ) + cStr + Chr( 34 ) )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ afteratnum("..",cStr) should be "test!",] )
QOut( [ and is "] + afteratnum( "..", cStr ) + ["] )
QOut( [ afteratnum("..",cStr,2) should be ".is...a...test!",] )
QOut( [ and is "] + afteratnum( "..", cStr, 2 ) + ["] )
QOut( [ afteratnum("..",cStr,2,2) should be ".a...test!",] )
QOut( [ and is "] + afteratnum( "..", cStr, 2, 2 ) + ["] )
QOut()
qout ("Begin test of AFTERATNUM()")
qout ("")
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
qout ("")
// Tests with CSetAtMuPa(.T.)
QOut( " Multi-Pass tests" )
QOut( " Setting csetatmupa() to .T." )
csetatmupa( .T. )
QOut( [ afteratnum("..",cStr) should be "test!",] )
QOut( [ and is "] + afteratnum( "..", cStr ) + ["] )
QOut( [ afteratnum("..",cStr,2) should be "This...is...a...test!",] )
QOut( [ and is "] + afteratnum( "..", cStr, 2 ) + ["] )
QOut( [ afteratnum("..",cStr,2,2) should be "is...a...test!",] )
QOut( [ and is "] + afteratnum( "..", cStr, 2, 2 ) + ["] )
QOut( " Setting csetatmupa() to .F." )
csetatmupa( .F. )
QOut()
// Some simple tests
qout (" Simple tests:")
qout ([ afteratnum ("..",cStr) should be "test!",])
qout ([ and is "]+afteratnum ("..", cStr)+["])
qout ([ afteratnum ("..",cStr,2) should be ".is...a...test!",])
qout ([ and is "]+afteratnum ("..", cStr, 2)+["])
qout ([ afteratnum ("..",cStr,2,2) should be ".a...test!",])
qout ([ and is "]+afteratnum ("..", cStr, 2, 2)+["])
qout ()
// Tests with CSetAtMuPa(.T.)
qout (" Multi-Pass tests")
qout (" Setting csetatmupa() to .T.")
csetatmupa (.T.)
qout ([ afteratnum ("..",cStr) should be "test!",])
qout ([ and is "]+afteratnum ("..", cStr)+["])
qout ([ afteratnum ("..",cStr,2) should be "This...is...a...test!",])
qout ([ and is "]+afteratnum ("..", cStr, 2)+["])
qout ([ afteratnum ("..",cStr,2,2) should be "is...a...test!",])
qout ([ and is "]+afteratnum ("..", cStr, 2, 2)+["])
qout (" Setting csetatmupa() to .F.")
csetatmupa (.F.)
qout ()
// Tests mit SetAtlike (1)
qout (" SetAtLike tests")
qout ([ Setting setatlike (CT_SETATLIKE_WILDCARD, ".")])
setatlike (CT_SETATLIKE_WILDCARD, ".")
qout ([ afteratnum ("..",cStr) should be "",])
qout ([ and is "]+afteratnum ("..", cStr)+["])
qout ([ afteratnum ("..",cStr,2,2) should be "s...is...a...test!",])
qout ([ and is "]+afteratnum ("..", cStr, 2, 2)+["])
qout ([ afteratnum ("..",cStr,2,10) should be ".a...test!",])
qout ([ and is "]+afteratnum ("..", cStr, 2, 10)+["])
qout ()
qout ("End test of AFTERATNUM()")
qout ()
ctexit()
return
// Tests mit SetAtlike(1)
QOut( " SetAtLike tests" )
QOut( [ Setting setatlike(CT_SETATLIKE_WILDCARD, ".")] )
setatlike( CT_SETATLIKE_WILDCARD, "." )
QOut( [ afteratnum("..",cStr) should be "",] )
QOut( [ and is "] + afteratnum( "..", cStr ) + ["] )
QOut( [ afteratnum("..",cStr,2,2) should be "s...is...a...test!",] )
QOut( [ and is "] + afteratnum( "..", cStr, 2, 2 ) + ["] )
QOut( [ afteratnum("..",cStr,2,10) should be ".a...test!",] )
QOut( [ and is "] + afteratnum( "..", cStr, 2, 10 ) + ["] )
QOut()
QOut( "End test of AFTERATNUM()" )
QOut()
ctexit()
RETURN

34
harbour/contrib/hbct/tests/asciisum.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function ASCIISUM()
* Test CT3 function ASCIISUM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,23 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of ASCIISUM()")
qout ("")
qout ([ asciisum (replicate ("A", 10000)) == 650000 ? --> ] + str (asciisum (replicate("A",10000))))
qout ([ asciisum ("0123456789") == 525 ? --> ] + str (asciisum ("0123456789")))
qout ([ asciisum (nil) == 0 ? --> ] + str (asciisum (nil)))
qout ("")
qout ("End test of ASCIISUM()")
qout ("")
ctexit()
return
QOut( "Begin test of ASCIISUM()" )
QOut( "" )
QOut( [ asciisum(replicate("A", 10000)) == 650000 ? --> ] + Str( asciisum(Replicate("A",10000 ) ) ) )
QOut( [ asciisum("0123456789") == 525 ? --> ] + Str( asciisum("0123456789" ) ) )
QOut( [ asciisum(nil) == 0 ? --> ] + Str( asciisum(nil ) ) )
QOut( "" )
QOut( "End test of ASCIISUM()" )
QOut( "" )
ctexit()
RETURN

34
harbour/contrib/hbct/tests/ascpos.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function ASCPOS()
* Test CT3 function ASCPOS()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,23 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of ASCPOS()")
qout ("")
qout ([ ascpos ("0123456789") == 57 ? --> ] + str (ascpos ("0123456789")))
qout ([ ascpos ("0123456789",1) == 48 ? --> ] + str (ascpos ("0123456789",1)))
qout ([ ascpos ("0123456789",11) == 0 ? --> ] + str (ascpos ("0123456789",11)))
qout ("")
qout ("End test of ASCPOS()")
qout ("")
ctexit()
return
QOut( "Begin test of ASCPOS()" )
QOut( "" )
QOut( [ ascpos("0123456789") == 57 ? --> ] + Str( ascpos("0123456789" ) ) )
QOut( [ ascpos("0123456789",1) == 48 ? --> ] + Str( ascpos("0123456789",1 ) ) )
QOut( [ ascpos("0123456789",11) == 0 ? --> ] + Str( ascpos("0123456789",11 ) ) )
QOut( "" )
QOut( "End test of ASCPOS()" )
QOut( "" )
ctexit()
RETURN

84
harbour/contrib/hbct/tests/atadjust.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function ATADJUST()
* Test CT3 function ATADJUST()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,58 +52,52 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL aStr := { "Introduction: 1", ;
"Theory: 5", ;
"Material and Methods: 13", ;
"Results: 19", ;
"Discussion: 21" }
LOCAL ni
procedure main
ctinit()
local aStr := {"Introduction: 1",;
"Theory: 5",;
"Material and Methods: 13",;
"Results: 19",;
"Discussion: 21"}
local ni
// Some simple tests
QOut( "Begin test of ATADJUST()" )
QOut( "" )
ctinit()
QOut( " Original strings:" )
for ni := 1 TO Len( aStr )
QOut( Space( 4 ) + aStr[ni] )
next
QOut( "" )
// Some simple tests
qout ("Begin test of ATADJUST()")
qout ("")
QOut( ' ATADJUST(":", aStr[ni], 21,,, ".") yields' )
for ni := 1 TO Len( aStr )
QOut( Space( 4 ) + atadjust( ":", aStr[ni], 21, 1,,"." ) )
next
QOut( "" )
qout (" Original strings:")
for ni := 1 to len (aStr)
qout (space(4)+aStr[ni])
next ni
qout ("")
qout (' ATADJUST (":", aStr[ni], 21,,, ".") yields')
for ni := 1 to len (aStr)
qout (space(4)+atadjust (":", aStr[ni], 21, 1,,"."))
next ni
qout ("")
qout (' ATADJUST (":", aStr[ni], 10, 1,, ".") yields')
for ni := 1 to len (aStr)
qout (space(4)+atadjust (":", aStr[ni], 10, 1,,"."))
next ni
qout ("")
qout (' SETATLIKE (CT_SETATLIKE_WILDCARD, ":")')
qout (' ATADJUST (":", aStr[ni], 10, 1,, ".") yields now')
setatlike (CT_SETATLIKE_WILDCARD, ":")
for ni := 1 to len (aStr)
qout (space(4)+atadjust (":", aStr[ni], 10, 1,,"."))
next ni
qout ("")
qout ("End test of ATADJUST()")
qout ("")
ctexit()
return
QOut( ' ATADJUST(":", aStr[ni], 10, 1,, ".") yields' )
for ni := 1 TO Len( aStr )
QOut( Space( 4 ) + atadjust( ":", aStr[ni], 10, 1,,"." ) )
next
QOut( "" )
QOut( ' SETATLIKE(CT_SETATLIKE_WILDCARD, ":")' )
QOut( ' ATADJUST(":", aStr[ni], 10, 1,, ".") yields now' )
setatlike( CT_SETATLIKE_WILDCARD, ":" )
for ni := 1 TO Len( aStr )
QOut( Space( 4 ) + atadjust( ":", aStr[ni], 10, 1,,"." ) )
next
QOut( "" )
QOut( "End test of ATADJUST()" )
QOut( "" )
ctexit()
RETURN

97
harbour/contrib/hbct/tests/atnum.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 functions ATNUM()
* Test CT3 functions ATNUM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,63 +52,58 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := "...This...is...a...test!"
procedure main
ctinit()
local cStr := "...This...is...a...test!"
QOut( "Begin test of ATNUM()" )
QOut( "" )
QOut( " Value of cStr is:" + Chr( 34 ) + cStr + Chr( 34 ) )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ atnum("..",cStr) should be 18,] )
QOut( [ and is ], atnum( "..", cStr ) )
QOut( [ atnum("..",cStr,2) should be 8,] )
QOut( [ and is ], atnum( "..", cStr, 2 ) )
QOut( [ atnum("..",cStr,2,2) should be 13,] )
QOut( [ and is ], atnum( "..", cStr, 2, 2 ) )
QOut()
qout ("Begin test of ATNUM()")
qout ("")
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
qout ("")
// Tests with CSetAtMuPa(.T.)
QOut( " Multi-Pass tests" )
QOut( " Setting csetatmupa() to .T." )
csetatmupa( .T. )
QOut( [ atnum("..",cStr) should be 18,] )
QOut( [ and is ], atnum( "..", cStr ) )
QOut( [ atnum("..",cStr,2) should be 2,] )
QOut( [ and is ], atnum( "..", cStr, 2 ) )
QOut( [ atnum("..",cStr,2,2) should be 9,] )
QOut( [ and is ], atnum( "..", cStr, 2, 2 ) )
QOut( " Setting csetatmupa() to .F." )
csetatmupa( .F. )
QOut()
// Some simple tests
qout (" Simple tests:")
qout ([ atnum ("..",cStr) should be 18,])
qout ([ and is ],atnum ("..", cStr))
qout ([ atnum ("..",cStr,2) should be 8,])
qout ([ and is ],atnum ("..", cStr, 2))
qout ([ atnum ("..",cStr,2,2) should be 13,])
qout ([ and is ],atnum ("..", cStr, 2, 2))
qout ()
// Tests with CSetAtMuPa(.T.)
qout (" Multi-Pass tests")
qout (" Setting csetatmupa() to .T.")
csetatmupa (.T.)
qout ([ atnum ("..",cStr) should be 18,])
qout ([ and is ],atnum ("..", cStr))
qout ([ atnum ("..",cStr,2) should be 2,])
qout ([ and is ],atnum ("..", cStr, 2))
qout ([ atnum ("..",cStr,2,2) should be 9,])
qout ([ and is ],atnum ("..", cStr, 2, 2))
qout (" Setting csetatmupa() to .F.")
csetatmupa (.F.)
qout ()
// Tests mit SetAtlike (1)
qout (" SetAtLike tests")
qout ([ Setting setatlike (CT_SETATLIKE_WILDCARD, ".")])
setatlike (CT_SETATLIKE_WILDCARD, ".")
qout ([ atnum ("..",cStr) should be 23,])
qout ([ and is ],atnum ("..", cStr))
qout ([ atnum ("..",cStr,2,2) should be 5,])
qout ([ and is ],atnum ("..", cStr, 2, 2))
qout ([ atnum ("..",cStr,2,10) should be 13,])
qout ([ and is ],atnum ("..", cStr, 2, 10))
qout ()
qout ("End test of ATNUM()")
qout ()
ctexit()
return
// Tests mit SetAtlike(1)
QOut( " SetAtLike tests" )
QOut( [ Setting setatlike(CT_SETATLIKE_WILDCARD, ".")] )
setatlike( CT_SETATLIKE_WILDCARD, "." )
QOut( [ atnum("..",cStr) should be 23,] )
QOut( [ and is ], atnum( "..", cStr ) )
QOut( [ atnum("..",cStr,2,2) should be 5,] )
QOut( [ and is ], atnum( "..", cStr, 2, 2 ) )
QOut( [ atnum("..",cStr,2,10) should be 13,] )
QOut( [ and is ], atnum( "..", cStr, 2, 10 ) )
QOut()
QOut( "End test of ATNUM()" )
QOut()
ctexit()
RETURN

41
harbour/contrib/hbct/tests/atrepl.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function ATREPL()
* Test CT3 function ATREPL()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,33 +52,28 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
procedure main()
ctinit()
ctinit()
QOut( "Begin test of ATREPL()" )
QOut( "" )
qout ("Begin test of ATREPL()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx") == "xxDxxDxx" ? --> "] + atrepl ("ABC", "ABCDABCDABC", "xx") + ["])
qout ([ atrepl ("ABC", "ABCDABC", "ZYXW") == "ZYXWDZYXW" ? --> "] + atrepl ("ABC", "ABCDABC", "ZYXW") + ["])
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx", 2) == "xxDxxDABC" ? --> "] + atrepl ("ABC", "ABCDABCDABC", "xx", 2) + ["])
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T.) == "ABCDxxDABC" ? --> "] + atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T.) + ["])
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T., 1) == "ABCDABCDxx" ? ])
qout ([ --> "] + atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T., 1) + ["])
qout ("End test of ATREPL()")
qout ("")
ctexit()
return
// simple tests
QOut( "Simple tests:" )
QOut( [ atrepl("ABC", "ABCDABCDABC", "xx") == "xxDxxDxx" ? --> "] + atrepl( "ABC", "ABCDABCDABC", "xx" ) + ["] )
QOut( [ atrepl("ABC", "ABCDABC", "ZYXW") == "ZYXWDZYXW" ? --> "] + atrepl( "ABC", "ABCDABC", "ZYXW" ) + ["] )
QOut( [ atrepl("ABC", "ABCDABCDABC", "xx", 2) == "xxDxxDABC" ? --> "] + atrepl( "ABC", "ABCDABCDABC", "xx", 2 ) + ["] )
QOut( [ atrepl("ABC", "ABCDABCDABC", "xx", 2, .T.) == "ABCDxxDABC" ? --> "] + atrepl( "ABC", "ABCDABCDABC", "xx", 2, .T. ) + ["] )
QOut( [ atrepl("ABC", "ABCDABCDABC", "xx", 2, .T., 1) == "ABCDABCDxx" ? ] )
QOut( [ --> "] + atrepl( "ABC", "ABCDABCDABC", "xx", 2, .T. , 1 ) + ["] )
QOut( "End test of ATREPL()" )
QOut( "" )
ctexit()
RETURN

61
harbour/contrib/hbct/tests/attoken.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function ATTOKEN()
* Test CT3 function ATTOKEN()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,44 +52,39 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := "...This...is...a...test!"
LOCAL ni, npos
procedure main
ctinit()
local cStr := "...This...is...a...test!"
local ni, npos
QOut( "Begin test of ATTOKEN()" )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ attoken("Hello, World!") == 8 ? ---------> ] + Str( attoken("Hello, World!" ) ) )
QOut( [ attoken("Hello, World!",,2) == 8 ? ------> ] + Str( attoken("Hello, World!",,2 ) ) )
QOut( [ attoken("Hello, World!",,2,1) == 7 ? ----> ] + Str( attoken("Hello, World!",,2,1 ) ) )
QOut( [ attoken("Hello, World!"," ",2,1) == 8 ? -> ] + Str( attoken("Hello, World!"," ",2,1 ) ) )
QOut( "" )
qout ("Begin test of ATTOKEN()")
qout ("")
// Some simple tests
qout (" Simple tests:")
qout ([ attoken ("Hello, World!") == 8 ? ---------> ] + str(attoken ("Hello, World!")))
qout ([ attoken ("Hello, World!",,2) == 8 ? ------> ] + str(attoken ("Hello, World!",,2)))
qout ([ attoken ("Hello, World!",,2,1) == 7 ? ----> ] + str(attoken ("Hello, World!",,2,1)))
qout ([ attoken ("Hello, World!"," ",2,1) == 8 ? -> ] + str(attoken ("Hello, World!"," ",2,1)))
qout ("")
qout ([ Tokenizing a string with skip width == 1 and ".!" as tokenizer list:])
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
qout ("")
for ni := 1 to numtoken (cStr, ".!", 1)
qout ([ Token #]+alltrim(str(ni))+[ ("]+token(cStr, ".!", ni, 1)+[")])
qout (" starts at pos "+str(npos:=attoken (cStr, ".!", ni, 1),3)+;
" and is "+iif(substr(cStr,npos,1)$".!","","not ")+"an empty token.")
next ni
qout ("")
qout ("End test of ATTOKEN()")
qout ()
ctexit()
return
QOut( [ Tokenizing a string with skip width == 1 and ".!" as tokenizer list:] )
QOut( " Value of cStr is:" + Chr( 34 ) + cStr + Chr( 34 ) )
QOut( "" )
for ni := 1 TO numtoken( cStr, ".!", 1 )
QOut( [ Token #] + AllTrim( Str(ni ) ) + [("] + token( cStr, ".!", ni, 1 ) + [")] )
QOut( " starts at pos " + Str( npos := attoken(cStr, ".!", ni, 1 ),3 ) + ;
" and is " + iif( SubStr( cStr,npos,1 ) $ ".!", "", "not " ) + "an empty token." )
next ni
QOut( "" )
QOut( "End test of ATTOKEN()" )
QOut()
ctexit()
RETURN

97
harbour/contrib/hbct/tests/beforatn.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 functions BEFORATNUM()
* Test CT3 functions BEFORATNUM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,63 +52,58 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := "...This...is...a...test!"
procedure main
ctinit()
local cStr := "...This...is...a...test!"
QOut( "Begin test of BEFORATNUM()" )
QOut( "" )
QOut( " Value of cStr is:" + Chr( 34 ) + cStr + Chr( 34 ) )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ beforatnum("..",cStr) should be "...This...is...a.",] )
QOut( [ and is "] + beforatnum( "..", cStr ) + ["] )
QOut( [ beforatnum("..",cStr,2) should be "...This",] )
QOut( [ and is "] + beforatnum( "..", cStr, 2 ) + ["] )
QOut( [ beforatnum("..",cStr,2,2) should be "...This...is",] )
QOut( [ and is "] + beforatnum( "..", cStr, 2, 2 ) + ["] )
QOut()
qout ("Begin test of BEFORATNUM()")
qout ("")
qout (" Value of cStr is:"+chr(34)+cStr+chr(34))
qout ("")
// Tests with CSetAtMuPa(.T.)
QOut( " Multi-Pass tests" )
QOut( " Setting csetatmupa() to .T." )
csetatmupa( .T. )
QOut( [ beforatnum("..",cStr) should be "...This...is...a.",] )
QOut( [ and is "] + beforatnum( "..", cStr ) + ["] )
QOut( [ beforatnum("..",cStr,2) should be ".",] )
QOut( [ and is "] + beforatnum( "..", cStr, 2 ) + ["] )
QOut( [ beforatnum("..",cStr,2,2) should be "...This.",] )
QOut( [ and is "] + beforatnum( "..", cStr, 2, 2 ) + ["] )
QOut( " Setting csetatmupa() to .F." )
csetatmupa( .F. )
QOut()
// Some simple tests
qout (" Simple tests:")
qout ([ beforatnum ("..",cStr) should be "...This...is...a.",])
qout ([ and is "]+beforatnum ("..", cStr)+["])
qout ([ beforatnum ("..",cStr,2) should be "...This",])
qout ([ and is "]+beforatnum ("..", cStr, 2)+["])
qout ([ beforatnum ("..",cStr,2,2) should be "...This...is",])
qout ([ and is "]+beforatnum ("..", cStr, 2, 2)+["])
qout ()
// Tests with CSetAtMuPa(.T.)
qout (" Multi-Pass tests")
qout (" Setting csetatmupa() to .T.")
csetatmupa (.T.)
qout ([ beforatnum ("..",cStr) should be "...This...is...a.",])
qout ([ and is "]+beforatnum ("..", cStr)+["])
qout ([ beforatnum ("..",cStr,2) should be ".",])
qout ([ and is "]+beforatnum ("..", cStr, 2)+["])
qout ([ beforatnum ("..",cStr,2,2) should be "...This.",])
qout ([ and is "]+beforatnum ("..", cStr, 2, 2)+["])
qout (" Setting csetatmupa() to .F.")
csetatmupa (.F.)
qout ()
// Tests mit SetAtlike (1)
qout (" SetAtLike tests")
qout ([ Setting setatlike (CT_SETATLIKE_WILDCARD, ".")])
setatlike (CT_SETATLIKE_WILDCARD, ".")
qout ([ beforatnum ("..",cStr) should be "...This...is...a...tes",])
qout ([ and is "]+beforatnum ("..", cStr)+["])
qout ([ beforatnum ("..",cStr,2,2) should be "...T",])
qout ([ and is "]+beforatnum ("..", cStr, 2, 2)+["])
qout ([ beforatnum ("..",cStr,2,10) should be "...This...is",])
qout ([ and is "]+beforatnum ("..", cStr, 2, 10)+["])
qout ()
qout ("End test of BEFORATNUM()")
qout ()
ctexit()
return
// Tests mit SetAtlike(1)
QOut( " SetAtLike tests" )
QOut( [ Setting setatlike(CT_SETATLIKE_WILDCARD, ".")] )
setatlike( CT_SETATLIKE_WILDCARD, "." )
QOut( [ beforatnum("..",cStr) should be "...This...is...a...tes",] )
QOut( [ and is "] + beforatnum( "..", cStr ) + ["] )
QOut( [ beforatnum("..",cStr,2,2) should be "...T",] )
QOut( [ and is "] + beforatnum( "..", cStr, 2, 2 ) + ["] )
QOut( [ beforatnum("..",cStr,2,10) should be "...This...is",] )
QOut( [ and is "] + beforatnum( "..", cStr, 2, 10 ) + ["] )
QOut()
QOut( "End test of BEFORATNUM()" )
QOut()
ctexit()
RETURN

38
harbour/contrib/hbct/tests/charadd.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARADD()
* Test CT3 function CHARADD()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,25 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARADD()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charadd ("012345678", chr(1)) == "123456789" ? -> "] + charadd ("012345678", chr(1)) + ["])
qout ([ charadd ("012345678", chr(1)+chr(2)) == "133557799" ? -> "] + charadd ("012345678", chr(1)+chr(2)) + ["])
qout ([ charadd ("123456789", chr(255)) == "012345678" ? -> "] + charadd ("123456789", chr(255)) + ["])
qout ([ charadd ("123456789", chr(255)+chr(254)) == "002244668" ? -> "] + charadd ("123456789", chr(255)+chr(254)) + ["])
qout ("End test of CHARADD()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARADD()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charadd("012345678", chr(1)) == "123456789" ? -> "] + charadd( "012345678", Chr(1 ) ) + ["] )
QOut( [ charadd("012345678", chr(1)+chr(2)) == "133557799" ? -> "] + charadd( "012345678", Chr(1 ) + Chr(2 ) ) + ["] )
QOut( [ charadd("123456789", chr(255)) == "012345678" ? -> "] + charadd( "123456789", Chr(255 ) ) + ["] )
QOut( [ charadd("123456789", chr(255)+chr(254)) == "002244668" ? -> "] + charadd( "123456789", Chr(255 ) + Chr(254 ) ) + ["] )
QOut( "End test of CHARADD()" )
QOut( "" )
ctexit()
RETURN

33
harbour/contrib/hbct/tests/charand.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARAND()
* Test CT3 function CHARAND()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CHARAND()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
qout ("Begin test of CHARAND()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charand ("012345678", chr(254)) == "002244668" ? --> "] + charand ("012345678", chr(254)) + ["])
qout ([ charand ("012345678", chr(254)+chr(252)) == "002044648" ? --> "] + charand ("012345678", chr(254)+chr(252)) + ["])
qout ("End test of CHARAND()")
qout ("")
ctexit()
return
QOut( [ charand("012345678", chr(254)) == "002244668" ? --> "] + charand( "012345678", Chr(254 ) ) + ["] )
QOut( [ charand("012345678", chr(254)+chr(252)) == "002044648" ? --> "] + charand( "012345678", Chr(254 ) + Chr(252 ) ) + ["] )
QOut( "End test of CHARAND()" )
QOut( "" )
ctexit()
RETURN

36
harbour/contrib/hbct/tests/chareven.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHAREVEN()
* Test CT3 function CHAREVEN()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,30 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHAREVEN()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ chareven (" 1 2 3 4 5") == "12345" ? --> "] + chareven (" 1 2 3 4 5") + ["])
qout ([ chareven (" 1 2 3 4 ") == "1234" ? --> "] + chareven (" 1 2 3 4 ") + ["])
qout ([ chareven (" ") == "" ? --> "] + chareven (" ") + ["])
qout ("End test of CHAREVEN()")
qout ("")
ctexit()
return
QOut( "Begin test of CHAREVEN()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ chareven(" 1 2 3 4 5") == "12345" ? --> "] + chareven( " 1 2 3 4 5" ) + ["] )
QOut( [ chareven(" 1 2 3 4 ") == "1234" ? --> "] + chareven( " 1 2 3 4 " ) + ["] )
QOut( [ chareven(" ") == "" ? --> "] + chareven( " " ) + ["] )
QOut( "End test of CHAREVEN()" )
QOut( "" )
ctexit()
RETURN

40
harbour/contrib/hbct/tests/charhist.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARHIST()
* Test CT3 function CHARHIST()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,33 +52,27 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL nTotal := 0
procedure main
ctinit()
local nTotal := 0
ctinit()
qout ("Begin test of CHARHIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charhist ("Hello World !")]+"[109] == 3 ? --> ", charhist ("Hello World !")[109])
qout ([ aeval (charhist ("Hello World !"),{|x|nTotal+=x})])
aeval (charhist ("Hello World !"),{|x|nTotal+=x})
qout ([ ==> nTotal == len("Hello World !") ? --> ], nTotal == len("Hello World !"))
qout ("End test of CHARHIST()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARHIST()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charhist("Hello World !")] + "[109] == 3 ? --> ", charhist( "Hello World !" )[109] )
QOut( [ aeval(charhist("Hello World !"),{|x|nTotal+=x})] )
AEval( charhist( "Hello World !" ), { |x|nTotal += x } )
QOut( [ ==> nTotal == len("Hello World !") ? --> ], nTotal == Len( "Hello World !" ) )
QOut( "End test of CHARHIST()" )
QOut( "" )
ctexit()
RETURN

34
harbour/contrib/hbct/tests/charlist.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARLIST()
* Test CT3 function CHARLIST()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,23 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARLIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charlist ("Hello World !") == "Helo Wrd!" ? -> "] + charlist ("Hello World !") + ["])
qout ([ charlist (nil) == "" ? -> "] + charlist (nil) + ["])
qout ("End test of CHARLIST()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARLIST()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charlist("Hello World !") == "Helo Wrd!" ? -> "] + charlist( "Hello World !" ) + ["] )
QOut( [ charlist(nil) == "" ? -> "] + charlist( nil ) + ["] )
QOut( "End test of CHARLIST()" )
QOut( "" )
ctexit()
RETURN

36
harbour/contrib/hbct/tests/charmirr.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARMIRR()
* Test CT3 function CHARMIRR()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,30 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARMIRR()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charmirr ("racecar") == "racecar" ? ----------> "] + charmirr("racecar") + ["])
qout ([ charmirr ("racecar ", .T.) == "racecar " ? -> "] + charmirr("racecar ", .T.) + ["])
qout ([ charmirr ("racecar ", .F.) == " racecar" ? -> "] + charmirr("racecar ", .F.) + ["])
qout ("End test of CHARMIRR()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARMIRR()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charmirr("racecar") == "racecar" ? ----------> "] + charmirr( "racecar" ) + ["] )
QOut( [ charmirr("racecar ", .T.) == "racecar " ? -> "] + charmirr( "racecar ", .T. ) + ["] )
QOut( [ charmirr("racecar ", .F.) == " racecar" ? -> "] + charmirr( "racecar ", .F. ) + ["] )
QOut( "End test of CHARMIRR()" )
QOut( "" )
ctexit()
RETURN

42
harbour/contrib/hbct/tests/charmix.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARMIX()
* Test CT3 function CHARMIX()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,33 +52,27 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARMIX()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charmix("ABC", "123") == "A1B2C3" ? --> "] + charmix("ABC", "123") + ["])
qout ([ charmix("ABCDE", "12") == "A1B2C1D2E1" ? --> "] + charmix("ABCDE", "12") + ["])
qout ([ charmix("AB", "12345") == "A1B2" ? --> "] + charmix("AB", "12345") + ["])
qout ([ charmix("HELLO", " ") == "H E L L O " ? --> "] + charmix("HELLO", " ") + ["])
qout ([ charmix("HELLO", "") == "HELLO" ? --> "] + charmix("HELLO", "") + ["])
qout ("")
qout ("End test of CHARMIX()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARMIX()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charmix("ABC", "123") == "A1B2C3" ? --> "] + charmix( "ABC", "123" ) + ["] )
QOut( [ charmix("ABCDE", "12") == "A1B2C1D2E1" ? --> "] + charmix( "ABCDE", "12" ) + ["] )
QOut( [ charmix("AB", "12345") == "A1B2" ? --> "] + charmix( "AB", "12345" ) + ["] )
QOut( [ charmix("HELLO", " ") == "H E L L O " ? --> "] + charmix( "HELLO", " " ) + ["] )
QOut( [ charmix("HELLO", "") == "HELLO" ? --> "] + charmix( "HELLO", "" ) + ["] )
QOut( "" )
QOut( "End test of CHARMIX()" )
QOut( "" )
ctexit()
RETURN

34
harbour/contrib/hbct/tests/charnlst.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARNOLIST()
* Test CT3 function CHARNOLIST()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,30 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CHARNOLIST()" )
QOut( "" )
ctinit()
qout ("Begin test of CHARNOLIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charnolist (charnolist ("Hello World !")) == " !HWdelor" ? -> "] + charnolist (charnolist ("Hello World !")) + ["])
qout ([ charnolist (charnolist (nil)) == ""? -> "] + charnolist (charnolist (nil)) + ["])
qout ("End test of CHARNOLIST()")
qout ("")
ctexit()
return
// simple tests
QOut( "Simple tests:" )
QOut( [ charnolist(charnolist("Hello World !")) == " !HWdelor" ? -> "] + charnolist( charnolist("Hello World !" ) ) + ["] )
QOut( [ charnolist(charnolist(nil)) == ""? -> "] + charnolist( charnolist(nil ) ) + ["] )
QOut( "End test of CHARNOLIST()" )
QOut( "" )
ctexit()
RETURN

59
harbour/contrib/hbct/tests/charnot.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARNOT
* Test CT3 function CHARNOT
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,45 +52,40 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL ni, cStr
procedure main
ctinit()
local ni, cStr
QOut( "Begin test of CHARNOT()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
qout ("Begin test of CHARNOT()")
qout ("")
QOut( [ charnot(chr(85)+chr(128)+chr(170)+chr(1)) == ] )
QOut( [ chr(170)+chr(127)+chr(85)+chr(254) ? -->] )
// simple tests
qout ("Simple tests:")
QOut( [ ] )
cStr := charnot( Chr( 85 ) + Chr( 128 ) + Chr( 170 ) + Chr( 1 ) )
for ni := 1 TO Len( cStr )
QQOut( "chr(" + AllTrim( Str(Asc(SubStr(cStr, ni, 1 ) ) ) ) + ")" )
IF ni < Len( cStr )
QQOut( "+" )
ENDIF
next ni
QOut( "" )
qout ([ charnot (chr(85)+chr(128)+chr(170)+chr(1)) == ])
qout ([ chr(170)+chr(127)+chr(85)+chr(254) ? -->])
qout ([ ])
cStr := charnot (chr(85)+chr(128)+chr(170)+chr(1))
for ni := 1 to len (cStr)
qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")")
if ni < len(cStr)
qqout ("+")
endif
next ni
qout ("")
qout ([ charnot (charnot ("This is a test!")) == "This is a test!" ?])
qout ([ --> "]+ charnot (charnot ("This is a test!"))+["])
qout ("")
qout ("End test of CHARNOT()")
qout ("")
ctexit()
return
QOut( [ charnot(charnot("This is a test!")) == "This is a test!" ?] )
QOut( [ --> "] + charnot( charnot("This is a test!" ) ) + ["] )
QOut( "" )
QOut( "End test of CHARNOT()" )
QOut( "" )
ctexit()
RETURN

34
harbour/contrib/hbct/tests/charodd.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARODD()
* Test CT3 function CHARODD()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,23 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARODD()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charodd ("1A2B3C4D5E") == "12345" ? --> "] + charodd ("1A2B3C4D5E") + ["])
qout ([ charodd ("1A2B3C4D5") == "12345" ? --> "] + charodd ("1A2B3C4D5") + ["])
qout ("End test of CHARODD()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARODD()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charodd("1A2B3C4D5E") == "12345" ? --> "] + charodd( "1A2B3C4D5E" ) + ["] )
QOut( [ charodd("1A2B3C4D5") == "12345" ? --> "] + charodd( "1A2B3C4D5" ) + ["] )
QOut( "End test of CHARODD()" )
QOut( "" )
ctexit()
RETURN

42
harbour/contrib/hbct/tests/charone.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARONE()
* Test CT3 function CHARONE()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,33 +52,27 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARONE()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charone("112333a123") == "123a123"? --> "] + charone("112333a123") + ["])
qout ([ charone("122333a123") == "123a123"? --> "] + charone("122333a123") + ["])
qout ([ charone("A B CCCD") == "A B CD"? ---> "] + charone("A B CCCD") + ["])
qout ([ charone(" ", "A B A B") == "A B A B"? --> "] + charone(" ", "A B A B") + ["])
qout ([ charone("o", "122oooB12o") == "122oB12o"? -> "] + charone("o", "122oooB12o") + ["])
qout ("")
qout ("End test of CHARONE()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARONE()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charone("112333a123") == "123a123"? --> "] + charone( "112333a123" ) + ["] )
QOut( [ charone("122333a123") == "123a123"? --> "] + charone( "122333a123" ) + ["] )
QOut( [ charone("A B CCCD") == "A B CD"? ---> "] + charone( "A B CCCD" ) + ["] )
QOut( [ charone(" ", "A B A B") == "A B A B"? --> "] + charone( " ", "A B A B" ) + ["] )
QOut( [ charone("o", "122oooB12o") == "122oB12o"? -> "] + charone( "o", "122oooB12o" ) + ["] )
QOut( "" )
QOut( "End test of CHARONE()" )
QOut( "" )
ctexit()
RETURN

37
harbour/contrib/hbct/tests/charonly.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARONLY()
* Test CT3 function CHARONLY()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARONLY()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charonly("0123456789", "0211 - 38 99 77") == "0211389977" ? --> "] + charonly("0123456789", "0211 - 38 99 77")+ ["])
qout ([ charonly("0123456789", "0211/ 389 977") == "0211389977" ? --> "] + charonly("0123456789", "0211/ 389 977") + ["])
qout ("")
qout ("End test of CHARONLY()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARONLY()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charonly("0123456789", "0211 - 38 99 77") == "0211389977" ? --> "] + charonly( "0123456789", "0211 - 38 99 77" ) + ["] )
QOut( [ charonly("0123456789", "0211/ 389 977") == "0211389977" ? --> "] + charonly( "0123456789", "0211/ 389 977" ) + ["] )
QOut( "" )
QOut( "End test of CHARONLY()" )
QOut( "" )
ctexit()
RETURN

32
harbour/contrib/hbct/tests/charor.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHAROR()
* Test CT3 function CHAROR()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,28 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CHAROR()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
qout ("Begin test of CHAROR()")
qout ("")
QOut( [ charor("012345678", chr(1)) == "113355779" ? --> "] + charor( "012345678", Chr(1 ) ) + ["] )
QOut( [ charor("012345678", chr(1)+chr(3)) == "133357779" ? --> "] + charor( "012345678", Chr(1 ) + Chr(3 ) ) + ["] )
// simple tests
qout ("Simple tests:")
qout ([ charor ("012345678", chr(1)) == "113355779" ? --> "] + charor ("012345678", chr(1)) + ["])
qout ([ charor ("012345678", chr(1)+chr(3)) == "133357779" ? --> "] + charor ("012345678", chr(1)+chr(3)) + ["])
qout ("End test of CHAROR()")
qout ("")
ctexit()
return
QOut( "End test of CHAROR()" )
QOut( "" )
ctexit()
RETURN

37
harbour/contrib/hbct/tests/charrem.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARREM()
* Test CT3 function CHARREM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARREM()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charrem(" ", " 1 2 ") == "12" ? ---> "] + charrem(" ", " 1 2 ")+ ["])
qout ([ charrem("3y", "xyz123") == "xz12" ? ---> "] + charrem("3y", "xyz123")+ ["])
qout ("")
qout ("End test of CHARREM()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARREM()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charrem(" ", " 1 2 ") == "12" ? ---> "] + charrem( " ", " 1 2 " ) + ["] )
QOut( [ charrem("3y", "xyz123") == "xz12" ? ---> "] + charrem( "3y", "xyz123" ) + ["] )
QOut( "" )
QOut( "End test of CHARREM()" )
QOut( "" )
ctexit()
RETURN

43
harbour/contrib/hbct/tests/charrepl.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARREPL()
* Test CT3 function CHARREPL()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,34 +52,27 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARREPL()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charrepl ("1234", "1x2y3z", "abcd") == "axbycz" ? --> "] + charrepl ("1234", "1x2y3z", "abcd") + ["])
qout ([ charrepl ("abcdefghij", "jhfdb", "1234567890") == "08642" ? --> "] + charrepl ("abcdefghij", "jhfdb", "1234567890")+ ["])
qout ([ charrepl ("abcdefghij", "jhfdb", "12345") == "55542" ? --> "] + charrepl ("abcdefghij", "jhfdb", "12345") + ["])
qout ([ charrepl ("1234", "1234", "234A") == "AAAA" ? --> "] + charrepl ("1234", "1234", "234A") + ["])
qout ([ charrepl ("1234", "1234", "234A", .T.) == "234A" ? --> "] + charrepl ("1234", "1234", "234A", .T.) + ["])
qout ("")
qout ("End test of CHARREPL()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARREPL()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charrepl("1234", "1x2y3z", "abcd") == "axbycz" ? --> "] + charrepl( "1234", "1x2y3z", "abcd" ) + ["] )
QOut( [ charrepl("abcdefghij", "jhfdb", "1234567890") == "08642" ? --> "] + charrepl( "abcdefghij", "jhfdb", "1234567890" ) + ["] )
QOut( [ charrepl("abcdefghij", "jhfdb", "12345") == "55542" ? --> "] + charrepl( "abcdefghij", "jhfdb", "12345" ) + ["] )
QOut( [ charrepl("1234", "1234", "234A") == "AAAA" ? --> "] + charrepl( "1234", "1234", "234A" ) + ["] )
QOut( [ charrepl("1234", "1234", "234A", .T.) == "234A" ? --> "] + charrepl( "1234", "1234", "234A", .T. ) + ["] )
QOut( "" )
QOut( "End test of CHARREPL()" )
QOut( "" )
ctexit()
RETURN

58
harbour/contrib/hbct/tests/charrll.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARRLL()
* Test CT3 function CHARRLL()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,44 +52,36 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL ni, cStr
procedure main
ctinit()
local ni, cStr
QOut( "Begin test of CHARRLL()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
QOut( [ charrll(chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+] )
QOut( [ chr(64)+chr(128), 3) == ] )
QOut( [ chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4) ? -->] )
qout ("Begin test of CHARRLL()")
qout ("")
QOut( [ ] )
cStr := charrll( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
for ni := 1 TO Len( cStr )
QQOut( "chr(" + AllTrim( Str(Asc(SubStr(cStr, ni, 1 ) ) ) ) + ")" )
IF ni < Len( cStr )
QQOut( "+" )
ENDIF
next ni
QOut( "" )
// simple tests
qout ("Simple tests:")
qout ([ charrll (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+])
qout ([ chr(64)+chr(128), 3) == ])
qout ([ chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4) ? -->])
qout ([ ])
cStr := charrll (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3)
for ni := 1 to len (cStr)
qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")")
if ni < len(cStr)
qqout ("+")
endif
next ni
qout ("")
qout ("End test of CHARRLL()")
qout ("")
ctexit()
return
QOut( "End test of CHARRLL()" )
QOut( "" )
ctexit()
RETURN

55
harbour/contrib/hbct/tests/charrlr.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARRLR()
* Test CT3 function CHARRLR()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,41 +52,36 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL ni, cStr
procedure main
ctinit()
local ni, cStr
QOut( "Begin test of CHARRLR()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
QOut( [ charrlr(chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+] )
QOut( [ chr(64)+chr(128), 3) == ] )
QOut( [ chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) ? -->] )
qout ("Begin test of CHARRLR()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charrlr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+])
qout ([ chr(64)+chr(128), 3) == ])
qout ([ chr(32)+chr(64)+chr(128)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) ? -->])
qout ([ ])
cStr := charrlr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3)
for ni := 1 to len (cStr)
qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")")
if ni < len(cStr)
qqout ("+")
endif
next ni
qout ("")
qout ("End test of CHARRLR()")
qout ("")
ctexit()
return
QOut( [ ] )
cStr := charrlr( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
for ni := 1 TO Len( cStr )
QQOut( "chr(" + AllTrim( Str(Asc(SubStr(cStr, ni, 1 ) ) ) ) + ")" )
IF ni < Len( cStr )
QQOut( "+" )
ENDIF
next ni
QOut( "" )
QOut( "End test of CHARRLR()" )
QOut( "" )
ctexit()
RETURN

58
harbour/contrib/hbct/tests/charshl.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARSHL()
* Test CT3 function CHARSHL()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,44 +52,36 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL ni, cStr
procedure main
local ni, cStr
ctinit()
qout ("Begin test of CHARSHL()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charshl (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+])
qout ([ chr(64)+chr(128), 3) == ])
qout ([ chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(0)+chr(0)+chr(0) ? -->])
qout ([ ])
cStr := charshl (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3)
for ni := 1 to len (cStr)
qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")")
if ni < len(cStr)
qqout ("+")
endif
next ni
qout ("")
qout ("End test of CHARSHL()")
qout ("")
ctexit()
return
ctinit()
QOut( "Begin test of CHARSHL()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charshl(chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+] )
QOut( [ chr(64)+chr(128), 3) == ] )
QOut( [ chr(8)+chr(16)+chr(32)+chr(64)+chr(128)+chr(0)+chr(0)+chr(0) ? -->] )
QOut( [ ] )
cStr := charshl( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
for ni := 1 TO Len( cStr )
QQOut( "chr(" + AllTrim( Str(Asc(SubStr(cStr, ni, 1 ) ) ) ) + ")" )
IF ni < Len( cStr )
QQOut( "+" )
ENDIF
next ni
QOut( "" )
QOut( "End test of CHARSHL()" )
QOut( "" )
ctexit()
RETURN

59
harbour/contrib/hbct/tests/charshr.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARSHR()
* Test CT3 function CHARSHR()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,45 +52,36 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL ni, cStr
procedure main
ctinit()
local ni, cStr
QOut( "Begin test of CHARSHR()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
QOut( [ charshr(chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+] )
QOut( [ chr(64)+chr(128), 3) == ] )
QOut( [ chr(0)+chr(0)+chr(0)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) ? -->] )
qout ("Begin test of CHARSHR()")
qout ("")
QOut( [ ] )
cStr := charshr( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
for ni := 1 TO Len( cStr )
QQOut( "chr(" + AllTrim( Str(Asc(SubStr(cStr, ni, 1 ) ) ) ) + ")" )
IF ni < Len( cStr )
QQOut( "+" )
ENDIF
next ni
QOut( "" )
// simple tests
qout ("Simple tests:")
qout ([ charshr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+])
qout ([ chr(64)+chr(128), 3) == ])
qout ([ chr(0)+chr(0)+chr(0)+chr(1)+chr(2)+chr(4)+chr(8)+chr(16) ? -->])
qout ([ ])
cStr := charshr (chr(1)+chr(2)+chr(4)+chr(8)+chr(16)+chr(32)+chr(64)+chr(128), 3)
for ni := 1 to len (cStr)
qqout ("chr("+alltrim(str(asc(substr(cStr, ni, 1))))+")")
if ni < len(cStr)
qqout ("+")
endif
next ni
qout ("")
qout ("End test of CHARSHR()")
qout ("")
ctexit()
return
QOut( "End test of CHARSHR()" )
QOut( "" )
ctexit()
RETURN

34
harbour/contrib/hbct/tests/charslst.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARSLIST()
* Test CT3 function CHARSLIST()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,23 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARSLIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charslist ("Hello World !") == " !HWdelor" ? -> "] + charslist ("Hello World !") + ["])
qout ([ charslist (nil) == "" ? -> "] + charslist (nil) + ["])
qout ("End test of CHARSLIST()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARSLIST()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charslist("Hello World !") == " !HWdelor" ? -> "] + charslist( "Hello World !" ) + ["] )
QOut( [ charslist(nil) == "" ? -> "] + charslist( nil ) + ["] )
QOut( "End test of CHARSLIST()" )
QOut( "" )
ctexit()
RETURN

51
harbour/contrib/hbct/tests/charsort.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARSORT()
* Test CT3 function CHARSORT()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,38 +52,31 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARSORT()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charsort("qwert") == "eqrtw" ? --> "] + charsort("qwert") + ["])
qout ([ charsort("qwert", 2) == "erqwt" ? --> "] + charsort("qwert", 2) + ["])
qout ([ charsort("b1a4a3a2a1", 2, 1) == "a2a1a3a4b1" ? --> "] + charsort("b1a4a3a2a1", 2, 1) + ["])
qout ([ NOTE : The order of equal elements (here the one beginning with the same char) is NOT determined !])
qout ([ charsort("XXXqwert", 1, 1, 3) == "XXXeqrtw" ? --> "] + charsort("XXXqwert", 1, 1, 3) + ["])
qout ([ charsort("b1a4a3a2a1", 2, 1, 0, 1) == "a1b1a2a3a4" ? --> "] + charsort("b1a4a3a2a1", 2, 1, 0, 1) + ["])
qout ([ NOTE : The order of equal elements (here the one ending with the same number) is NOT determined !])
qout ([ charsort("384172852", 1, 1, 0, 0, 4) == "134872852" ? --> "] + charsort("384172852", 1, 1, 0, 0, 4)+ ["])
qout ([ charsort("qwert",,,,,,.T.) == "wtrqe" ? --> "] + charsort("qwert",,,,,,.T.) + ["])
qout ("")
qout ("End test of CHARSORT()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARSORT()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charsort("qwert") == "eqrtw" ? --> "] + charsort( "qwert" ) + ["] )
QOut( [ charsort("qwert", 2) == "erqwt" ? --> "] + charsort( "qwert", 2 ) + ["] )
QOut( [ charsort("b1a4a3a2a1", 2, 1) == "a2a1a3a4b1" ? --> "] + charsort( "b1a4a3a2a1", 2, 1 ) + ["] )
QOut( [ NOTE : The order of equal elements(here the one beginning with the same char) is NOT determined !] )
QOut( [ charsort("XXXqwert", 1, 1, 3) == "XXXeqrtw" ? --> "] + charsort( "XXXqwert", 1, 1, 3 ) + ["] )
QOut( [ charsort("b1a4a3a2a1", 2, 1, 0, 1) == "a1b1a2a3a4" ? --> "] + charsort( "b1a4a3a2a1", 2, 1, 0, 1 ) + ["] )
QOut( [ NOTE : The order of equal elements(here the one ending with the same number) is NOT determined !] )
QOut( [ charsort("384172852", 1, 1, 0, 0, 4) == "134872852" ? --> "] + charsort( "384172852", 1, 1, 0, 0, 4 ) + ["] )
QOut( [ charsort("qwert",,,,,,.T.) == "wtrqe" ? --> "] + charsort( "qwert",,,,,, .T. ) + ["] )
QOut( "" )
QOut( "End test of CHARSORT()" )
QOut( "" )
ctexit()
RETURN

36
harbour/contrib/hbct/tests/charsub.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARSUB()
* Test CT3 function CHARSUB()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,25 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CHARSUB()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
QOut( [ charadd("123456789", chr(1)) == "012345678" ? -> "] + charsub( "123456789", Chr(1 ) ) + ["] )
QOut( [ charadd("123456789", chr(1)+chr(2)) == "002244668" ? -> "] + charsub( "123456789", Chr(1 ) + Chr(2 ) ) + ["] )
QOut( [ charadd("012345678", chr(255)) == "123456789" ? -> "] + charsub( "012345678", Chr(255 ) ) + ["] )
QOut( [ charadd("012345678", chr(255)+chr(254)) == "133557799" ? -> "] + charsub( "012345678", Chr(255 ) + Chr(254 ) ) + ["] )
qout ("Begin test of CHARSUB()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charadd ("123456789", chr(1)) == "012345678" ? -> "] + charsub ("123456789", chr(1)) + ["])
qout ([ charadd ("123456789", chr(1)+chr(2)) == "002244668" ? -> "] + charsub ("123456789", chr(1)+chr(2)) + ["])
qout ([ charadd ("012345678", chr(255)) == "123456789" ? -> "] + charsub ("012345678", chr(255)) + ["])
qout ([ charadd ("012345678", chr(255)+chr(254)) == "133557799" ? -> "] + charsub ("012345678", chr(255)+chr(254)) + ["])
qout ("End test of CHARSUB()")
qout ("")
ctexit()
return
QOut( "End test of CHARSUB()" )
QOut( "" )
ctexit()
RETURN

37
harbour/contrib/hbct/tests/charswap.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARSWAP()
* Test CT3 function CHARSWAP()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of CHARSWAP()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charswap("0123456789") == "1032547698" ? --> "] + charswap("0123456789") + ["])
qout ([ charswap("ABCDEFGHIJK") == "BADCFEHGJIK" ? --> "] + charswap("ABCDEFGHIJK")+ ["])
qout ("")
qout ("End test of CHARSWAP()")
qout ("")
ctexit()
return
QOut( "Begin test of CHARSWAP()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ charswap("0123456789") == "1032547698" ? --> "] + charswap( "0123456789" ) + ["] )
QOut( [ charswap("ABCDEFGHIJK") == "BADCFEHGJIK" ? --> "] + charswap( "ABCDEFGHIJK" ) + ["] )
QOut( "" )
QOut( "End test of CHARSWAP()" )
QOut( "" )
ctexit()
RETURN

35
harbour/contrib/hbct/tests/charxor.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CHARXOR()
* Test CT3 function CHARXOR()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,29 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CHARXOR()" )
QOut( "" )
ctinit()
qout ("Begin test of CHARXOR()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charxor (charxor ("This is top secret !", "My Password"),])
qout ([ "My Password") == "This is top secret !" ? ->])
qout ([ ]+charxor (charxor ("This is top secret !", "My Password"),"My Password"))
qout ("End test of CHARXOR()")
qout ("")
ctexit()
return
// simple tests
QOut( "Simple tests:" )
QOut( [ charxor(charxor("This is top secret !", "My Password"),] )
QOut( [ "My Password") == "This is top secret !" ? ->] )
QOut( [ ] + charxor( charxor("This is top secret !", "My Password" ),"My Password" ) )
QOut( "End test of CHARXOR()" )
QOut( "" )
ctexit()
RETURN

398
harbour/contrib/hbct/tests/csetarge.prg
View File

@@ -53,246 +53,244 @@
*/
#include "../ct.ch"
#include "ct.ch"
PROCEDURE main
procedure main
LOCAL cRet, olderr
local cRet, olderr
ctinit()
ctinit()
QOut( "Begin test of CSETARGERR()" )
QOut( "" )
qout ("Begin test of CSETARGERR()")
qout ("")
QOut( "" )
QOut( "Local error handler: " )
qout ("")
qout ("Local error handler: ")
olderr := ErrorBlock( { | oerr | myerrhandler( oerr ) } )
olderr := errorblock ({|oerr|myerrhandler(oerr)})
// standard behaviour on argument error
QOut( "" )
QOut( "Standard behaviour" )
QOut( " Call to addascii(5789676,1,2,.T.):" )
cRet := addascii( 5789676, 1, 2, .T. )
QOut( " return value was", cRet )
QOut( "" )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// standard behaviour on argument error
qout ("")
qout ("Standard behaviour")
qout (" Call to addascii (5789676,1,2,.T.):")
cRet := addascii (5789676,1,2,.T.)
qout (" return value was", cRet)
qout ("")
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_WHOCARES on argument error
QOut( "" )
QOut( "CT_ARGERR_WHOCARES behaviour" )
CSETARGERR( CT_ARGERR_WHOCARES )
QOut( " Call to addascii(5789676,1,2,.T.):" )
cRet := addascii( 5789676, 1, 2, .T. )
QOut( " return value was", cRet )
QOut( "" )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_WHOCARES on argument error
qout ("")
qout ("CT_ARGERR_WHOCARES behaviour")
CSETARGERR (CT_ARGERR_WHOCARES)
qout (" Call to addascii (5789676,1,2,.T.):")
cRet := addascii (5789676,1,2,.T.)
qout (" return value was", cRet)
qout ("")
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_WARNING on argument error
QOut( "" )
QOut( "CT_ARGERR_WARNING behaviour" )
CSETARGERR( CT_ARGERR_WARNING )
QOut( " Call to addascii(5789676,1,2,.T.):" )
cRet := addascii( 5789676, 1, 2, .T. )
QOut( " return value was", cRet )
QOut( "" )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_WARNING on argument error
qout ("")
qout ("CT_ARGERR_WARNING behaviour")
CSETARGERR (CT_ARGERR_WARNING)
qout (" Call to addascii (5789676,1,2,.T.):")
cRet := addascii (5789676,1,2,.T.)
qout (" return value was", cRet)
qout ("")
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_ERROR on argument error
QOut( "" )
QOut( "CT_ARGERR_ERROR behaviour" )
CSETARGERR( CT_ARGERR_ERROR )
QOut( " Call to addascii(5789676,1,2,.T.):" )
cRet := addascii( 5789676, 1, 2, .T. )
QOut( " return value was", cRet )
QOut( "" )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_ERROR on argument error
qout ("")
qout ("CT_ARGERR_ERROR behaviour")
CSETARGERR (CT_ARGERR_ERROR)
qout (" Call to addascii (5789676,1,2,.T.):")
cRet := addascii (5789676,1,2,.T.)
qout (" return value was", cRet)
qout ("")
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_CATASTROPHIC on argument error
QOut( "" )
QOut( "CT_ARGERR_CATASTROPHIC behaviour" )
CSETARGERR( CT_ARGERR_CATASTROPHIC )
QOut( " Call to addascii(5789676,1,2,.T.):" )
cRet := addascii( 5789676, 1, 2, .T. )
QOut( " return value was", cRet )
QOut( "" )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_CATASTROPHIC on argument error
qout ("")
qout ("CT_ARGERR_CATASTROPHIC behaviour")
CSETARGERR (CT_ARGERR_CATASTROPHIC)
qout (" Call to addascii (5789676,1,2,.T.):")
cRet := addascii (5789676,1,2,.T.)
qout (" return value was", cRet)
qout ("")
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
QOut( "" )
QOut( "Standard error handler: " )
ErrorBlock( olderr )
qout ("")
qout ("Standard error handler: ")
errorblock (olderr)
// standard behaviour on argument error
QOut( "" )
QOut( "Standard behaviour" )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// standard behaviour on argument error
qout ("")
qout ("Standard behaviour")
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_WHOCARES on argument error
QOut( "" )
QOut( "CT_ARGERR_WHOCARES behaviour" )
CSETARGERR( CT_ARGERR_WHOCARES )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_WHOCARES on argument error
qout ("")
qout ("CT_ARGERR_WHOCARES behaviour")
CSETARGERR (CT_ARGERR_WHOCARES)
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_WARNING on argument error
QOut( "" )
QOut( "CT_ARGERR_WARNING behaviour" )
CSETARGERR( CT_ARGERR_WARNING )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_WARNING on argument error
qout ("")
qout ("CT_ARGERR_WARNING behaviour")
CSETARGERR (CT_ARGERR_WARNING)
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_ERROR on argument error
QOut( "" )
QOut( "CT_ARGERR_ERROR behaviour" )
CSETARGERR( CT_ARGERR_ERROR )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_ERROR on argument error
qout ("")
qout ("CT_ARGERR_ERROR behaviour")
CSETARGERR (CT_ARGERR_ERROR)
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
// CT_ARGERR_CATASTROPHIC on argument error
QOut( "" )
QOut( "CT_ARGERR_CATASTROPHIC behaviour" )
CSETARGERR( CT_ARGERR_CATASTROPHIC )
QOut( " Call to charadd('AA',.F.):" )
cRet := charadd( "AA", .F. )
QOut( " return value was", cRet, "<Press any key>" )
QOut( "" )
Inkey( 0 )
// CT_ARGERR_CATASTROPHIC on argument error
qout ("")
qout ("CT_ARGERR_CATASTROPHIC behaviour")
CSETARGERR (CT_ARGERR_CATASTROPHIC)
qout (" Call to charadd ('AA',.F.):")
cRet := charadd ("AA",.F.)
qout (" return value was", cRet, "<Press any key>")
qout ("")
inkey (0)
QOut( "End test of CSETARGERR()" )
qout ("End test of CSETARGERR()")
ctexit()
ctexit()
RETURN
return
FUNCTION myerrhandler( oerr )
LOCAL ni, nDigit
function myerrhandler (oerr)
MEMVAR INPUT
local ni, nDigit
QOut( " Error handler called:" )
QOut( " err:severity.....:", oerr:severity )
QOut( " err:subSystem....:", oerr:subSystem )
QOut( " err:operation....:", oerr:operation )
QOut( " len(err:args)....:", Len( oerr:args ) )
FOR ni := 1 TO Len( oerr:args )
QOut( " err:args[" + hb_ntos( ni ) + "]..:", oerr:args[ni] )
NEXT
QOut( " err:genCode......:", oerr:genCode )
QOut( " err:subCode......:", oerr:subCode )
QOut( " err:osCode.......:", oerr:osCode )
QOut( " err:filename.....:", oerr:filename )
QOut( " err:tries........:", oerr:tries )
QOut( " err:cargo........:", oerr:cargo )
QOut( " err:canDefault...:", oerr:canDefault )
QOut( " err:canRetry.....:", oerr:canRetry )
QOut( " err:canSubstitute:", oerr:canSubstitute )
QOut()
memvar Input
IF oerr:canSubstitute
qout (" Error handler called:")
qout (" err:severity.....:",oerr:severity)
qout (" err:subSystem....:",oerr:subSystem)
qout (" err:operation....:",oerr:operation)
qout (" len(err:args)....:",len(oerr:args))
for ni := 1 to len (oerr:args)
qout (" err:args["+alltrim(str(ni))+"]..:",oerr:args[ni])
next ni
qout (" err:genCode......:",oerr:genCode)
qout (" err:subCode......:",oerr:subCode)
qout (" err:osCode.......:",oerr:osCode)
qout (" err:filename.....:",oerr:filename)
qout (" err:tries........:",oerr:tries)
qout (" err:cargo........:",oerr:cargo)
qout (" err:canDefault...:",oerr:canDefault)
qout (" err:canRetry.....:",oerr:canRetry)
qout (" err:canSubstitute:",oerr:canSubstitute)
qout()
PRIVATE Input := ""
if oerr:canSubstitute
QOut( " Error handler can substitute return value, so please" )
ACCEPT " type in return value <Return for default>: " TO Input
private Input := ""
IF Empty( Input )
QOut( " You have chosen the default return value. Ok, this should " )
QOut( " be now problem, since the last digit of err:subCode indicates" )
QOut( " the type of the return value:" )
QOut( " 0 is NIL, 1 is String, 2 is Integer," )
QOut( " 3 is Float, 4 is Boolean, 5 is Date" )
QOut( " 6 is Block, 7 is Array, 8 is Object" )
QOut( " 9 is unknown" )
nDigit := Int( oerr:subCode % 10 )
QOut( " Here it's a " + AllTrim( Str(nDigit ) ) + ", so I return a " )
DO CASE
CASE nDigit == 0
QQOut( "NIL." )
Input := NIL
qout (" Error handler can substitute return value, so please")
ACCEPT " type in return value <Return for default>: " TO Input
CASE nDigit == 1
QQOut( "String." )
Input := ""
if empty (Input)
qout (" You have chosen the default return value. Ok, this should ")
qout (" be now problem, since the last digit of err:subCode indicates")
qout (" the type of the return value:")
qout (" 0 is NIL, 1 is String, 2 is Integer,")
qout (" 3 is Float, 4 is Boolean, 5 is Date")
qout (" 6 is Block, 7 is Array, 8 is Object")
qout (" 9 is unknown")
nDigit := int (oerr:subCode%10)
qout (" Here it's a "+alltrim(str(nDigit))+", so I return a ")
do case
case nDigit == 0
qqout ("NIL.")
Input := NIL
CASE nDigit == 2
QQOut( "Integer." )
Input := 0
case nDigit == 1
qqout ("String.")
Input := ""
CASE nDigit == 3
QQOut( "Float." )
Input := 0.0
case nDigit == 2
qqout ("Integer.")
Input := 0
CASE nDigit == 4
QQOut( "Boolean." )
Input := .F.
case nDigit == 3
qqout ("Float.")
Input := 0.0
CASE nDigit == 5
QQOut( "Date." )
Input := CToD( "" )
case nDigit == 4
qqout ("Boolean.")
Input := .F.
CASE nDigit == 6
QQOut( "Block." )
Input := { ||NIL }
case nDigit == 5
qqout ("Date.")
Input := ctod ("")
CASE nDigit == 7
QQOut( "Array." )
Input := {}
case nDigit == 6
qqout ("Block.")
Input := {||NIL}
CASE nDigit == 8
QQOut( "Object." )
Input := GetNew()
case nDigit == 7
qqout ("Array.")
Input := {}
CASE nDigit == 9
QQOut( "<don't know, NIL would be best." )
Input := NIL
case nDigit == 8
qqout ("Object.")
Input := GetNew()
ENDCASE
case nDigit == 9
qqout ("<don't know, NIL would be best.")
Input := NIL
ENDIF
endcase
RETURN INPUT
endif
ENDIF
return Input
IF oerr:canDefault
QOut( " Subsystem can set the default value itself, so this error" )
QOut( " is only informative." )
ENDIF
endif
if oerr:canDefault
qout (" Subsystem can set the default value itself, so this error")
qout (" is only informative.")
endif
return .F.
RETURN .F.

28
harbour/contrib/hbct/tests/csetatmu.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CSETATMUPA()
* Test CT3 function CSETATMUPA()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,22 +52,20 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CSETATMUPA()" )
QOut( " Default switch should be .F., is..................................", csetatmupa() )
QOut( " Setting switch to .T., return value should be .F., is.............", csetatmupa( .T. ) )
QOut( " Switch setting should now be .T., is..............................", csetatmupa() )
QOut( " Setting switch to .F. again, return value should still be .T., is ", csetatmupa( .F. ) )
QOut( "End test of CSETATMUPA()" )
QOut( "" )
ctinit()
ctexit()
qout ("Begin test of CSETATMUPA()")
qout (" Default switch should be .F., is..................................", csetatmupa())
qout (" Setting switch to .T., return value should be .F., is.............", csetatmupa (.T.))
qout (" Switch setting should now be .T., is..............................", csetatmupa())
qout (" Setting switch to .F. again, return value should still be .T., is ", csetatmupa (.F.))
qout ("End test of CSETATMUPA()")
qout ("")
ctexit()
return
RETURN

28
harbour/contrib/hbct/tests/csetref.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function CSETREF()
* Test CT3 function CSETREF()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,22 +52,20 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of CSETREF()" )
QOut( " Default switch should be .F., is..................................", csetref() )
QOut( " Setting switch to .T., return value should be .F., is.............", csetref( .T. ) )
QOut( " Switch setting should now be .T., is..............................", csetref() )
QOut( " Setting switch to .F. again, return value should still be .T., is ", csetref( .F. ) )
QOut( "End test of CSETREF()" )
QOut( "" )
ctinit()
ctexit()
qout ("Begin test of CSETREF()")
qout (" Default switch should be .F., is..................................", csetref())
qout (" Setting switch to .T., return value should be .F., is.............", csetref (.T.))
qout (" Switch setting should now be .T., is..............................", csetref())
qout (" Setting switch to .F. again, return value should still be .T., is ", csetref (.F.))
qout ("End test of CSETREF()")
qout ("")
ctexit()
return
RETURN

188
harbour/contrib/hbct/tests/ctwtest.prg
View File

@@ -10,105 +10,109 @@
* Donated to the public domain on 2006-02-11 by Przemyslaw Czerpak
*/
#define ntrim(n) ltrim(str(n))
#include "inkey.ch"
#include "setcurs.ch"
proc main()
local aWin:=array(9), y, x, i, k, lFlag:=.f., lBoard:=.t.
PROCEDURE Main()
setblink(.f.)
wboard(5,5,20,75)
wmode(.t.,.t.,.t.,.t.)
wsetshadow(7)
setclearA(10*16+14)
setclearB(35)
dispbox(0,0,maxrow(),maxcol(),repl("#",9),ntocolor(10*16+14))
setpos(0,0)
? "GT driver: "+ HB_GTVERSION()
? HB_GTVERSION(1)
?
? "ESC - quit "
? "0 - select window 0 (base screen) "
? "1-9 select window 1-9 "
? "C - close window "
? "Q - clear screen "
? "P - print text at window 0 "
? "B - board switch "
? "INS - cursor shape "
? "DEL - hide cursor "
? "arrows - window move "
LOCAL aWin := Array( 9 ), y, x, i, k, lFlag := .F. , lBoard := .T.
setclearB(61)
for i:=1 to len(aWin)
y:=i+2
x:=i*4+10
setcolor(ntocolor(i*16+15)+",W+/B*")
wsetshadow(i%8)
aWin[i]:=wopen(y,x,y+10,x+20)
wbox()
SetBlink( .F. )
wboard( 5, 5, 20, 75 )
wmode( .T. , .T. , .T. , .T. )
wsetshadow( 7 )
setclearA( 10 * 16 + 14 )
setclearB( 35 )
DispBox( 0, 0, MaxRow(), MaxCol(), repl( "#",9 ), ntocolor( 10 * 16 + 14 ) )
SetPos( 0, 0 )
? "GT driver: " + hb_gtVersion()
? hb_gtVersion( 1 )
?
? "ESC - quit "
? "0 - select window 0 (base screen) "
? "1-9 select window 1-9 "
? "C - close window "
? "Q - clear screen "
? "P - print text at window 0 "
? "B - board switch "
? "INS - cursor shape "
? "DEL - hide cursor "
? "arrows - window move "
@ -1,0 say "TITLE "+ntrim(aWin[i])
? ntrim(row())+":"+ntrim(col()),"/",ntrim(maxrow())+":"+ntrim(maxcol()),""
? ntrim(wrow())+":"+ntrim(wcol()),"/",ntrim(maxrow(.t.))+":"+ntrim(maxcol(.t.)),""
? ntrim(wfrow())+":"+ntrim(wfcol()),"/",;
ntrim(wflastrow())+":"+ntrim(wflastcol()),""
? ntrim(wfrow(.t.))+":"+ntrim(wfcol(.t.)),"/",;
ntrim(wflastrow(.t.))+":"+ntrim(wflastcol(.t.)),""
? "window:",ntrim(aWin[i]),""
setcursor(int(i%5))
setclearB( 61 )
for i := 1 TO Len( aWin )
y := i + 2
x := i * 4 + 10
SetColor( ntocolor( i * 16 + 15 ) + ",W+/B*" )
wsetshadow( i % 8 )
aWin[i] := wopen( y, x, y + 10, x + 20 )
wbox()
next
@ - 1, 0 SAY "TITLE " + hb_ntos( aWin[i] )
? hb_ntos( Row() ) + ":" + hb_ntos( Col() ), "/", hb_ntos( MaxRow() ) + ":" + hb_ntos( MaxCol() ), ""
? hb_ntos( wrow() ) + ":" + hb_ntos( wcol() ), "/", hb_ntos( MaxRow( .T. ) ) + ":" + hb_ntos( MaxCol( .T. ) ), ""
? hb_ntos( wfrow() ) + ":" + hb_ntos( wfcol() ), "/", ;
hb_ntos( wflastrow() ) + ":" + hb_ntos( wflastcol() ), ""
? hb_ntos( wfrow( .T. ) ) + ":" + hb_ntos( wfcol( .T. ) ), "/", ;
hb_ntos( wflastrow( .T. ) ) + ":" + hb_ntos( wflastcol( .T. ) ), ""
? "window:", hb_ntos( aWin[i] ), ""
SetCursor( Int( i % 5 ) )
next
dspcord()
while .t.
k:=inkey(0, INKEY_ALL)
if k == K_ESC
exit
elseif k>=asc("1") .and. k<=asc("9")
wselect(aWin[k-asc("0")])
elseif k==asc("0")
wselect(0)
elseif k==asc("C") .or. k==asc("c")
wclose()
elseif k==asc("Q") .or. k==asc("q")
clear screen
elseif k==asc("B") .or. k==asc("b")
if lBoard
wboard(0,0,maxrow(.t.)-1,maxcol(.t.))
else
wboard(5,5,20,75)
endif
lBoard:=!lBoard
elseif k==asc("P") .or. k==asc("P")
y:=wfrow()
x:=wfcol()
i:=wselect()
wselect(0)
@ y,x say "THIS IS WINDOW 0 OUTPUT"
wselect(i)
elseif k==K_INS
lFlag:=!lFlag
setcursor(iif(lFlag,3,1))
elseif k==K_DEL
setcursor(SC_NONE)
elseif k==K_LEFT
wmove(wrow(),wcol()-1)
elseif k==K_RIGHT
wmove(wrow(),wcol()+1)
elseif k==K_UP
wmove(wrow()-1,wcol())
elseif k==K_DOWN
wmove(wrow()+1,wcol())
endif
dspcord()
enddo
return
WHILE .T.
k := Inkey( 0, INKEY_ALL )
IF k == K_ESC
EXIT
ELSEIF k >= Asc( "1" ) .AND. k <= Asc( "9" )
wselect( aWin[k-asc("0")] )
ELSEIF k == Asc( "0" )
wselect( 0 )
ELSEIF k == Asc( "C" ) .OR. k == Asc( "c" )
wclose()
ELSEIF k == Asc( "Q" ) .OR. k == Asc( "q" )
CLEAR SCREEN
ELSEIF k == Asc( "B" ) .OR. k == Asc( "b" )
IF lBoard
wboard( 0, 0, MaxRow( .T. ) - 1, MaxCol( .T. ) )
ELSE
wboard( 5, 5, 20, 75 )
ENDIF
lBoard := !lBoard
ELSEIF k == Asc( "P" ) .OR. k == Asc( "P" )
y := wfrow()
x := wfcol()
i := wselect()
wselect( 0 )
@ y, x SAY "THIS IS WINDOW 0 OUTPUT"
wselect( i )
ELSEIF k == K_INS
lFlag := !lFlag
SetCursor( iif( lFlag,3,1 ) )
ELSEIF k == K_DEL
SetCursor( SC_NONE )
ELSEIF k == K_LEFT
wmove( wrow(), wcol() - 1 )
ELSEIF k == K_RIGHT
wmove( wrow(), wcol() + 1 )
ELSEIF k == K_UP
wmove( wrow() - 1, wcol() )
ELSEIF k == K_DOWN
wmove( wrow() + 1, wcol() )
ENDIF
dspcord()
ENDDO
static proc dspcord()
local mr:=mrow(), mc:=mcol(), r:=wrow(), c:=wcol(), w:=wselect()
wselect(0)
@ maxrow(), 0 say padr("WPOS("+ltrim(str(r))+","+ltrim(str(c))+")"+;
iif(MPresent(), "MPOS("+ltrim(str(mr))+","+ltrim(str(mc))+")", ""), maxcol()+1)
wselect(w)
return
RETURN
STATIC PROC dspcord()
LOCAL mr := MRow(), mc := MCol(), r := wrow(), c := wcol(), w := wselect()
wselect( 0 )
@ MaxRow(), 0 SAY PadR( "WPOS(" + LTrim( Str(r ) ) + "," + LTrim( Str(c ) ) + ")" + ;
iif( MPresent(), "MPOS(" + LTrim( Str(mr ) ) + "," + LTrim( Str(mc ) ) + ")", "" ), MaxCol() + 1 )
wselect( w )
RETURN

2201
harbour/contrib/hbct/tests/datetime.prg
View File

File diff suppressed because it is too large Load Diff

23
harbour/contrib/hbct/tests/expomant.prg
View File

@@ -52,27 +52,26 @@
*
*/
PROCEDURE Main()
PROCEDURE MAIN
local n
LOCAL n
CTINIT()
SET DECIMALS TO 15
for n := 1 to 1000
outstd (str(n,20,15)+": "+str(mantissa(n),20,15)+" "+str(exponent(n),4) + hb_eol())
outstd (str(sqrt(n),20,15)+": "+str(mantissa(sqrt(n)),20,15)+" "+str(exponent(sqrt(n)),4) + hb_eol())
for n := 1 TO 1000
OutStd( Str( n,20,15 ) + ": " + Str( mantissa(n ),20,15 ) + " " + Str( exponent(n ),4 ) + hb_eol() )
OutStd( Str( Sqrt(n ),20,15 ) + ": " + Str( mantissa(Sqrt(n ) ),20,15 ) + " " + Str( exponent(Sqrt(n ) ),4 ) + hb_eol() )
next n
// The call to str( infinity(.t.) ), generate a GPF.
// outstd (str(infinity(.t.))+str(mantissa( infinity(.t.) ))+str(exponent( infinity(.t.) )))
// outstd (str(infinity(.t.)) )
// The call to str( infinity(.t.) ), generate a GPF.
// outstd(str(infinity(.t.))+str(mantissa( infinity(.t.) ))+str(exponent( infinity(.t.) )))
// outstd(str(infinity(.t.)) )
outstd (" infinity(.t.): "+str(mantissa(infinity(.t.)),20,15)+" ")
outstd (str(exponent(infinity(.t.)),4)+hb_eol())
OutStd( " infinity(.t.): " + Str( mantissa(infinity( .T. ) ),20,15 ) + " " )
OutStd( Str( exponent(infinity( .T. ) ),4 ) + hb_eol() )
CTEXIT()
RETURN
RETURN

89
harbour/contrib/hbct/tests/finan.prg
View File

@@ -10,11 +10,7 @@
* - PAYMENT
* - PERIODS
* - RATE
*
* NOTE: All these functions were builded using Borland C++ 5.5 (free version)
*
* Copyright 2001 Alejandro de Garate <alex_degarate@hotmail.com>
*
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -58,54 +54,53 @@
*
*/
PROCEDURE Main()
PROCEDURE MAIN
CTINIT()
CTINIT()
SET DECIMAL TO 3
CLS
?? "Testing Financial functions...."
?
? "Calculate how loan summs if you make deposits for $175.00 for 24 months,"
? "if the annual rate of the Bank for this mortage is 9.5% fixed"
? "PV( 175, 0.095/12, 24 ) = 3811.433 // CT3"
? Space( 19 ), PV( 175, 0.095/12, 24 ), " <-- CT for Harbour"
?
?
SET DECIMAL TO 3
CLS
?? "Testing Financial functions...."
?
? "Calculate how loan summs if you make deposits for $175.00 for 24 months,"
? "if the annual rate of the Bank for this mortage is 9.5% fixed"
? "PV( 175, 0.095/12, 24 ) = 3811.433 // CT3"
? SPACE(19), PV( 175, 0.095/12, 24 ), " <-- CT for Harbour"
?
?
? "Calculate the amount in your account after 3 years, if you make deposits"
? "for $150.00 per month, and the annual rate of the Bank for this is 6%"
? "Capital = FV( 150, 0.06/12, 36 ) = 5900.416 // CT3"
? Space( 28 ), FV( 150, 0.06/12, 36 ), " <-- CT for Harbour"
?
?
? "Calculate the amount in your account after 3 years, if you make deposits"
? "for $150.00 per month, and the annual rate of the Bank for this is 6%"
? "Capital = FV( 150, 0.06/12, 36 ) = 5900.416 // CT3"
? SPACE(28), FV( 150, 0.06/12, 36 ), " <-- CT for Harbour"
?
?
? "Calculate the monthly payment for a loan of $2000.00 at an annual rate"
? "of 10%, within 24 month "
? "PAYMENT( 2000.00, 0.10/12, 24 ) = 92.290 // CT3"
? Space( 26 ), PAYMENT( 2000.00, 0.10/12, 24 ), " <-- CT for Harbour"
?
? " PRESS ANY KEY"
? "Calculate the monthly payment for a loan of $2000.00 at an annual rate"
? "of 10%, within 24 month "
? "PAYMENT( 2000.00, 0.10/12, 24 ) = 92.290 // CT3"
? SPACE(26),PAYMENT( 2000.00, 0.10/12, 24 ), " <-- CT for Harbour"
?
? " PRESS ANY KEY"
Inkey( 0 )
? "Continue Testing Financial functions...."
?
? "Calculate how many month do you need to cancel a loan of $4000.00 at"
? "an annual rate of 9.5% with payments of $200.00 max"
? "PERIODS( 4000.00, 200.00, 0.095/12 ) = 21.859 // CT3"
? Space( 31 ), PERIODS( 4000.00, 200.00, 0.095/12 ), " <-- CT for Harbour"
?
?
INKEY (0)
? "Continue Testing Financial functions...."
?
? "Calculate how many month do you need to cancel a loan of $4000.00 at"
? "an annual rate of 9.5% with payments of $200.00 max"
? "PERIODS( 4000.00, 200.00, 0.095/12 ) = 21.859 // CT3"
? SPACE(31), PERIODS( 4000.00, 200.00, 0.095/12 ), " <-- CT for Harbour"
?
?
? "Calculate which is the effective anual rate of your Bank, for a loan"
? "of $2500.00 if you pay $86.67 per month for 3 years"
? "RATE( 2500.00, 86.67, 36 ) * 12 = 0.1501 // CT3"
? Space( 24 ), RATE( 2500.00, 86.67, 36 ) * 12.0, " <-- CT for Harbour"
?
? " PRESS ANY KEY"
Inkey( 0 )
? "Calculate which is the effective anual rate of your Bank, for a loan"
? "of $2500.00 if you pay $86.67 per month for 3 years"
? "RATE( 2500.00, 86.67, 36 ) * 12 = 0.1501 // CT3"
? SPACE(24), RATE( 2500.00, 86.67, 36 ) * 12.0, " <-- CT for Harbour"
?
? " PRESS ANY KEY"
INKEY(0)
CTEXIT()
CTEXIT()
RETURN
RETURN

178
harbour/contrib/hbct/tests/math.prg
View File

@@ -4,16 +4,13 @@
/*
* Harbour Project source code:
*
* Test CT3 math functions
* Test CT3 math functions
* - FLOOR
* - CEILING
* - LOG10
* - SIGN
* - FACT
*
* Copyright 2001 Alejandro de Garate <alex_degarate@hotmail.com>
*
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -57,126 +54,119 @@
*
*/
PROCEDURE Main()
PROCEDURE MAIN
CTINIT()
CTINIT()
SET DECIMAL TO 2
CLS
? "Test of mathematical functions"
?
SET DECIMAL TO 2
CLS
? "Test of mathematical functions"
?
? "FLOOR( 1.9) = 1 // CT3"
? Space( 4 ), FLOOR( 1.9 ), " <-- CT for Harbour"
?
? "FLOOR( 1.9) = 1 // CT3"
? SPACE(4), FLOOR( 1.9)," <-- CT for Harbour"
?
? "FLOOR( 1.1) = 1 // CT3"
? Space( 4 ), FLOOR( 1.1 ), " <-- CT for Harbour"
?
? "FLOOR( 1.1) = 1 // CT3"
? SPACE(4), FLOOR( 1.1)," <-- CT for Harbour"
?
? "FLOOR( 0.9) = 0 // CT3"
? Space( 4 ), FLOOR( 0.9 ), " <-- CT for Harbour"
?
? "FLOOR( 0.9) = 0 // CT3"
? SPACE(4), FLOOR( 0.9)," <-- CT for Harbour"
?
? "FLOOR( -0.1) = -1 // CT3"
? Space( 6 ), FLOOR( - 0.1 ), " <-- CT for Harbour"
?
? "FLOOR( -0.1) = -1 // CT3"
? SPACE(6), FLOOR( -0.1)," <-- CT for Harbour"
?
? "FLOOR( -0.9) = -1 // CT3"
? Space( 6 ), FLOOR( - 0.9 ), " <-- CT for Harbour"
?
? "FLOOR( -0.9) = -1 // CT3"
? SPACE(6), FLOOR( -0.9)," <-- CT for Harbour"
?
? "FLOOR( -1.1) = -2 // CT3"
? Space( 6 ), FLOOR( - 1.1 ), " <-- CT for Harbour"
?
WAIT4()
? "FLOOR( -1.1) = -2 // CT3"
? SPACE(6), FLOOR( -1.1)," <-- CT for Harbour"
?
WAIT4()
? "CEILING( 1.9) = 2 // CT3"
? Space( 6 ), CEILING( 1.9 ), " <-- CT for Harbour"
?
? "CEILING( 1.9) = 2 // CT3"
? SPACE(6), CEILING( 1.9)," <-- CT for Harbour"
?
? "CEILING( 1.1) = 2 // CT3"
? Space( 6 ), CEILING( 1.1 ), " <-- CT for Harbour"
?
? "CEILING( 1.1) = 2 // CT3"
? SPACE(6), CEILING( 1.1)," <-- CT for Harbour"
?
? "CEILING( 0.9) = 1 // CT3"
? Space( 6 ), CEILING( 0.9 ), " <-- CT for Harbour"
?
? "CEILING( 0.9) = 1 // CT3"
? SPACE(6), CEILING( 0.9)," <-- CT for Harbour"
?
? "CEILING( -0.1) = 0 // CT3"
? Space( 7 ), CEILING( - 0.1 ), " <-- CT for Harbour"
?
? "CEILING( -0.1) = 0 // CT3"
? SPACE(7), CEILING( -0.1)," <-- CT for Harbour"
?
? "CEILING( -0.9) = 0 // CT3"
? Space( 7 ), CEILING( - 0.9 ), " <-- CT for Harbour"
?
? "CEILING( -0.9) = 0 // CT3"
? SPACE(7), CEILING( -0.9)," <-- CT for Harbour"
?
? "CEILING( -1.1) = -1 // CT3"
? Space( 8 ), CEILING( - 1.1 ), " <-- CT for Harbour"
?
? "CEILING( -1.1) = -1 // CT3"
? SPACE(8), CEILING( -1.1)," <-- CT for Harbour"
?
WAIT4()
WAIT4()
? "LOG10( 0.01 ) = -2.00 // CT3"
? SPACE(7), LOG10( 0.01 )," <-- CT for Harbour"
?
? "LOG10( 0.01 ) = -2.00 // CT3"
? Space( 7 ), LOG10( 0.01 ), " <-- CT for Harbour"
?
? "LOG10( 2 ) = 0.30 // CT3"
? SPACE(3), LOG10( 2 )," <-- CT for Harbour"
?
? "LOG10( 2 ) = 0.30 // CT3"
? Space( 3 ), LOG10( 2 ), " <-- CT for Harbour"
?
? "LOG10( 100 ) = 2.00 // CT3"
? SPACE(5), LOG10( 100 )," <-- CT for Harbour"
?
?
? "LOG10( 100 ) = 2.00 // CT3"
? Space( 5 ), LOG10( 100 ), " <-- CT for Harbour"
?
?
? "SIGN( 48335 ) = 1 // CT3"
? SPACE(6), SIGN( 48335 )," <-- CT for Harbour"
?
? "SIGN( 48335 ) = 1 // CT3"
? Space( 6 ), SIGN( 48335 ), " <-- CT for Harbour"
?
? "SIGN( -258 ) = -1 // CT3"
? SPACE(6), SIGN( -258 )," <-- CT for Harbour"
?
? "SIGN( -258 ) = -1 // CT3"
? Space( 6 ), SIGN( - 258 ), " <-- CT for Harbour"
?
WAIT4()
WAIT4()
SET DECIMALS TO 0
? "FACT( 1 ) = 1 // CT3"
? SPACE(2), FACT( 1 ), " <-- CT for Harbour"
?
SET DECIMALS TO 0
? "FACT( 1 ) = 1 // CT3"
? Space( 2 ), FACT( 1 ), " <-- CT for Harbour"
?
? "FACT( 5 ) = 120 // CT3"
? SPACE(4), FACT( 5), " <-- CT for Harbour"
?
? "FACT( 5 ) = 120 // CT3"
? Space( 4 ), FACT( 5 ), " <-- CT for Harbour"
?
? "FACT( 21 ) = 51090942171709440000 // CT3"
? SPACE(12), FACT( 21), " <-- CT for Harbour"
?
? "FACT( 21 ) = 51090942171709440000 // CT3"
? Space( 12 ), FACT( 21 ), " <-- CT for Harbour"
?
? "FACT( 25 ) = -1 // CT3"
? SPACE(4), FACT( 25), " <-- CT for Harbour"
?
? "FACT( 25 ) = -1 // CT3"
? Space( 4 ), FACT( 25 ), " <-- CT for Harbour"
?
? "FACT( 0 ) = 1 // CT3"
? SPACE(2), FACT( 0), " <-- CT for Harbour"
?
? "FACT( 0 ) = 1 // CT3"
? Space( 2 ), FACT( 0 ), " <-- CT for Harbour"
?
CTEXIT()
CTEXIT()
RETURN
RETURN
PROCEDURE WAIT4
? " PRESS ANY KEY"
INKEY(0)
CLS
RETURN
? " PRESS ANY KEY"
Inkey( 0 )
CLS
RETURN

104
harbour/contrib/hbct/tests/num1.prg
View File

@@ -4,15 +4,11 @@
/*
* Harbour Project source code:
*
* Test CT3 Numeric functions - PART 1
*
* - CELSIUS
* - FAHRENHEIT
* - INFINITY
*
* - CELSIUS
* - FAHRENHEIT
* - INFINITY
* Copyright 2001 Alejandro de Garate <alex_degarate@hotmail.com>
*
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -56,55 +52,53 @@
*
*/
PROCEDURE Main()
CTINIT()
SET DECIMAL TO 14
CLS
?? "Test of Numeric functions - part 1"
? "CELSIUS( 33.8 ) = 1 // CT3"
? Space( 10 ), CELSIUS( 33.8 ), " <-- CT for Harbour "
?
? "CELSIUS( 338.0 ) = 170 // CT3"
? Space( 11 ), CELSIUS( 338.0 ), " <-- CT for Harbour "
?
? "CELSIUS( 3380.0) = 1860 // CT3"
? Space( 12 ), CELSIUS( 3380.0 ), " <-- CT for Harbour "
?
? "CELSIUS( -33.8) = -36.5555.. // CT3"
? Space( 10 ), CELSIUS( - 33.8 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( 12.5 ) = 54.5 // CT3"
? Space( 12 ), FAHRENHEIT( 12.5 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( 125 ) = 257 // CT3"
? Space( 12 ), FAHRENHEIT( 125 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( 1250 ) = 2282 // CT3"
? Space( 14 ), FAHRENHEIT( 1250 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( -155 ) = -247 // CT3"
? Space( 14 ), FAHRENHEIT( - 155 ), " <-- CT for Harbour "
?
? " PRESS ANY KEY"
Inkey( 0 )
PROCEDURE MAIN
? "INFINITY() // CT3"
? Space( 8 ), Str( INFINITY(), 30, 15 ), " <-- CT for Harbour"
?
CTINIT()
CTEXIT()
SET DECIMAL TO 14
CLS
?? "Test of Numeric functions - part 1"
? "CELSIUS( 33.8 ) = 1 // CT3"
? SPACE(10), CELSIUS( 33.8 ), " <-- CT for Harbour "
?
? "CELSIUS( 338.0 ) = 170 // CT3"
? SPACE(11), CELSIUS( 338.0 ), " <-- CT for Harbour "
?
? "CELSIUS( 3380.0) = 1860 // CT3"
? SPACE(12), CELSIUS( 3380.0), " <-- CT for Harbour "
?
? "CELSIUS( -33.8) = -36.5555.. // CT3"
? SPACE(10), CELSIUS( -33.8), " <-- CT for Harbour "
?
? "FAHRENHEIT( 12.5 ) = 54.5 // CT3"
? SPACE(12), FAHRENHEIT( 12.5 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( 125 ) = 257 // CT3"
? SPACE(12), FAHRENHEIT( 125 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( 1250 ) = 2282 // CT3"
? SPACE(14), FAHRENHEIT( 1250 ), " <-- CT for Harbour "
?
? "FAHRENHEIT( -155 ) = -247 // CT3"
? SPACE(14), FAHRENHEIT( -155 ), " <-- CT for Harbour "
?
? " PRESS ANY KEY"
INKEY(0)
? "INFINITY() // CT3"
? SPACE(8), STR( INFINITY(), 30, 15), " <-- CT for Harbour"
?
CTEXIT()
RETURN
RETURN

55
harbour/contrib/hbct/tests/numtoken.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function NUMTOKEN()
* Test CT3 function NUMTOKEN()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,41 +52,36 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
procedure main
ctinit()
local cStr := ".,.This.,.is.,.a.,.test!"
QOut( "Begin test of NUMTOKEN()" )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ numtoken("Hello, World!") == 2 ? ------------------------------> ] + Str( numtoken("Hello, World!" ),2 ) )
QOut( [ numtoken("This is good. See you! How do you do?",".!?") == 3 ? -> ] + Str( numtoken("This is good. See you! How do you do?",".!?" ),2 ) )
QOut( [ numtoken("one,,three,four,,six",",",1) == 6 ? -----------------> ] + Str( numtoken("one,,three,four,,six",",",1 ),2 ) )
QOut( "" )
qout ("Begin test of NUMTOKEN()")
qout ("")
// Some simple tests
qout (" Simple tests:")
qout ([ numtoken ("Hello, World!") == 2 ? ------------------------------> ] + str (numtoken ("Hello, World!"),2))
qout ([ numtoken ("This is good. See you! How do you do?",".!?") == 3 ? -> ] + str (numtoken ("This is good. See you! How do you do?",".!?"),2))
qout ([ numtoken ("one,,three,four,,six",",",1) == 6 ? -----------------> ] + str (numtoken ("one,,three,four,,six",",",1),2))
qout ("")
qout ([ # of tokens in the string "]+cStr+["])
qout ([ separator list = ".,!" and skip width = 1: ]+str (numtoken (cStr, ".,!", 1)))
qout ([ skip width = 3: ]+str (numtoken (cStr, ".,!", 3)))
qout ([ separator list = ",!" and skip width = 1: ]+str (numtoken (cStr, ",!", 1)))
qout ([ skip width = 3: ]+str (numtoken (cStr, ",!", 3)))
qout ([ separator list = "!" and skip width = 1: ]+str (numtoken (cStr, "!", 1)))
qout ([ skip width = 3: ]+str (numtoken (cStr, "!", 3)))
qout ("")
qout ("End test of NUMTOKEN()")
qout ()
ctexit()
return
QOut( [ # of tokens in the string "] + cStr + ["] )
QOut( [ separator list = ".,!" and skip width = 1: ] + Str( numtoken(cStr, ".,!", 1 ) ) )
QOut( [ skip width = 3: ] + Str( numtoken(cStr, ".,!", 3 ) ) )
QOut( [ separator list = ",!" and skip width = 1: ] + Str( numtoken(cStr, ",!", 1 ) ) )
QOut( [ skip width = 3: ] + Str( numtoken(cStr, ",!", 3 ) ) )
QOut( [ separator list = "!" and skip width = 1: ] + Str( numtoken(cStr, "!", 1 ) ) )
QOut( [ skip width = 3: ] + Str( numtoken(cStr, "!", 3 ) ) )
QOut( "" )
QOut( "End test of NUMTOKEN()" )
QOut()
ctexit()
RETURN

40
harbour/contrib/hbct/tests/rangerem.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function RANGEREM()
* Test CT3 function RANGEREM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,32 +52,26 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of RANGEREM()")
qout ("")
qout ([ rangerem ("0","9","year2002.dbf") == "year.dbf" ? --> "] + ;
rangerem ("0","9","year2002.dbf") + ["])
qout ([ rangerem ("9","0","year2002.dbf") == "22" ? --> "] + ;
rangerem ("9","0","year2002.dbf") + ["])
qout ([ rangerem ("0","9","yearcurr.dbf") == "yearcurr.dbf" ? --> "] + ;
rangerem ("0","9","yearcurr.dbf") + ["])
qout ("")
qout ("End test of RANGEREM()")
qout ("")
ctexit()
return
QOut( "Begin test of RANGEREM()" )
QOut( "" )
QOut( [ rangerem("0","9","year2002.dbf") == "year.dbf" ? --> "] + ;
rangerem( "0", "9", "year2002.dbf" ) + ["] )
QOut( [ rangerem("9","0","year2002.dbf") == "22" ? --> "] + ;
rangerem( "9", "0", "year2002.dbf" ) + ["] )
QOut( [ rangerem("0","9","yearcurr.dbf") == "yearcurr.dbf" ? --> "] + ;
rangerem( "0", "9", "yearcurr.dbf" ) + ["] )
QOut( "" )
QOut( "End test of RANGEREM()" )
QOut( "" )
ctexit()
RETURN

40
harbour/contrib/hbct/tests/rangerep.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function RANGEREPL()
* Test CT3 function RANGEREPL()
*
* Copyright 2002 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,32 +52,26 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of RANGEREPL()")
qout ("")
qout ([ rangerepl ("0","9","year2002.dbf","?") == "year????.dbf" ? --> "] + ;
rangerepl ("0","9","year2002.dbf","?") + ["])
qout ([ rangerepl ("9","0","year2002.dbf","?") == "????2??2????" ? --> "] + ;
rangerepl ("9","0","year2002.dbf","?") + ["])
qout ([ rangerepl ("0","9","yearcurr.dbf","?") == "yearcurr.dbf" ? --> "] + ;
rangerepl ("0","9","yearcurr.dbf","?") + ["])
qout ("")
qout ("End test of RANGEREPL()")
qout ("")
ctexit()
return
QOut( "Begin test of RANGEREPL()" )
QOut( "" )
QOut( [ rangerepl("0","9","year2002.dbf","?") == "year????.dbf" ? --> "] + ;
rangerepl( "0", "9", "year2002.dbf", "?" ) + ["] )
QOut( [ rangerepl("9","0","year2002.dbf","?") == "????2??2????" ? --> "] + ;
rangerepl( "9", "0", "year2002.dbf", "?" ) + ["] )
QOut( [ rangerepl("0","9","yearcurr.dbf","?") == "yearcurr.dbf" ? --> "] + ;
rangerepl( "0", "9", "yearcurr.dbf", "?" ) + ["] )
QOut( "" )
QOut( "End test of RANGEREPL()" )
QOut( "" )
ctexit()
RETURN

44
harbour/contrib/hbct/tests/setatlik.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function SETATLIKE()
* Test CT3 function SETATLIKE()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,29 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cWildcard := " "
procedure main
ctinit()
local cWildcard := " "
QOut( "Begin test of SETATLIKE()" )
QOut( " Default mode should be 0, is................................", setatlike() )
QOut( " Setting mode to 1, return value should be 0, is.............", setatlike( 1 ) )
QOut( " Mode setting should now be 1, is............................", setatlike() )
QOut( " Setting mode to 0 again, return value should still be 1, is ", setatlike( 0 ) )
QOut( "" )
setatlike( , @cWildcard )
QOut( " Default wildcard character should be '?', is................", cWildcard )
setatlike( , "#" )
setatlike( , @cWildcard )
QOut( " Setting wildcard to '#' and calling SETATLIKE(,@cWildcard)" )
QOut( " should yield '#' for cWildcard, does......................", cWildcard )
QOut( "End test of SETATLIKE()" )
QOut( "" )
ctinit()
ctexit()
qout ("Begin test of SETATLIKE()")
qout (" Default mode should be 0, is................................", setatlike())
qout (" Setting mode to 1, return value should be 0, is.............", setatlike (1))
qout (" Mode setting should now be 1, is............................", setatlike())
qout (" Setting mode to 0 again, return value should still be 1, is ", setatlike (0))
qout ("")
setatlike (, @cWildcard)
qout (" Default wildcard character should be '?', is................", cWildcard)
setatlike (, "#")
setatlike (, @cWildcard)
qout (" Setting wildcard to '#' and calling SETATLIKE (,@cWildcard)")
qout (" should yield '#' for cWildcard, does......................", cWildcard)
qout ("End test of SETATLIKE()")
qout ("")
ctexit()
return
RETURN

40
harbour/contrib/hbct/tests/strdiff.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function STRDIFF()
* Test CT3 function STRDIFF()
*
* Copyright 2002 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,32 +52,28 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
QOut( "Begin test of STRDIFF()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
qout ("Begin test of STRDIFF()")
qout ("")
QOut( [ strdiff("ABC", "ADC") == 3 ? -> ], strdiff( "ABC", "ADC" ) )
QOut( [ strdiff("ABC", "AEC") == 3 ? -> ], strdiff( "ABC", "AEC" ) )
QOut( [ strdiff("CBA", "ABC") == 6 ? -> ], strdiff( "CBA", "ABC" ) )
QOut( [ strdiff("ABC", "AXBC") == 1 ? -> ], strdiff( "ABC", "AXBC" ) )
QOut( [ strdiff("AXBC", "ABC") == 6 ? -> ], strdiff( "AXBC", "ABC" ) )
QOut( [ strdiff("AXBC", "ADC") == 9 ? -> ], strdiff( "AXBC", "ADC" ) )
// simple tests
qout ("Simple tests:")
qout ([ strdiff("ABC", "ADC") == 3 ? -> ], strdiff ("ABC", "ADC"))
qout ([ strdiff("ABC", "AEC") == 3 ? -> ], strdiff ("ABC", "AEC"))
qout ([ strdiff("CBA", "ABC") == 6 ? -> ], strdiff ("CBA", "ABC"))
qout ([ strdiff("ABC", "AXBC") == 1 ? -> ], strdiff ("ABC", "AXBC"))
qout ([ strdiff("AXBC", "ABC") == 6 ? -> ], strdiff ("AXBC", "ABC"))
qout ([ strdiff("AXBC", "ADC") == 9 ? -> ], strdiff ("AXBC", "ADC"))
qout ("End test of STRDIFF()")
qout ("")
ctexit()
return
QOut( "End test of STRDIFF()" )
QOut( "" )
ctexit()
RETURN

182
harbour/contrib/hbct/tests/tab.prg
View File

@@ -52,112 +52,110 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr, nLen
procedure main
ctinit()
local cStr, nLen
QOut( "Begin test of TABEXPAND()" )
QOut( "" )
ctinit()
// simple tests
QOut( "Simple tests:" )
QOut( [ tabexpand("-"+chr(9)+"!") == "- !" ? -> "] + tabexpand( "-" + Chr(9 ) + "!" ) + ["] )
QOut( [ tabexpand("----"+chr(9) +"!") == "---- !" ? -> "] + tabexpand( "----" + Chr(9 ) + "!" ) + ["] )
QOut( [ tabexpand("-"+chr(9)+"!",, "+") == "-+++++++!" ? -> "] + tabexpand( "-" + Chr(9 ) + "!",, "+" ) + ["] )
QOut( [ tabexpand("-"+chr(9)+ "!", 4) == "- !" ? -> "] + tabexpand( "-" + Chr(9 ) + "!", 4 ) + ["] )
QOut( [ tabexpand("----"+chr(9)+ "!", 8) == "---- !" ? -> "] + tabexpand( "----" + Chr(9 ) + "!", 8 ) + ["] )
QOut( [ tabexpand("----"+chr(9)+ "!", 8, "+") == "----++++!" ? -> "] + tabexpand( "----" + Chr(9 ) + "!", 8, "+" ) + ["] )
QOut( "" )
qout ("Begin test of TABEXPAND()")
qout ("")
QOut( "Tests with newline characters: ^J == LF, ^M == CR" )
cStr := hb_eol()
cStr := StrTran( cStr, Chr( 10 ), "^J" )
cStr := StrTran( cStr, Chr( 13 ), "^M" )
QOut( [ hb_eol() = "] + cStr + ["] )
cStr := tabexpand( "-" + Chr( 9 ) + "!" + hb_eol() + "----" + Chr( 9 ) + "!", , "+" )
cStr := StrTran( cStr, Chr( 10 ), "^J" )
cStr := StrTran( cStr, Chr( 13 ), "^M" )
QOut( [ tabexpand("-"+chr(9)+"!"+hb_eol()+"----"+chr(9)+ "!",, "+")] )
QOut( [ == "-+++++++!"+hb_eol()+"----++++!" ? -> "] + cStr + ["] )
cStr := tabexpand( "-" + Chr( 9 ) + "!$$--" + hb_eol() + "--" + Chr( 9 ) + "!", , "+", "$" )
cStr := StrTran( cStr, Chr( 10 ), "^J" )
cStr := StrTran( cStr, Chr( 13 ), "^M" )
QOut( [ tabexpand("-"+chr(9)+"!$$--"+hb_eol()+--"+chr(9)+ "!",, "+", "$")] )
nLen := Len( hb_eol() )
QOut( [ == "-+++++++!$$--"+hb_eol()+"] + Replicate( "-",4 - nLen ) + [++!" ? -> "] + cStr + ["] )
QOut( "" )
// simple tests
qout ("Simple tests:")
qout ([ tabexpand("-"+chr(9)+"!") == "- !" ? -> "] + tabexpand ("-"+chr(9)+"!") + ["])
qout ([ tabexpand("----"+chr(9) +"!") == "---- !" ? -> "] + tabexpand ("----"+chr(9) +"!") + ["])
qout ([ tabexpand("-"+chr(9)+"!",, "+") == "-+++++++!" ? -> "] + tabexpand ("-"+chr(9)+"!",, "+") + ["])
qout ([ tabexpand("-"+chr(9)+ "!", 4) == "- !" ? -> "] + tabexpand ("-"+chr(9)+ "!", 4) + ["])
qout ([ tabexpand("----"+chr(9)+ "!", 8) == "---- !" ? -> "] + tabexpand ("----"+chr(9)+ "!", 8) + ["])
qout ([ tabexpand("----"+chr(9)+ "!", 8, "+") == "----++++!" ? -> "] + tabexpand ("----"+chr(9)+ "!", 8, "+") + ["])
qout ("")
QOut( "Tests with tab characters:" )
QOut( [ tabexpand("-"+chr(9)+"-",,"+") == "-+++++++-" ? -> "] + tabexpand( "-" + Chr(9 ) + "-",,"+" ) + ["] )
QOut( [ tabexpand("-"+chr(9)+"-",,"+",,"-")] )
QOut( [ == "++++++++^I+++++++" ? -> "] + StrTran( tabexpand("-" + Chr(9 ) + "-",,"+",,"-" ),Chr(9 ),"^I" ) + ["] )
QOut( "" )
qout ("Tests with newline characters: ^J == LF, ^M == CR")
cStr := hb_eol()
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ hb_eol() = "] + cStr +["])
cStr := tabexpand("-"+chr(9)+"!"+hb_eol()+"----"+chr(9)+ "!",, "+")
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ tabexpand("-"+chr(9)+"!"+hb_eol()+"----"+chr(9)+ "!",, "+")])
qout ([ == "-+++++++!"+hb_eol()+"----++++!" ? -> "] + cStr +["])
cStr := tabexpand("-"+chr(9)+"!$$--"+hb_eol()+"--"+chr(9)+ "!",, "+", "$")
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ tabexpand("-"+chr(9)+"!$$--"+hb_eol()+--"+chr(9)+ "!",, "+", "$")])
nLen := len (hb_eol())
qout ([ == "-+++++++!$$--"+hb_eol()+"]+replicate("-",4-nLen)+[++!" ? -> "] + cStr +["])
qout ("")
QOut( "End test of TABEXPAND()" )
QOut( "Press any key to continue with tests of TABPACK()..." )
QOut( "" )
Inkey( 0 )
qout ("Tests with tab characters:")
qout ([ tabexpand("-"+chr(9)+"-",,"+") == "-+++++++-" ? -> "] + tabexpand("-"+chr(9)+"-",,"+") + ["])
qout ([ tabexpand("-"+chr(9)+"-",,"+",,"-")])
qout ([ == "++++++++^I+++++++" ? -> "] + strtran(tabexpand("-"+chr(9)+"-",,"+",,"-"),chr(9),"^I")+ ["])
qout ("")
QOut( "Begin test of TABPACK()" )
QOut( "" )
qout ("End test of TABEXPAND()")
qout ("Press any key to continue with tests of TABPACK()...")
qout ("")
inkey (0)
// simple tests
QOut( "Simple tests: ^I == tab character" )
qout ("Begin test of TABPACK()")
qout ("")
QOut( [ tabpack("AAAAAAA*",, "*") == "AAAAAAA*" ? -> "] + StrTran( tabpack("AAAAAAA*",, "*" ),Chr(9 ),"^I" ) + ["] )
QOut( [ tabpack("AAAAA***",, "*") == "AAAAA^I" ? -> "] + StrTran( tabpack("AAAAA***",, "*" ),Chr(9 ),"^I" ) + ["] )
QOut( [ tabpack("AAAAA*****",, "*") == "AAAAA^I**" ? -> "] + StrTran( tabpack("AAAAA*****",, "*" ),Chr(9 ),"^I" ) + ["] )
QOut( "" )
// simple tests
qout ("Simple tests: ^I == tab character")
QOut( "Tests with newline characters:" )
cStr := hb_eol()
cStr := StrTran( cStr, Chr( 10 ), "^J" )
cStr := StrTran( cStr, Chr( 13 ), "^M" )
QOut( [ hb_eol() = "] + cStr + ["] )
qout ([ tabpack("AAAAAAA*",, "*") == "AAAAAAA*" ? -> "] + strtran(tabpack("AAAAAAA*",, "*"),chr(9),"^I") + ["])
qout ([ tabpack("AAAAA***",, "*") == "AAAAA^I" ? -> "] + strtran(tabpack("AAAAA***",, "*"),chr(9),"^I") + ["])
qout ([ tabpack("AAAAA*****",, "*") == "AAAAA^I**" ? -> "] + strtran(tabpack("AAAAA*****",, "*"),chr(9),"^I")+ ["])
qout ("")
cStr := "ABCD+" + hb_eol() + "++---+++++"
cStr := tabpack( cStr, 4, "+" )
cStr := StrTran( cStr, Chr( 10 ), "^J" )
cStr := StrTran( cStr, Chr( 13 ), "^M" )
cStr := StrTran( cStr, Chr( 9 ), "^I" )
QOut( [ tabpack("ABCD+" + hb_eol() + "++---+++++", 4, "+")] )
QOut( [ == "ABCD+"+hb_eol()+"++---"+chr(9)+"++" ? -> "] + cStr + ["] )
qout ("Tests with newline characters:")
cStr := hb_eol()
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ hb_eol() = "] + cStr +["])
QOut( "End test of TABPACK()" )
QOut( "" )
cStr := "ABCD+" + hb_eol() + "++---+++++"
cStr := tabpack (cStr, 4, "+")
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
cStr := strtran (cStr, chr(9),"^I")
qout ([ tabpack("ABCD+" + hb_eol() + "++---+++++", 4, "+")])
qout ([ == "ABCD+"+hb_eol()+"++---"+chr(9)+"++" ? -> "] + cStr +["])
// qout("Test with a MEMOEDITed string:")
// qout(" Now, a memoedit() will start. Please type a text, use tab characters")
// qout(" and make sure, you make use of soft and hard returns !")
// qout(" ...press any key to start the memoedit now...")
// qout("")
// inkey(0)
// cls
// dispbox(0,0,20,60)
// cStr := memoedit(, 1, 1, 9, 59,,,59)
// cls
// qout(" Now printing the expanded text using a tab length of 4 and soft CRs")
// cStr1 := tabexpand(cStr,4,"+",,,.F.)
// cStr1 := strtran(cStr, chr(141), hb_eol())
//
// for ni := 1 to mlcount(cStr1, 59, 4, .T.)
// qout(" "+str(ni)+": "+memoline(cStr1, 59,ni,4,.T.))
// next ni
//
// qout(" Now printing the expanded text using a tab length of 4 but without soft CRs")
// cStr1 := tabexpand(cStr,4,"+",,,.T.)
//
// for ni := 1 to mlcount(cStr1, 59, 4, .T.)
// qout(" "+str(ni)+": "+memoline(cStr1, 59,ni,4,.T.))
// next ni
// inkey(0)
qout ("End test of TABPACK()")
qout ("")
ctexit()
// qout ("Test with a MEMOEDITed string:")
// qout (" Now, a memoedit() will start. Please type a text, use tab characters")
// qout (" and make sure, you make use of soft and hard returns !")
// qout (" ...press any key to start the memoedit now...")
// qout ("")
// inkey (0)
// cls
// dispbox (0,0,20,60)
// cStr := memoedit (, 1, 1, 9, 59,,,59)
// cls
// qout (" Now printing the expanded text using a tab length of 4 and soft CRs")
// cStr1 := tabexpand (cStr,4,"+",,,.F.)
// cStr1 := strtran (cStr, chr(141), hb_eol())
//
// for ni := 1 to mlcount (cStr1, 59, 4, .T.)
// qout (" "+str(ni)+": "+memoline (cStr1, 59,ni,4,.T.))
// next ni
//
// qout (" Now printing the expanded text using a tab length of 4 but without soft CRs")
// cStr1 := tabexpand (cStr,4,"+",,,.T.)
//
// for ni := 1 to mlcount (cStr1, 59, 4, .T.)
// qout (" "+str(ni)+": "+memoline (cStr1, 59,ni,4,.T.))
// next ni
// inkey (0)
ctexit()
return
RETURN

79
harbour/contrib/hbct/tests/token.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function TOKEN()
* Test CT3 function TOKEN()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,54 +52,49 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
LOCAL ni, npos
LOCAL cPre := " "
LOCAL cPost := " "
procedure main
ctinit()
local cStr := ".,.This.,.is.,.a.,.test!"
local ni, npos
local cPre := " "
local cPost := " "
QOut( "Begin test of TOKEN()" )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ token("Hello, World!") == "World" ? -----------> "] + token( "Hello, World!" ) + ["] )
QOut( [ token("Hello, World!",,2,1) == "" ? -----------> "] + token( "Hello, World!",,2,1 ) + ["] )
QOut( [ token("Hello, World!",",",2,1) == " World!" ? -> "] + token( "Hello, World!",",",2,1 ) + ["] )
QOut( [ token("Hello, World!"," ",2,1) == "World!" ? --> "] + token( "Hello, World!"," ",2,1 ) + ["] )
QOut( "" )
qout ("Begin test of TOKEN()")
qout ("")
QOut( [ Tokenizing the string "] + cStr + ["] )
QOut( [ with skip width == 1 and ".,!" as tokenizer list:] )
QOut( "" )
for ni := 1 TO numtoken( cStr, ".,!", 1 )
QOut( [ Token #] + AllTrim( Str(ni ) ) + [("] + token( cStr, ".,!", ni, 1, @cPre, @cPost ) + ;
[") @ pos ] + Str( npos := attoken( cStr, ".,!", ni, 1 ), 3 ) + [, tokenized by "] + cPre + [" and "] + cPost + [" is ] + iif( SubStr( cStr,npos,1 ) $ ".,!", "", "not " ) + "empty" )
next ni
// Some simple tests
qout (" Simple tests:")
qout ([ token ("Hello, World!") == "World" ? -----------> "] + token ("Hello, World!")+["])
qout ([ token ("Hello, World!",,2,1) == "" ? -----------> "] + token ("Hello, World!",,2,1)+["])
qout ([ token ("Hello, World!",",",2,1) == " World!" ? -> "] + token ("Hello, World!",",",2,1)+["])
qout ([ token ("Hello, World!"," ",2,1) == "World!" ? --> "] + token ("Hello, World!"," ",2,1)+["])
qout ("")
qout ([ Tokenizing the string "]+cStr+["])
qout ([ with skip width == 1 and ".,!" as tokenizer list:])
qout ("")
for ni := 1 to numtoken (cStr, ".,!", 1)
qout ([ Token #]+alltrim(str(ni))+[ ("]+token(cStr, ".,!", ni, 1, @cPre, @cPost)+;
[") @ pos ]+str(npos:=attoken (cStr, ".,!", ni, 1),3)+[, tokenized by "]+cPre+[" and "]+cPost+[" is ]+iif(substr(cStr,npos,1)$".,!","","not ")+"empty")
next ni
qout ("")
qout ([ Tokenizing the string "]+cStr+["])
qout ([ with skip width == 3 and ".,!" as tokenizer list:])
qout ("")
for ni := 1 to numtoken (cStr, ".,!", 3)
qout ([ Token #]+alltrim(str(ni))+[ ("]+token(cStr, ".,!", ni, 3, @cPre, @cPost)+;
[") @ pos ]+str(npos:=attoken (cStr, ".,!", ni, 3),3)+[, tokenized by "]+cPre+[" and "]+cPost+[" is ]+iif(substr(cStr,npos,1)$".,!","","not ")+"empty.")
next ni
qout ("")
qout ("End test of TOKEN()")
qout ()
ctexit()
return
QOut( "" )
QOut( [ Tokenizing the string "] + cStr + ["] )
QOut( [ with skip width == 3 and ".,!" as tokenizer list:] )
QOut( "" )
for ni := 1 TO numtoken( cStr, ".,!", 3 )
QOut( [ Token #] + AllTrim( Str(ni ) ) + [("] + token( cStr, ".,!", ni, 3, @cPre, @cPost ) + ;
[") @ pos ] + Str( npos := attoken( cStr, ".,!", ni, 3 ), 3 ) + [, tokenized by "] + cPre + [" and "] + cPost + [" is ] + iif( SubStr( cStr,npos,1 ) $ ".,!", "", "not " ) + "empty." )
next ni
QOut( "" )
QOut( "End test of TOKEN()" )
QOut()
ctexit()
RETURN

209
harbour/contrib/hbct/tests/token2.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 functions
* Test CT3 functions
* - TOKENINIT()
* - TOKENEXIT()
* - TOKENNEXT()
@@ -60,125 +60,122 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
procedure main
LOCAL cStr1 := "A,BB,CCC,DDDD,EEEEE,FFFFFF"
local cStr1 := "A,BB,CCC,DDDD,EEEEE,FFFFFF"
//local cStr2 := "ZZZZZZ,YYYYY,XXXX,WWW,VV,U"
local cStr3 := "0123456789ABCDEFGHIJKLM"
local cStr4 := "08:09:10:11:12"
local cStr5 := "05:00+20:00+35:00+50:00"
//local cStr2 := "ZZZZZZ,YYYYY,XXXX,WWW,VV,U"
LOCAL cStr3 := "0123456789ABCDEFGHIJKLM"
LOCAL cStr4 := "08:09:10:11:12"
LOCAL cStr5 := "05:00+20:00+35:00+50:00"
local cTE1, cTE2
LOCAL cTE1, cTE2
ctinit()
ctinit()
qout ("Begin test of incremental tokenizer function family")
qout ("")
QOut( "Begin test of incremental tokenizer function family" )
QOut( "" )
// Some simple tests with global token environment
qout ([ Incremental tokenizing the string "]+cStr1+["])
qout ([ tokeninit (@cStr1, ",", 1) == .T. ? ----> ] + ltoc(tokeninit (@cStr1, ",", 1)))
qout ([ tokennum () == 6 ? ---------------------> ] + str(tokennum ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ access tokens directly with tokennext])
qout ([ tokennext (@cStr1,2) == "BB" ? -------> "] + tokennext(@cStr1,2)+["])
qout ([ tokennext (@cStr1,4) == "DDDD" ? -----> "] + tokennext(@cStr1,4)+["])
qout ()
// Some simple tests with global token environment
QOut( [ Incremental tokenizing the string "] + cStr1 + ["] )
QOut( [ tokeninit(@cStr1, ",", 1) == .T. ? ----> ] + ltoc( tokeninit(@cStr1, ",", 1 ) ) )
QOut( [ tokennum() == 6 ? ---------------------> ] + Str( tokennum() ) )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
WHILE( !tokenend() )
QOut( [ tokennext(@cStr1) ------------------> "] + tokennext( @cStr1 ) + ["] )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
ENDDO
QOut()
QOut( [ rewind with tokeninit() == .T. ? ------> ] + ltoc( tokeninit() ) )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
WHILE( !tokenend() )
QOut( [ tokennext(@cStr1) ------------------> "] + tokennext( @cStr1 ) + ["] )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
ENDDO
QOut()
QOut( [ access tokens directly with tokennext] )
QOut( [ tokennext(@cStr1,2) == "BB" ? -------> "] + tokennext( @cStr1,2 ) + ["] )
QOut( [ tokennext(@cStr1,4) == "DDDD" ? -----> "] + tokennext( @cStr1,4 ) + ["] )
QOut()
qout ("...Press any key...")
qout ()
inkey (0)
QOut( "...Press any key..." )
QOut()
Inkey( 0 )
qout ([ Incremental tokenizing the string "]+cStr3+[" with the])
qout ([ token environment of cStr1 !])
qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr3) ------------------> "] + tokennext(@cStr3)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ start & end with tokenat(.F./.T.)-----> ] + str(tokenat())+[ ]+str(tokenat(.T.)))
tokennext(@cStr1)
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ()
qout ([ access tokens directly with tokenat])
qout ([ tokenat (.F.,2) == 3 ? ---------------> ] + str(tokenat(.F.,2)))
qout ([ tokenat (.T.,4) == 14 ? --------------> ] + str(tokenat(.T.,4)))
qout()
QOut( [ Incremental tokenizing the string "] + cStr3 + [" with the] )
QOut( [ token environment of cStr1 !] )
QOut( [ rewind with tokeninit() == .T. ? ------> ] + ltoc( tokeninit() ) )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
WHILE( !tokenend() )
QOut( [ tokennext(@cStr3) ------------------> "] + tokennext( @cStr3 ) + ["] )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
ENDDO
QOut()
QOut( [ rewind with tokeninit() == .T. ? ------> ] + ltoc( tokeninit() ) )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
WHILE( !tokenend() )
QOut( [ start & end with tokenat(.F./.T.)-----> ] + Str( tokenat() ) + [ ] + Str( tokenat( .T. ) ) )
tokennext( @cStr1 )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
ENDDO
QOut()
QOut( [ access tokens directly with tokenat] )
QOut( [ tokenat(.F.,2) == 3 ? ---------------> ] + Str( tokenat( .F. ,2 ) ) )
QOut( [ tokenat(.T.,4) == 14 ? --------------> ] + Str( tokenat( .T. ,4 ) ) )
QOut()
qout ("...Press any key...")
qout ()
inkey (0)
QOut( "...Press any key..." )
QOut()
Inkey( 0 )
qout ([ Save global token environment with savetoken])
cTE1 := savetoken()
qout ([ tokeninit a different string, cStr4 := "]+cStr4+[", with tokeninit()])
qout ([ tokeninit (@cStr4, ":", 1) == .T. ? ----> ] + ltoc(tokeninit (@cStr4, ":", 1)))
qout ([ tokennum () == 5 ? ---------------------> ] + str(tokennum ()))
qout ([ tokennext() == "08" ? ------------------> "]+ tokennext (@cStr4)+["])
qout ([ Now restore global token environment with resttoken and rewind it])
resttoken (cTE1)
tokeninit()
qout ([ tokennum () == 6 ? ---------------------> ] + str(tokennum ()))
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
while (!tokenend())
qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["])
qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend()))
enddo
qout ([ Release global TE with tokenexit () ----> ] + ltoc(tokenexit()))
qout ()
QOut( [ Save global token environment with savetoken] )
cTE1 := savetoken()
QOut( [ tokeninit a different string, cStr4 := "] + cStr4 + [", with tokeninit()] )
QOut( [ tokeninit(@cStr4, ":", 1) == .T. ? ----> ] + ltoc( tokeninit(@cStr4, ":", 1 ) ) )
QOut( [ tokennum() == 5 ? ---------------------> ] + Str( tokennum() ) )
QOut( [ tokennext() == "08" ? ------------------> "] + tokennext( @cStr4 ) + ["] )
QOut( [ Now restore global token environment with resttoken and rewind it] )
resttoken( cTE1 )
tokeninit()
QOut( [ tokennum() == 6 ? ---------------------> ] + Str( tokennum() ) )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
WHILE( !tokenend() )
QOut( [ tokennext(@cStr1) ------------------> "] + tokennext( @cStr1 ) + ["] )
QOut( [ tokenend() ? -------------------------> ] + ltoc( tokenend() ) )
ENDDO
QOut( [ Release global TE with tokenexit() ----> ] + ltoc( tokenexit() ) )
QOut()
qout ("...Press any key...")
qout ()
inkey (0)
QOut( "...Press any key..." )
QOut()
Inkey( 0 )
qout ([ Now tokenize cStr4 := "]+cStr4+[" and])
qout ([ cStr5 := "]+cStr5+["])
qout ([ and store the token environment locally to cTE1 and cTE2:])
qout ([ tokeninit (@cStr4, ":", 1, @cTE1) == .T. ? -> ] + ltoc(tokeninit (@cStr4, ":", 1, @cTE1)))
qout ([ tokeninit (@cStr5, "+", 1, @cTE2) == .T. ? -> ] + ltoc(tokeninit (@cStr5, "+", 1, @cTE2)))
qout ([ tokennum (@cTE1) == 5 ? --------------------> ] + str(tokennum (@cTE1)))
qout ([ tokennum (@cTE2) == 4 ? --------------------> ] + str(tokennum (@cTE2)))
qout ([ tokenend (@cTE1) ? ---------------------> ] + ltoc (tokenend (@cTE1)))
qout ([ tokenend (@cTE2) ? ---------------------> ] + ltoc (tokenend (@cTE2)))
while (!tokenend (@cTE1) .AND. !tokenend (@cTE2))
qout ([ next train at ]+tokennext (cStr4,,@cTE1)+":"+tokennext (cStr5,,@cTE2))
qout ([ compiled with tokennext (cStr4,,@cTE1)+":"+tokennext (cStr5,,@cTE2)])
qout ([ tokenend (@cTE1) ? ---------------------> ] + ltoc (tokenend (@cTE1)))
qout ([ tokenend (@cTE2) ? ---------------------> ] + ltoc (tokenend (@cTE2)))
enddo
QOut( [ Now tokenize cStr4 := "] + cStr4 + [" and] )
QOut( [ cStr5 := "] + cStr5 + ["] )
QOut( [ and store the token environment locally to cTE1 and cTE2:] )
QOut( [ tokeninit(@cStr4, ":", 1, @cTE1) == .T. ? -> ] + ltoc( tokeninit(@cStr4, ":", 1, @cTE1 ) ) )
QOut( [ tokeninit(@cStr5, "+", 1, @cTE2) == .T. ? -> ] + ltoc( tokeninit(@cStr5, "+", 1, @cTE2 ) ) )
QOut( [ tokennum(@cTE1) == 5 ? --------------------> ] + Str( tokennum(@cTE1 ) ) )
QOut( [ tokennum(@cTE2) == 4 ? --------------------> ] + Str( tokennum(@cTE2 ) ) )
QOut( [ tokenend(@cTE1) ? ---------------------> ] + ltoc( tokenend(@cTE1 ) ) )
QOut( [ tokenend(@cTE2) ? ---------------------> ] + ltoc( tokenend(@cTE2 ) ) )
WHILE( !tokenend( @cTE1 ) .AND. !tokenend( @cTE2 ) )
QOut( [ next train at ] + tokennext( cStr4,,@cTE1 ) + ":" + tokennext( cStr5,,@cTE2 ) )
QOut( [ compiled with tokennext(cStr4,,@cTE1)+":"+tokennext(cStr5,,@cTE2)] )
QOut( [ tokenend(@cTE1) ? ---------------------> ] + ltoc( tokenend(@cTE1 ) ) )
QOut( [ tokenend(@cTE2) ? ---------------------> ] + ltoc( tokenend(@cTE2 ) ) )
ENDDO
qout ("")
qout ("End test of incremental tokenizer function family")
qout ()
qout ("...Press any key...")
qout ()
inkey (0)
ctexit()
return
QOut( "" )
QOut( "End test of incremental tokenizer function family" )
QOut()
QOut( "...Press any key..." )
QOut()
Inkey( 0 )
ctexit()
RETURN

63
harbour/contrib/hbct/tests/tokenlow.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function TOKENLOWER()
* Test CT3 function TOKENLOWER()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,45 +52,40 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
procedure main
ctinit()
local cStr := ".,.This.,.is.,.a.,.test!"
QOut( "Begin test of TOKENLOWER()" )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ tokenlower("Hello, World, here I am!") == "hello, world, here i am!" ?] )
QOut( [ -> "] + tokenlower( "Hello, World, here I am!" ) + ["] )
QOut( [ tokenlower("Hello, World, here I am!",,3) == "hello, world, here I am!" ?] )
QOut( [ -> "] + tokenlower( "Hello, World, here I am!",,3 ) + ["] )
QOut( [ tokenlower("Hello, World, here I am!",",",3) == "hello, World, here I am!" ?] )
QOut( [ -> "] + tokenlower( "Hello, World, here I am!",",",3 ) + ["] )
QOut( [ tokenlower("Hello, World, here I am!"," W") == "hello, World, here i am!" ?] )
QOut( [ -> "] + tokenlower( "Hello, World, here I am!"," W" ) + ["] )
QOut( "" )
qout ("Begin test of TOKENLOWER()")
qout ("")
// Some simple tests
qout (" Simple tests:")
qout ([ tokenlower("Hello, World, here I am!") == "hello, world, here i am!" ?])
qout ([ -> "] + tokenlower ("Hello, World, here I am!") + ["])
qout ([ tokenlower("Hello, World, here I am!",,3) == "hello, world, here I am!" ?])
qout ([ -> "] + tokenlower ("Hello, World, here I am!",,3) + ["])
qout ([ tokenlower("Hello, World, here I am!",",",3) == "hello, World, here I am!" ?])
qout ([ -> "] + tokenlower ("Hello, World, here I am!",",",3) + ["])
qout ([ tokenlower("Hello, World, here I am!"," W") == "hello, World, here i am!" ?])
qout ([ -> "] + tokenlower ("Hello, World, here I am!"," W") + ["])
qout ("")
qout ([ Lowercase the tokens in the string "]+cStr+["])
qout ([ with csetref (.T.) and "@"])
csetref (.T.)
qout ("")
qout ([ --> return value of tokenlower (@cStr): ],tokenlower(@cStr))
qout ([ --> cStr is now: "]+cStr+["])
qout ("")
qout ("End test of TOKENLOWER()")
qout ()
ctexit()
return
QOut( [ Lowercase the tokens in the string "] + cStr + ["] )
QOut( [ with csetref(.T.) and "@"] )
csetref( .T. )
QOut( "" )
QOut( [ --> return value of tokenlower(@cStr): ], tokenlower( @cStr ) )
QOut( [ --> cStr is now: "] + cStr + ["] )
QOut( "" )
QOut( "End test of TOKENLOWER()" )
QOut()
ctexit()
RETURN

63
harbour/contrib/hbct/tests/tokensep.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function TOKENSEP()
* Test CT3 function TOKENSEP()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,45 +52,40 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
LOCAL ni
procedure main
ctinit()
local cStr := ".,.This.,.is.,.a.,.test!"
local ni
QOut( "Begin test of TOKENSEP()" )
QOut( "" )
ctinit()
// Some simple tests
QOut( [ Tokenizing the string "] + cStr + ["] )
QOut( [ with skip width == 1 and ".,!" as tokenizer list:] )
QOut( "" )
for ni := 1 TO numtoken( cStr, ".,!", 1 )
QOut( [ Token #] + AllTrim( Str(ni ) ) + [("] + token( cStr, ".,!", ni, 1 ) + ;
[") is tokenized by "] + tokensep( .F. ) + [" and "] + tokensep( .T. ) + ["] )
next ni
qout ("Begin test of TOKENSEP()")
qout ("")
// Some simple tests
qout ([ Tokenizing the string "]+cStr+["])
qout ([ with skip width == 1 and ".,!" as tokenizer list:])
qout ("")
for ni := 1 to numtoken (cStr, ".,!", 1)
qout ([ Token #]+alltrim(str(ni))+[ ("]+token(cStr, ".,!", ni, 1)+;
[") is tokenized by "]+tokensep(.F.)+[" and "]+tokensep(.T.)+["])
next ni
qout ("")
qout ([ Tokenizing the string "]+cStr+["])
qout ([ with skip width == 3 and ".,!" as tokenizer list:])
qout ("")
for ni := 1 to numtoken (cStr, ".,!", 3)
qout ([ Token #]+alltrim(str(ni))+[ ("]+token(cStr, ".,!", ni, 3)+;
[") is tokenized by "]+tokensep(.F.)+[" and "]+tokensep(.T.)+["])
next ni
qout ("")
qout ("End test of TOKENSEP()")
qout ()
ctexit()
return
QOut( "" )
QOut( [ Tokenizing the string "] + cStr + ["] )
QOut( [ with skip width == 3 and ".,!" as tokenizer list:] )
QOut( "" )
for ni := 1 TO numtoken( cStr, ".,!", 3 )
QOut( [ Token #] + AllTrim( Str(ni ) ) + [("] + token( cStr, ".,!", ni, 3 ) + ;
[") is tokenized by "] + tokensep( .F. ) + [" and "] + tokensep( .T. ) + ["] )
next ni
QOut( "" )
QOut( "End test of TOKENSEP()" )
QOut()
ctexit()
RETURN

63
harbour/contrib/hbct/tests/tokenupp.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function TOKENUPPER()
* Test CT3 function TOKENUPPER()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,45 +52,40 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
procedure main
ctinit()
local cStr := ".,.This.,.is.,.a.,.test!"
QOut( "Begin test of TOKENUPPER()" )
QOut( "" )
ctinit()
// Some simple tests
QOut( " Simple tests:" )
QOut( [ tokenupper("Hello, world, here I am!") == "Hello, World, Here I Am!" ?] )
QOut( [ -> "] + tokenupper( "Hello, world, here I am!" ) + ["] )
QOut( [ tokenupper("Hello, world, here I am!",,3) == "Hello, World, Here I am!" ?] )
QOut( [ -> "] + tokenupper( "Hello, world, here I am!",,3 ) + ["] )
QOut( [ tokenupper("Hello, world, here I am!",",",3) == "Hello, world, here I am!" ?] )
QOut( [ -> "] + tokenupper( "Hello, world, here I am!",",",3 ) + ["] )
QOut( [ tokenupper("Hello, world, here I am!"," w") == "Hello, wOrld, Here I Am!" ?] )
QOut( [ -> "] + tokenupper( "Hello, world, here I am!"," w" ) + ["] )
QOut( "" )
qout ("Begin test of TOKENUPPER()")
qout ("")
// Some simple tests
qout (" Simple tests:")
qout ([ tokenupper("Hello, world, here I am!") == "Hello, World, Here I Am!" ?])
qout ([ -> "] + tokenupper ("Hello, world, here I am!") + ["])
qout ([ tokenupper("Hello, world, here I am!",,3) == "Hello, World, Here I am!" ?])
qout ([ -> "] + tokenupper ("Hello, world, here I am!",,3) + ["])
qout ([ tokenupper("Hello, world, here I am!",",",3) == "Hello, world, here I am!" ?])
qout ([ -> "] + tokenupper ("Hello, world, here I am!",",",3) + ["])
qout ([ tokenupper("Hello, world, here I am!"," w") == "Hello, wOrld, Here I Am!" ?])
qout ([ -> "] + tokenupper ("Hello, world, here I am!"," w") + ["])
qout ("")
qout ([ Uppercase the tokens in the string "]+cStr+["])
qout ([ with csetref (.T.) and "@"])
csetref (.T.)
qout ("")
qout ([ --> return value of tokenupper (@cStr): ],tokenupper(@cStr))
qout ([ --> cStr is now: "]+cStr+["])
qout ("")
qout ("End test of TOKENUPPER()")
qout ()
ctexit()
return
QOut( [ Uppercase the tokens in the string "] + cStr + ["] )
QOut( [ with csetref(.T.) and "@"] )
csetref( .T. )
QOut( "" )
QOut( [ --> return value of tokenupper(@cStr): ], tokenupper( @cStr ) )
QOut( [ --> cStr is now: "] + cStr + ["] )
QOut( "" )
QOut( "End test of TOKENUPPER()" )
QOut()
ctexit()
RETURN

356
harbour/contrib/hbct/tests/trig.prg
View File

@@ -4,24 +4,20 @@
/*
* Harbour Project source code:
*
* Test CT3 TRIGONOMETRIC functions - PART 1
*
* - PI
* - SIN
* - COS
* - TAN
* - COT
* - ASIN
* - ACOS
* - ATAN
* - ATN2
* - SINH
* - COSH
* - TANH
*
* - PI
* - SIN
* - COS
* - TAN
* - COT
* - ASIN
* - ACOS
* - ATAN
* - ATN2
* - SINH
* - COSH
* - TANH
* Copyright 2001 Alejandro de garate <alex_degarate@hotmail.com>
*
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -65,176 +61,174 @@
*
*/
PROCEDURE Main()
LOCAL X, Y
CTINIT()
SET DECIMAL TO 14
CLS
? "Begin test of Trigonometric functions... "
?
? "PI = " + Str( PI(), 18, 15 )
? "STR( SIN( PI() /4 ), 18, 15 ) = 0.707106781186548 // CT3"
? Space( 32 ) + Str( SIN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() /2 ), 18, 15 ) = 1.000000000000000 // CT3"
? Space( 32 ) + Str( SIN( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() *99.5 ), 18, 15 ) = -1.000000000000000 // CT3"
? Space( 35 ) + Str( SIN( PI() * 99.5 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() /9 ), 18, 15 ) = 0.342020143325669 // CT3"
? Space( 32 ) + Str( SIN( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
WAIT4()
PROCEDURE MAIN
? "STR( COS( 0 ), 18, 15 ) = 1.000000000000000 // CT3"
? Space( 26 ) + Str( COS( 0 ), 18, 15 ) + " <-- CT for Harbour"
?
local X, Y
? "STR( COS( PI() /4 ), 18, 15 ) = 0.707106781186548 // CT3"
? Space( 32 ) + Str( COS( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
CTINIT()
? "STR( COS( PI() /2 ), 18, 15 ) = 0.000000000000000 // CT3"
? Space( 32 ) + Str( COS( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
SET DECIMAL TO 14
CLS
? "Begin test of Trigonometric functions... "
?
? "PI = " + STR( PI(), 18, 15 )
? "STR( COS( PI() *99.5 ), 18, 15 ) = 0.000000000000000 // CT3"
? Space( 34 ) + Str( COS( PI() * 99.5 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() /4 ), 18, 15 ) = 0.707106781186548 // CT3"
? SPACE(32) + STR( SIN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() /2 ), 18, 15 ) = 1.000000000000000 // CT3"
? SPACE(32) + STR( SIN( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() *99.5 ), 18, 15 ) = -1.000000000000000 // CT3"
? SPACE(35) + STR( SIN( PI() * 99.5 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SIN( PI() /9 ), 18, 15 ) = 0.342020143325669 // CT3"
? SPACE(32) + STR( SIN( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
WAIT4()
? "STR( COS( PI() /9 ), 18, 15 ) = 0.939692620785908 // CT3"
? Space( 32 ) + Str( COS( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COS( 0 ), 18, 15 ) = 1.000000000000000 // CT3"
? SPACE(26) + STR( COS( 0 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COS( PI() /4 ), 18, 15 ) = 0.707106781186548 // CT3"
? SPACE(32) + STR( COS( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COS( PI() /2 ), 18, 15 ) = 0.000000000000000 // CT3"
? SPACE(32) + STR( COS( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COS( PI() *99.5 ), 18, 15 ) = 0.000000000000000 // CT3"
? SPACE(34) + STR( COS( PI() *99.5), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COS( PI() /9 ), 18, 15 ) = 0.939692620785908 // CT3"
? SPACE(32) + STR( COS( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
?
WAIT4()
WAIT4()
? "STR( TAN( 0 ), 18, 15 ) = 1.000000000000000 // CT3 wrong ! "
? Space( 26 ) + Str( TAN( 0 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( TAN( PI() /4 ), 18, 15 ) = 1.000000000000000 // CT3"
? Space( 32 ) + Str( TAN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( TAN( PI() /9 ), 18, 15 ) = 0.363970234266202 // CT3"
? Space( 32 ) + Str( TAN( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
?
?
?
? "STR( ASIN( 0.5 ), 18, 15 ) = 0.523598775598299 // CT3"
? Space( 29 ) + Str( ASIN( 0.5 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( ACOS( 0.7 ), 18, 15 ) = 0.795398830184144 // CT3"
? Space( 29 ) + Str( ACOS( 0.7 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( ATAN( PI() /4 ), 18, 15 ) = 0.665773750028354 // CT3"
? Space( 33 ) + Str( ATAN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
WAIT4()
? "STR( TAN( 0 ), 18, 15 ) = 1.000000000000000 // CT3 wrong ! "
? SPACE(26) + STR( TAN( 0 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COT( PI() /4 ), 18, 15 ) = 1.000000000000000 // CT3"
? Space( 32 ) + Str( COT( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( TAN( PI() /4 ), 18, 15 ) = 1.000000000000000 // CT3"
? SPACE(32) + STR( TAN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COT( PI() /2 ), 18, 15 ) = 0.000000000000000 // CT3"
? Space( 32 ) + Str( COT( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( TAN( PI() /9 ), 18, 15 ) = 0.363970234266202 // CT3"
? SPACE(32) + STR( TAN( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
?
?
?
? "STR( COT( PI() /9 ), 18, 15 ) = 2.747477419454622 // CT3"
? Space( 32 ) + Str( COT( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( ASIN( 0.5 ), 18, 15 ) = 0.523598775598299 // CT3"
? SPACE(29) + STR( ASIN( 0.5 ), 18, 15 ) + " <-- CT for Harbour"
?
WAIT4()
? "STR( ACOS( 0.7 ), 18, 15 ) = 0.795398830184144 // CT3"
? SPACE(29) + STR( ACOS( 0.7 ), 18, 15 ) + " <-- CT for Harbour"
?
?? "Testing Hiperbolic Sine..."
?
? "STR( SINH( PI() /2 ), 18, 15 ) = 2.301298902307295 // CT3"
? Space( 33 ) + Str( SINH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( ATAN( PI() /4 ), 18, 15 ) = 0.665773750028354 // CT3"
? SPACE(33) + STR( ATAN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SINH( PI() /4 ), 18, 15 ) = 0.868670961486010 // CT3"
? Space( 33 ) + Str( SINH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
WAIT4()
? "Testing Hiperbolic Cosine..."
?
? "STR( COSH( PI() /2 ), 18, 15 ) = 2.509178478658057 // CT3"
? Space( 33 ) + Str( COSH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COSH( PI() /4 ), 18, 15 ) = 1.324609089252006 // CT3"
? Space( 33 ) + Str( COSH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "Testing Hiperbolic Tangent..."
?
? "STR( TANH( PI() /2 ), 18, 15 ) = 0.917152335667274 // CT3"
? Space( 33 ) + Str( TANH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( TANH( PI() /4 ), 18, 15 ) = 0.655794202632672 // CT3"
? Space( 33 ) + Str( TANH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
WAIT4()
? "Testing Degree TO Radian..."
?
? "STR( DTOR( 360), 18, 15 ) = 6.283185307179588 // CT3"
? Space( 27 ) + Str( DTOR( 360 ), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( 180), 18, 15 ) = 3.141592653589794 // CT3"
? Space( 27 ) + Str( DTOR( 180 ), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( 180.5), 18, 15 ) = 3.150319299849766 // CT3"
? Space( 29 ) + Str( DTOR( 180.5 ), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( 720), 18, 15 ) = 12.566370614359180 // CT3"
? Space( 28 ) + Str( DTOR( 720 ), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( -180), 18, 15 ) = -3.141592653589794 // CT3"
? Space( 29 ) + Str( DTOR( - 180 ), 18, 15 ), " <-- CT for Harbour "
WAIT4()
? "STR( COT( PI() /4 ), 18, 15 ) = 1.000000000000000 // CT3"
? SPACE(32) + STR( COT( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "Testing Radian TO Degree..."
?
? "RTOD( PI() ) = 180 // CT3 "
? Space( 7 ), RTOD( PI() ), " <-- CT for Harbour "
? "STR( COT( PI() /2 ), 18, 15 ) = 0.000000000000000 // CT3"
? SPACE(32) + STR( COT( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "RTOD( 2 * PI()) = 360 // CT3 "
? Space( 10 ), RTOD( 2 * PI() ), " <-- CT for Harbour "
? "STR( COT( PI() /9 ), 18, 15 ) = 2.747477419454622 // CT3"
? SPACE(32) + STR( COT( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour"
?
? "RTOD( 4 * PI()) = 720 // CT3 "
? Space( 10 ), RTOD( 4 * PI() ), " <-- CT for Harbour "
WAIT4()
? "RTOD( -PI() ) = -180 // CT3"
? Space( 9 ), RTOD( - PI() ), " <-- CT for Harbour "
?
?? "Testing Hiperbolic Sine..."
?
? "STR( SINH( PI() /2 ), 18, 15 ) = 2.301298902307295 // CT3"
? SPACE(33) + STR( SINH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( SINH( PI() /4 ), 18, 15 ) = 0.868670961486010 // CT3"
? SPACE(33) + STR( SINH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "Testing Hiperbolic Cosine..."
?
? "STR( COSH( PI() /2 ), 18, 15 ) = 2.509178478658057 // CT3"
? SPACE(33) + STR( COSH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( COSH( PI() /4 ), 18, 15 ) = 1.324609089252006 // CT3"
? SPACE(33) + STR( COSH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
? "Testing Hiperbolic Tangent..."
?
? "STR( TANH( PI() /2 ), 18, 15 ) = 0.917152335667274 // CT3"
? SPACE(33) + STR( TANH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour"
?
? "STR( TANH( PI() /4 ), 18, 15 ) = 0.655794202632672 // CT3"
? SPACE(33) + STR( TANH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour"
?
WAIT4()
? "Testing Degree TO Radian..."
?
? "STR( DTOR( 360), 18, 15 ) = 6.283185307179588 // CT3"
? SPACE(27) + STR( DTOR( 360), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( 180), 18, 15 ) = 3.141592653589794 // CT3"
? SPACE(27) + STR( DTOR( 180), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( 180.5), 18, 15 ) = 3.150319299849766 // CT3"
? SPACE(29) + STR( DTOR( 180.5), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( 720), 18, 15 ) = 12.566370614359180 // CT3"
? SPACE(28) + STR( DTOR( 720), 18, 15 ), " <-- CT for Harbour "
?
? "STR( DTOR( -180), 18, 15 ) = -3.141592653589794 // CT3"
? SPACE(29) + STR( DTOR( -180), 18, 15 ), " <-- CT for Harbour "
WAIT4()
? "Testing Radian TO Degree..."
?
? "RTOD( PI() ) = 180 // CT3 "
? SPACE(7), RTOD( PI() ), " <-- CT for Harbour "
? "RTOD( 2 * PI()) = 360 // CT3 "
? SPACE(10), RTOD( 2 * PI() ), " <-- CT for Harbour "
? "RTOD( 4 * PI()) = 720 // CT3 "
? SPACE(10), RTOD( 4 * PI() ), " <-- CT for Harbour "
? "RTOD( -PI() ) = -180 // CT3"
? SPACE(9), RTOD( -PI() ), " <-- CT for Harbour "
?
WAIT4()
WAIT4()
/* NOTE: ATN2( x, y) have the parameters inverted, when
@@ -242,29 +236,29 @@
*/
? "Testing ATN2( x, y )... where:"
? "Testing ATN2( x, y )... where:"
x := SIN( DTOR( 30 ) )
y := COS( DTOR( 30 ) )
? "x = SIN( DTOR( 30 ) ) =", x
? "y = COS( DTOR( 30 ) ) =", y
?
? "STR( ATN2( x, y ), 18, 15 ) = 0.523598775598299 // CT3"
? SPACE(31) + STR( ATN2( x, y), 18, 15 ) + " <-- CT for Harbour"
?
? "RTOD( ATN2( x, y)) ="+ STR( RTOD( ATN2( x,y)), 18,4) +" <-- CT for Harbour"
?
x := SIN( DTOR( 30 ) )
y := COS( DTOR( 30 ) )
? "x = SIN( DTOR( 30 ) ) =", x
? "y = COS( DTOR( 30 ) ) =", y
?
? "STR( ATN2( x, y ), 18, 15 ) = 0.523598775598299 // CT3"
? Space( 31 ) + Str( ATN2( x, y ), 18, 15 ) + " <-- CT for Harbour"
?
? "RTOD( ATN2( x, y)) =" + Str( RTOD( ATN2( x,y ) ), 18, 4 ) + " <-- CT for Harbour"
?
WAIT4()
WAIT4()
CTEXIT()
RETURN
CTEXIT()
RETURN
PROCEDURE WAIT4
? " PRESS ANY KEY"
INKEY(0)
CLS
RETURN
? " PRESS ANY KEY"
Inkey( 0 )
CLS
RETURN

36
harbour/contrib/hbct/tests/valpos.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function VALPOS()
* Test CT3 function VALPOS()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,30 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of VALPOS()")
qout ("")
qout ([ valpos ("1234x56789") == 9 ? --> ] + str (valpos ("1234x56789")))
qout ([ valpos ("1234x56789",1) == 1 ? --> ] + str (valpos ("1234x56789",1)))
qout ([ valpos ("1234x56789",11) == 0 ? --> ] + str (valpos ("1234x56789",11)))
qout ([ valpos ("1234x56789",5) == 0 ? --> ] + str (valpos ("1234x56789",5)))
qout ("")
qout ("End test of VALPOS()")
qout ("")
ctexit()
return
QOut( "Begin test of VALPOS()" )
QOut( "" )
QOut( [ valpos("1234x56789") == 9 ? --> ] + Str( valpos("1234x56789" ) ) )
QOut( [ valpos("1234x56789",1) == 1 ? --> ] + Str( valpos("1234x56789",1 ) ) )
QOut( [ valpos("1234x56789",11) == 0 ? --> ] + Str( valpos("1234x56789",11 ) ) )
QOut( [ valpos("1234x56789",5) == 0 ? --> ] + Str( valpos("1234x56789",5 ) ) )
QOut( "" )
QOut( "End test of VALPOS()" )
QOut( "" )
ctexit()
RETURN

38
harbour/contrib/hbct/tests/wordone.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function WORDONE()
* Test CT3 function WORDONE()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,25 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of WORDONE()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordone("12ABAB12") == "12AB12" ? --> "] + wordone("12ABAB12") + ["])
qout ([ wordone("1AAAA2") == "1AAAA2" ? --> "] + wordone("1AAAA2") + ["])
qout ([ wordone("12", "1212ABAB") == "12ABAB" ? --> "] + wordone("12", "1212ABAB") + ["])
qout ("")
qout ("End test of WORDONE()")
qout ("")
ctexit()
return
QOut( "Begin test of WORDONE()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ wordone("12ABAB12") == "12AB12" ? --> "] + wordone( "12ABAB12" ) + ["] )
QOut( [ wordone("1AAAA2") == "1AAAA2" ? --> "] + wordone( "1AAAA2" ) + ["] )
QOut( [ wordone("12", "1212ABAB") == "12ABAB" ? --> "] + wordone( "12", "1212ABAB" ) + ["] )
QOut( "" )
QOut( "End test of WORDONE()" )
QOut( "" )
ctexit()
RETURN

37
harbour/contrib/hbct/tests/wordonly.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function WORDONLY()
* Test CT3 function WORDONLY()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of WORDONLY()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordonly("AABBCCDD", "XXAAYYBBZZ") == "AABB" ? --> "] + wordonly("AABBCCDD", "XXAAYYBBZZ")+ ["])
qout ([ wordonly("AABBCCDD", "XAAYYYBBZZ") == "BB" ? ----> "] + wordonly("AABBCCDD", "XAAYYYBBZZ")+ ["])
qout ("")
qout ("End test of WORDONLY()")
qout ("")
ctexit()
return
QOut( "Begin test of WORDONLY()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ wordonly("AABBCCDD", "XXAAYYBBZZ") == "AABB" ? --> "] + wordonly( "AABBCCDD", "XXAAYYBBZZ" ) + ["] )
QOut( [ wordonly("AABBCCDD", "XAAYYYBBZZ") == "BB" ? ----> "] + wordonly( "AABBCCDD", "XAAYYYBBZZ" ) + ["] )
QOut( "" )
QOut( "End test of WORDONLY()" )
QOut( "" )
ctexit()
RETURN

38
harbour/contrib/hbct/tests/wordrem.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function WORDREM()
* Test CT3 function WORDREM()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,32 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
procedure main
ctinit()
qout ("Begin test of WORDREM()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordrem("abcd", "0ab1cd") == "0ab1" ? ----> "] + wordrem("abcd", "0ab1cd") + ["])
qout ([ wordrem("abcd", "ab0cd1") == "0cd1" ? ----> "] + wordrem("abcd", "ab0cd1") + ["])
qout ("")
qout ("End test of WORDREM()")
qout ("")
ctexit()
return
PROCEDURE Main()
ctinit()
QOut( "Begin test of WORDREM()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ wordrem("abcd", "0ab1cd") == "0ab1" ? ----> "] + wordrem( "abcd", "0ab1cd" ) + ["] )
QOut( [ wordrem("abcd", "ab0cd1") == "0cd1" ? ----> "] + wordrem( "abcd", "ab0cd1" ) + ["] )
QOut( "" )
QOut( "End test of WORDREM()" )
QOut( "" )
ctexit()
RETURN

50
harbour/contrib/hbct/tests/wordrepl.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function WORDREPL()
* Test CT3 function WORDREPL()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,39 +52,31 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of WORDREPL()")
qout ("")
// simple tests
qout (" Simple tests:")
qout ([ wordrepl("CC", "AABBCCDDEE", "XX") == "AABBXXDDEE"? --> "] + wordrepl("CC", "AABBCCDDEE", "XX")+ ["])
qout ([ wordrepl("aa", "1aaaa", "ba") == "1abaa" ? ------> "] + wordrepl("aa", "1aaaa", "ba") + ["])
qout ([ wordrepl("aa", "1aaaa", "ba", .T.) == "1baba" ? ------> "] + wordrepl("aa", "1aaaa", "ba", .T.)+ ["])
qout ("")
qout (" Testing CSETATMUPA(.T.) with lMode==.T.:")
csetatmupa(.T.)
qout ([ wordrepl("aa", "1aaaa", "ba") == "1abaa" ? --> "] + wordrepl("aa", "1aaaa", "ba") + ["])
qout ([ wordrepl("aa", "1aaaa", "ba", .T.) == "1bbba" ? --> "] + wordrepl("aa", "1aaaa", "ba", .T.)+ ["])
qout ("")
qout ("End test of WORDREPL()")
qout ("")
ctexit()
return
QOut( "Begin test of WORDREPL()" )
QOut( "" )
// simple tests
QOut( " Simple tests:" )
QOut( [ wordrepl("CC", "AABBCCDDEE", "XX") == "AABBXXDDEE"? --> "] + wordrepl( "CC", "AABBCCDDEE", "XX" ) + ["] )
QOut( [ wordrepl("aa", "1aaaa", "ba") == "1abaa" ? ------> "] + wordrepl( "aa", "1aaaa", "ba" ) + ["] )
QOut( [ wordrepl("aa", "1aaaa", "ba", .T.) == "1baba" ? ------> "] + wordrepl( "aa", "1aaaa", "ba", .T. ) + ["] )
QOut( "" )
QOut( " Testing CSETATMUPA(.T.) with lMode==.T.:" )
csetatmupa( .T. )
QOut( [ wordrepl("aa", "1aaaa", "ba") == "1abaa" ? --> "] + wordrepl( "aa", "1aaaa", "ba" ) + ["] )
QOut( [ wordrepl("aa", "1aaaa", "ba", .T.) == "1bbba" ? --> "] + wordrepl( "aa", "1aaaa", "ba", .T. ) + ["] )
QOut( "" )
QOut( "End test of WORDREPL()" )
QOut( "" )
ctexit()
RETURN

37
harbour/contrib/hbct/tests/wordswap.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* Test CT3 function WORDSWAP()
* Test CT3 function WORDSWAP()
*
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
@@ -52,31 +52,24 @@
*
*/
#include "ct.ch"
#include "../ct.ch"
PROCEDURE Main()
ctinit()
procedure main
ctinit()
qout ("Begin test of WORDSWAP()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ wordswap("1234567890") == "3412785690" ? --> "] + wordswap("1234567890") + ["])
qout ([ wordswap("1234567890", .t.) == "4321876590" ? --> "] + wordswap("1234567890", .t.)+ ["])
qout ("")
qout ("End test of WORDSWAP()")
qout ("")
ctexit()
return
QOut( "Begin test of WORDSWAP()" )
QOut( "" )
// simple tests
QOut( "Simple tests:" )
QOut( [ wordswap("1234567890") == "3412785690" ? --> "] + wordswap( "1234567890" ) + ["] )
QOut( [ wordswap("1234567890", .t.) == "4321876590" ? --> "] + wordswap( "1234567890", .T. ) + ["] )
QOut( "" )
QOut( "End test of WORDSWAP()" )
QOut( "" )
ctexit()
RETURN

318
harbour/tests/stripem.prg
View File

@@ -1,8 +1,9 @@
//
// $Id$
//
/*
* $Id$
*/
#include "set.ch"
#xtranslate Default( <Var>, <xVal> ) => IIF( <Var> == NIL, <xVal>, <Var> )
//
@@ -26,43 +27,44 @@
* Placed in the public domain
*/
function Main( cFrom, cTo )
FUNCTION Main( cFrom, cTo )
local oFrom
local oTo
local cOut
LOCAL oFrom
LOCAL oTo
LOCAL cOut
set( _SET_EXACT, .T.)
SET( _SET_EXACT, .T. )
cFrom := Default( cFrom, "strip.prg" )
cTo := Default( cTo, "strip.out" )
oFrom := TTextFile()
// Debug( __objGetMethodList( oFrom ) )
// Debug( __objGetMethodList( oFrom ) )
oFrom:New( cFrom, "R" )
oTo := TTextFile()
// Debug( __objGetMethodList( oTo ) )
// Debug( __objGetMethodList( oTo ) )
oTo:New( cTo , "W" )
do while !oFrom:EoF()
DO WHILE !oFrom:EOF()
cOut := oFrom:Run()
if alltrim(cOut) != ""
IF AllTrim( cOut ) != ""
oTo:Run( cOut )
endif
enddo
ENDIF
ENDDO
QOut( "Number of lines", oTo:nLine )
oFrom:Dispose()
oTo:Dispose()
return nil
RETURN nil
//
// Generic DOS file handler
//
function TTextFile() // Parameter = dirty
//
// Generic DOS file handler
//
static oFile := NIL
FUNCTION TTextFile() // Parameter = dirty
if oFile == NIL
STATIC oFile := NIL
IF oFile == NIL
oFile := HBClass():New( "TTEXTFILE" ) // Create a new class def
oFile:AddData( "cFileName" ) // Filename spec. by user
@@ -73,7 +75,7 @@ function TTextFile() // Parameter = dirty
oFile:AddData( "cBlock" ) // Storage block
oFile:AddData( "nBlockSize" ) // Size of read-ahead buffer
oFile:AddData( "cMode" ) // Mode of file use
// R = read, W = write
// R = read, W = write
oFile:AddMethod( "New" , @New() ) // Constructor
oFile:AddMethod( "Dispose", @Dispose() ) // Clean up code
@@ -82,26 +84,27 @@ function TTextFile() // Parameter = dirty
oFile:AddMethod( "Goto" , @Goto() ) // Go to line
oFile:AddInline( "Run" , ; // Get/set data
{|self,xTxt,lCRLF|iif( ::cMode == "R",::Read(),::WriteLn(xTxt, lCRLF)) } )
oFile:AddInline( "Write" , {|self, xTxt|::WriteLn( xTxt, .F. ) } )
// Write without CR
oFile:AddInline( "EoF" , {|self|::lEoF} )
// End of file as function
{ |self, xTxt, lCRLF|iif( ::cMode == "R", ::Read(), ::WriteLn( xTxt, lCRLF ) ) } )
oFile:AddInline( "Write" , { |self, xTxt|::WriteLn( xTxt, .F. ) } )
// Write without CR
oFile:AddInline( "EoF" , { |self|::lEoF } )
// End of file as function
oFile:Create()
endif
return oFile:Instance()
ENDIF
RETURN oFile:Instance()
//
// Method TextFile:New -> Create a new text file
//
// <cFile> file name. No wild characters
// <cMode> mode for opening. Default "R"
// <nBlockSize> Optional maximum blocksize
//
function New( cFileName, cMode, nBlock )
//
// Method TextFile:New -> Create a new text file
//
// <cFile> file name. No wild characters
// <cMode> mode for opening. Default "R"
// <nBlockSize> Optional maximum blocksize
//
local self := QSelf() // Get self
FUNCTION New( cFileName, cMode, nBlock )
LOCAL self := QSelf() // Get self
::nLine := 0
::lEoF := .F.
@@ -110,183 +113,186 @@ function New( cFileName, cMode, nBlock )
::cMode := Default( cMode, "R" )
if ::cMode == "R"
::hFile := fOpen( cFileName )
::hFile := FOpen( cFileName )
elseif ::cMode == "W"
::hFile := fCreate( cFileName )
else
::hFile := FCreate( cFileName )
ELSE
QOut( "DosFile Init: Unknown file mode:", ::cMode )
endif
ENDIF
::nError := fError()
::nError := FError()
if ::nError != 0
::lEoF := .T.
QOut( "Error ", ::nError)
endif
QOut( "Error ", ::nError )
ENDIF
::nBlockSize := Default( nBlock, 4096 )
return self
RETURN self
//
// Dispose -> Close the file handle
//
//
// Dispose -> Close the file handle
//
function Dispose()
FUNCTION Dispose()
local self := QSelf()
LOCAL self := QSelf()
::cBlock := NIL
if ::hFile != -1
if ::cMode == "W" .and. ::nError != 0
::Write( Chr(26) ) // Do not forget EOF marker
endif
if !fClose(::hFile)
::nError := fError()
QOut( "Dos Error closing ", ::cFileName, " Code ", ::nError)
endif
endif
return self
if ::hFile != - 1
if ::cMode == "W" .AND. ::nError != 0
::Write( Chr( 26 ) ) // Do not forget EOF marker
ENDIF
IF !FClose( ::hFile )
::nError := FError()
QOut( "Dos Error closing ", ::cFileName, " Code ", ::nError )
ENDIF
ENDIF
RETURN self
//
// Read a single line
//
function Read()
//
// Read a single line
//
local self := QSelf()
local cRet := ""
local cBlock
local nCrPos
local nEoFPos
local nRead
FUNCTION READ()
if ::hFile == -1
LOCAL self := QSelf()
LOCAL cRet := ""
LOCAL cBlock
LOCAL nCrPos
LOCAL nEoFPos
LOCAL nRead
if ::hFile == - 1
QOut( "DosFile:Read : No file open" )
elseif ::cMode != "R"
QOut( "File ", ::cFileName, " not open for reading" )
elseif !::lEoF
ELSEIF !::lEoF
if Len(::cBlock) == 0 // Read new block
cBlock := fReadStr( ::hFile, ::nBlockSize )
if len(cBlock) == 0
::nError := fError() // Error or EOF
IF Len( ::cBlock ) == 0 // Read new block
cBlock := FReadStr( ::hFile, ::nBlockSize )
IF Len( cBlock ) == 0
::nError := FError() // Error or EOF
::lEoF := .T.
else
ELSE
::cBlock := cBlock
endif
endif
ENDIF
ENDIF
if !::lEoF
IF !::lEoF
::nLine := ::nLine + 1 // ++ not available
nCRPos := At(Chr(10), ::cBlock)
if nCRPos != 0 // More than one line read
cRet := Substr( ::cBlock, 1, nCRPos - 1)
::cBlock := Substr( ::cBlock, nCRPos + 1)
else // No complete line
nCRPos := At( Chr( 10 ), ::cBlock )
IF nCRPos != 0 // More than one line read
cRet := SubStr( ::cBlock, 1, nCRPos - 1 )
::cBlock := SubStr( ::cBlock, nCRPos + 1 )
ELSE // No complete line
cRet := ::cBlock
::cBlock := ""
cRet += ::Read() // Read the rest
if !::lEoF
IF !::lEoF
::nLine := ::nLine - 1 // Adjust erroneous line count
endif
endif
nEoFPos := At( Chr(26), cRet )
if nEoFPos != 0 // End of file read
cRet := Substr( cRet, 1, nEoFPos-1 )
ENDIF
ENDIF
nEoFPos := At( Chr( 26 ), cRet )
IF nEoFPos != 0 // End of file read
cRet := SubStr( cRet, 1, nEoFPos - 1 )
::lEoF := .T.
endif
cRet := Strtran( cRet, Chr(13), "" ) // Remove CR
endif
endif
return cRet
ENDIF
cRet := StrTran( cRet, Chr( 13 ), "" ) // Remove CR
ENDIF
ENDIF
RETURN cRet
//
// WriteLn -> Write a line to a file
//
// <xTxt> Text to write. May be any type. May also be an array containing
// one or more strings
// <lCRLF> End with Carriage Return/Line Feed (Default == TRUE)
//
function WriteLn( xTxt, lCRLF )
//
// WriteLn -> Write a line to a file
//
// <xTxt> Text to write. May be any type. May also be an array containing
// one or more strings
// <lCRLF> End with Carriage Return/Line Feed (Default == TRUE)
//
local self := QSelf()
local cBlock
FUNCTION WriteLn( xTxt, lCRLF )
if ::hFile == -1
LOCAL self := QSelf()
LOCAL cBlock
if ::hFile == - 1
QOut( "DosFile:Write : No file open" )
elseif ::cMode != 'W'
QOut( "File ", ::cFileName," not opened for writing" )
else
QOut( "File ", ::cFileName, " not opened for writing" )
ELSE
cBlock := ToChar( xTxt ) // Convert to string
if Default( lCRLF, .T. )
cBlock += Chr(10) // +chr(13) ??
endif
fWrite( ::hFile, cBlock, len(cBlock) )
if fError() != 0
::nError := fError() // Not completely written !
endif
IF DEFAULT( lCRLF, .T. )
cBlock += Chr( 10 ) // +chr(13) ??
ENDIF
FWrite( ::hFile, cBlock, Len( cBlock ) )
IF FError() != 0
::nError := FError() // Not completely written !
ENDIF
::nLine := ::nLine + 1
endif
return self
ENDIF
RETURN self
//
// Go to a specified line number
//
function Goto( nLine )
//
// Go to a specified line number
//
local self := QSelf()
local nWhere := 1
FUNCTION GOTO( nLine )
if Empty(::hFile)
LOCAL self := QSelf()
LOCAL nWhere := 1
IF Empty( ::hFile )
QOut( "DosFile:Goto : No file open" )
elseif ::cMode != "R"
QOut( "File ", ::cFileName, " not open for reading" )
else
ELSE
::lEoF := .F. // Clear (old) End of file
::nLine := 0 // Start at beginning
::cBlock := ""
fSeek(::hFile, 0) // Go top
do while !::lEoF .and. nWhere < nLine
nWhere++
FSeek( ::hFile, 0 ) // Go top
DO WHILE !::lEoF .AND. nWhere < nLine
nWhere ++
::Run()
enddo
endif
return !::lEoF
ENDDO
ENDIF
function ToChar( xVal )
RETURN !::lEoF
local cType := ValType( xVal )
FUNCTION ToChar( xVal )
do case
case cType == 'U'
return "NIL"
LOCAL cType := ValType( xVal )
case cType == 'A'
return "{}"
DO CASE
CASE cType == 'U'
RETURN "NIL"
case cType == 'B'
return "{|| }"
CASE cType == 'A'
RETURN "{}"
case cType == 'C'
return xVal
CASE cType == 'B'
RETURN "{|| }"
case cType == 'D'
return dtoc( xVal )
CASE cType == 'C'
RETURN xVal
case cType == 'L'
return IIF( xVal, ".T.", ".F." )
CASE cType == 'D'
RETURN DToC( xVal )
case cType == 'M'
return xVal
CASE cType == 'L'
RETURN IIF( xVal, ".T.", ".F." )
case cType == 'N'
return Str( xVal )
CASE cType == 'M'
RETURN xVal
case cType == 'O'
return "{::}"
CASE cType == 'N'
RETURN Str( xVal )
endcase
CASE cType == 'O'
RETURN "{::}"
return "?"
ENDCASE
RETURN "?"

172
harbour/tests/testbrw.prg
View File

@@ -2,24 +2,24 @@
* $Id$
*/
// Harbour Class TBrowse and TBColumn sample
// Harbour Class TBrowse and TBColumn sample
#include "inkey.ch"
function Main()
FUNCTION Main()
local oBrowse := TBrowseNew( 5, 5, 16, 30 )
local aTest0 := { "This", "is", "a", "browse", "on", "an", "array", "test", "with", "a", "long", "data" }
local aTest1 := { 1, 2, 3, 4, 5, 6, 7, 8, 10000, -1000, 54, 456342 }
local aTest2 := { date(), date()+4, date()+56, date()+14, date()+5, date()+6, date()+7, date()+8, date()+10000, date()-1000, date()-54, date()+456342 }
local aTest3 := { .t., .f., .t., .t., .f., .f., .t., .f., .t., .t., .f., .f. }
local n := 1
local nKey
local lEnd := .f.
local nCursor
local cColor
local nRow, nCol
local nTmpRow, nTmpCol
LOCAL oBrowse := TBRowseNew( 5, 5, 16, 30 )
LOCAL aTest0 := { "This", "is", "a", "browse", "on", "an", "array", "test", "with", "a", "long", "data" }
LOCAL aTest1 := { 1, 2, 3, 4, 5, 6, 7, 8, 10000, - 1000, 54, 456342 }
LOCAL aTest2 := { Date(), Date() + 4, Date() + 56, Date() + 14, Date() + 5, Date() + 6, Date() + 7, Date() + 8, Date() + 10000, Date() - 1000, Date() - 54, Date() + 456342 }
LOCAL aTest3 := { .T. , .F. , .T. , .T. , .F. , .F. , .T. , .F. , .T. , .T. , .F. , .F. }
LOCAL n := 1
LOCAL nKey
LOCAL lEnd := .F.
LOCAL nCursor
LOCAL cColor
LOCAL nRow, nCol
LOCAL nTmpRow, nTmpCol
oBrowse:colorSpec := "W+/B, N/BG"
oBrowse:ColSep := "³"
@@ -27,24 +27,24 @@ function Main()
oBrowse:FootSep := "ÏÍ"
oBrowse:GoTopBlock := { || n := 1 }
oBrowse:GoBottomBlock := { || n := Len( aTest0 ) }
oBrowse:SkipBlock := { | nSkip, nPos | nPos := n,;
n := iif( nSkip > 0, Min( Len( aTest0 ), n + nSkip ),;
Max( 1, n + nSkip )), n - nPos }
oBrowse:SkipBlock := { | nSkip, nPos | nPos := n, ;
n := iif( nSkip > 0, Min( Len( aTest0 ), n + nSkip ), ;
Max( 1, n + nSkip ) ), n - nPos }
oBrowse:AddColumn( TBColumnNew( "First", { || n } ) )
oBrowse:AddColumn( TBColumnNew( "Second", { || aTest0[ n ] } ) )
oBrowse:AddColumn( TBColumnNew( "Third", { || aTest1[ n ] } ) )
oBrowse:AddColumn( TBColumnNew( "Forth", { || aTest2[ n ] } ) )
oBrowse:AddColumn( TBColumnNew( "Fifth", { || aTest3[ n ] } ) )
oBrowse:GetColumn(1):Footing := 'Number'
oBrowse:GetColumn(2):Footing := 'Strins'
oBrowse:GetColumn( 1 ):Footing := 'Number'
oBrowse:GetColumn( 2 ):Footing := 'Strins'
oBrowse:GetColumn(2):Picture := '@!'
oBrowse:GetColumn( 2 ):Picture := '@!'
oBrowse:GetColumn(3):Footing := 'Number'
oBrowse:GetColumn(3):Picture := '999,999.99'
oBrowse:GetColumn(4):Footing := 'Dates'
oBrowse:GetColumn(5):Footing := 'Logical'
oBrowse:GetColumn( 3 ):Footing := 'Number'
oBrowse:GetColumn( 3 ):Picture := '999,999.99'
oBrowse:GetColumn( 4 ):Footing := 'Dates'
oBrowse:GetColumn( 5 ):Footing := 'Logical'
// needed since I've changed some columns _after_ I've added them to TBrowse object
oBrowse:Configure()
@@ -56,75 +56,75 @@ function Main()
cColor := SetColor( "W+/B" )
nRow := Row()
nCol := Col()
@ 4,4,17,31 BOX "ÚÄ¿³ÙÄÀ³ "
@ 4, 4, 17, 31 BOX "ÚÄ¿³ÙÄÀ³ "
#ifdef HB_COMPAT_C53
oBrowse:Setkey(0,{|ob,nkey| Defproc(ob,nKey)})
while .t.
oBrowse:ForceStable()
if (oBrowse:applykey(inkey(0))== -1)
exit
endif
enddo
oBrowse:SetKey( 0, { |ob, nkey| Defproc( ob,nKey ) } )
WHILE .T.
oBrowse:ForceStable()
IF ( oBrowse:applykey( Inkey(0 ) ) == - 1 )
EXIT
ENDIF
ENDDO
#else
While !lEnd
WHILE !lEnd
oBrowse:ForceStable()
nKey := InKey( 0 )
nKey := Inkey( 0 )
do case
case nKey == K_ESC
SetPos( 17, 0 )
lEnd := .t.
DO CASE
CASE nKey == K_ESC
SetPos( 17, 0 )
lEnd := .T.
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()
case nKey == K_CTRL_PGUP
oBrowse:goTop()
CASE nKey == K_CTRL_PGUP
oBrowse:goTop()
case nKey == K_CTRL_PGDN
oBrowse:goBottom()
CASE nKey == K_CTRL_PGDN
oBrowse:goBottom()
case nKey == K_HOME
oBrowse:home()
CASE nKey == K_HOME
oBrowse:home()
case nKey == K_END
oBrowse:end()
CASE nKey == K_END
oBrowse:end()
case nKey == K_CTRL_LEFT
oBrowse:panLeft()
CASE nKey == K_CTRL_LEFT
oBrowse:panLeft()
case nKey == K_CTRL_RIGHT
oBrowse:panRight()
CASE nKey == K_CTRL_RIGHT
oBrowse:panRight()
case nKey == K_CTRL_HOME
oBrowse:panHome()
CASE nKey == K_CTRL_HOME
oBrowse:panHome()
case nKey == K_CTRL_END
oBrowse:panEnd()
CASE nKey == K_CTRL_END
oBrowse:panEnd()
case nKey == K_TAB
nTmpRow := ROW()
nTmpCol := COL()
@ 0, 0 SAY TIME()
DevPos( nTmpRow, nTmpCol )
CASE nKey == K_TAB
nTmpRow := Row()
nTmpCol := Col()
@ 0, 0 SAY Time()
DevPos( nTmpRow, nTmpCol )
endcase
ENDCASE
end
#endif
@@ -132,16 +132,22 @@ While !lEnd
SetColor( cColor )
SetCursor( nCursor )
return nil
RETURN nil
#ifdef HB_COMPAT_C53
function defproc(ob,nkey)
Local nTmpRow,nTmpCol
if nKey == K_TAB
nTmpRow := ROW()
nTmpCol := COL()
@ 0, 0 SAY TIME()
DevPos( nTmpRow, nTmpCol )
ob:Refreshall()
endif
return 1
FUNCTION defproc( ob, nkey )
LOCAL nTmpRow, nTmpCol
IF nKey == K_TAB
nTmpRow := Row()
nTmpCol := Col()
@ 0, 0 SAY Time()
DevPos( nTmpRow, nTmpCol )
ob:Refreshall()
ENDIF
RETURN 1
#endif