From 62b27c73bb35e4e885bd5f8509fb4a42022e0944 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 17 Jul 2012 20:34:29 +0000 Subject: [PATCH] 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 --- harbour/ChangeLog | 66 + harbour/contrib/hbct/tests/addascii.prg | 98 +- harbour/contrib/hbct/tests/afteratn.prg | 97 +- harbour/contrib/hbct/tests/asciisum.prg | 34 +- harbour/contrib/hbct/tests/ascpos.prg | 34 +- harbour/contrib/hbct/tests/atadjust.prg | 84 +- harbour/contrib/hbct/tests/atnum.prg | 97 +- harbour/contrib/hbct/tests/atrepl.prg | 41 +- harbour/contrib/hbct/tests/attoken.prg | 61 +- harbour/contrib/hbct/tests/beforatn.prg | 97 +- harbour/contrib/hbct/tests/charadd.prg | 38 +- harbour/contrib/hbct/tests/charand.prg | 33 +- harbour/contrib/hbct/tests/chareven.prg | 36 +- harbour/contrib/hbct/tests/charhist.prg | 40 +- harbour/contrib/hbct/tests/charlist.prg | 34 +- harbour/contrib/hbct/tests/charmirr.prg | 36 +- harbour/contrib/hbct/tests/charmix.prg | 42 +- harbour/contrib/hbct/tests/charnlst.prg | 34 +- harbour/contrib/hbct/tests/charnot.prg | 59 +- harbour/contrib/hbct/tests/charodd.prg | 34 +- harbour/contrib/hbct/tests/charone.prg | 42 +- harbour/contrib/hbct/tests/charonly.prg | 37 +- harbour/contrib/hbct/tests/charor.prg | 32 +- harbour/contrib/hbct/tests/charrem.prg | 37 +- harbour/contrib/hbct/tests/charrepl.prg | 43 +- harbour/contrib/hbct/tests/charrll.prg | 58 +- harbour/contrib/hbct/tests/charrlr.prg | 55 +- harbour/contrib/hbct/tests/charshl.prg | 58 +- harbour/contrib/hbct/tests/charshr.prg | 59 +- harbour/contrib/hbct/tests/charslst.prg | 34 +- harbour/contrib/hbct/tests/charsort.prg | 51 +- harbour/contrib/hbct/tests/charsub.prg | 36 +- harbour/contrib/hbct/tests/charswap.prg | 37 +- harbour/contrib/hbct/tests/charxor.prg | 35 +- harbour/contrib/hbct/tests/csetarge.prg | 398 ++-- harbour/contrib/hbct/tests/csetatmu.prg | 28 +- harbour/contrib/hbct/tests/csetref.prg | 28 +- harbour/contrib/hbct/tests/ctwtest.prg | 188 +- harbour/contrib/hbct/tests/datetime.prg | 2201 ++++++++++++----------- harbour/contrib/hbct/tests/expomant.prg | 23 +- harbour/contrib/hbct/tests/finan.prg | 89 +- harbour/contrib/hbct/tests/math.prg | 178 +- harbour/contrib/hbct/tests/num1.prg | 104 +- harbour/contrib/hbct/tests/numtoken.prg | 55 +- harbour/contrib/hbct/tests/rangerem.prg | 40 +- harbour/contrib/hbct/tests/rangerep.prg | 40 +- harbour/contrib/hbct/tests/setatlik.prg | 44 +- harbour/contrib/hbct/tests/strdiff.prg | 40 +- harbour/contrib/hbct/tests/tab.prg | 182 +- harbour/contrib/hbct/tests/token.prg | 79 +- harbour/contrib/hbct/tests/token2.prg | 209 ++- harbour/contrib/hbct/tests/tokenlow.prg | 63 +- harbour/contrib/hbct/tests/tokensep.prg | 63 +- harbour/contrib/hbct/tests/tokenupp.prg | 63 +- harbour/contrib/hbct/tests/trig.prg | 356 ++-- harbour/contrib/hbct/tests/valpos.prg | 36 +- harbour/contrib/hbct/tests/wordone.prg | 38 +- harbour/contrib/hbct/tests/wordonly.prg | 37 +- harbour/contrib/hbct/tests/wordrem.prg | 38 +- harbour/contrib/hbct/tests/wordrepl.prg | 50 +- harbour/contrib/hbct/tests/wordswap.prg | 37 +- harbour/tests/stripem.prg | 318 ++-- harbour/tests/testbrw.prg | 172 +- 63 files changed, 3349 insertions(+), 3557 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 588cfe2884..3cd079cf21 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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. diff --git a/harbour/contrib/hbct/tests/addascii.prg b/harbour/contrib/hbct/tests/addascii.prg index 8b89d520ae..aa6cb37a6f 100644 --- a/harbour/contrib/hbct/tests/addascii.prg +++ b/harbour/contrib/hbct/tests/addascii.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/afteratn.prg b/harbour/contrib/hbct/tests/afteratn.prg index 34a53c60fe..ff3719d877 100644 --- a/harbour/contrib/hbct/tests/afteratn.prg +++ b/harbour/contrib/hbct/tests/afteratn.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/asciisum.prg b/harbour/contrib/hbct/tests/asciisum.prg index 24e996c281..0c70b82bf5 100644 --- a/harbour/contrib/hbct/tests/asciisum.prg +++ b/harbour/contrib/hbct/tests/asciisum.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/ascpos.prg b/harbour/contrib/hbct/tests/ascpos.prg index 342953dca1..c4baa34a66 100644 --- a/harbour/contrib/hbct/tests/ascpos.prg +++ b/harbour/contrib/hbct/tests/ascpos.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/atadjust.prg b/harbour/contrib/hbct/tests/atadjust.prg index f6ed014567..94278a2d80 100644 --- a/harbour/contrib/hbct/tests/atadjust.prg +++ b/harbour/contrib/hbct/tests/atadjust.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/atnum.prg b/harbour/contrib/hbct/tests/atnum.prg index 99412ccec9..e66e680d79 100644 --- a/harbour/contrib/hbct/tests/atnum.prg +++ b/harbour/contrib/hbct/tests/atnum.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/atrepl.prg b/harbour/contrib/hbct/tests/atrepl.prg index 062d7f03c2..afd634002b 100644 --- a/harbour/contrib/hbct/tests/atrepl.prg +++ b/harbour/contrib/hbct/tests/atrepl.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/attoken.prg b/harbour/contrib/hbct/tests/attoken.prg index 1a78cf9836..bf2da503f5 100644 --- a/harbour/contrib/hbct/tests/attoken.prg +++ b/harbour/contrib/hbct/tests/attoken.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/beforatn.prg b/harbour/contrib/hbct/tests/beforatn.prg index 3cae3ef679..05810a5b9f 100644 --- a/harbour/contrib/hbct/tests/beforatn.prg +++ b/harbour/contrib/hbct/tests/beforatn.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charadd.prg b/harbour/contrib/hbct/tests/charadd.prg index 386e6e5e1d..3bd82c7db4 100644 --- a/harbour/contrib/hbct/tests/charadd.prg +++ b/harbour/contrib/hbct/tests/charadd.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charand.prg b/harbour/contrib/hbct/tests/charand.prg index dab5c94206..c63ce072a5 100644 --- a/harbour/contrib/hbct/tests/charand.prg +++ b/harbour/contrib/hbct/tests/charand.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/chareven.prg b/harbour/contrib/hbct/tests/chareven.prg index fdb3e01f01..e30f372abd 100644 --- a/harbour/contrib/hbct/tests/chareven.prg +++ b/harbour/contrib/hbct/tests/chareven.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charhist.prg b/harbour/contrib/hbct/tests/charhist.prg index fdc79c006e..b239b1d6f7 100644 --- a/harbour/contrib/hbct/tests/charhist.prg +++ b/harbour/contrib/hbct/tests/charhist.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charlist.prg b/harbour/contrib/hbct/tests/charlist.prg index 5a25ab2f6a..4406024eac 100644 --- a/harbour/contrib/hbct/tests/charlist.prg +++ b/harbour/contrib/hbct/tests/charlist.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charmirr.prg b/harbour/contrib/hbct/tests/charmirr.prg index 3416fa58ee..7d2b5daa11 100644 --- a/harbour/contrib/hbct/tests/charmirr.prg +++ b/harbour/contrib/hbct/tests/charmirr.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charmix.prg b/harbour/contrib/hbct/tests/charmix.prg index 2d9ab45fb4..ed15c66ec2 100644 --- a/harbour/contrib/hbct/tests/charmix.prg +++ b/harbour/contrib/hbct/tests/charmix.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charnlst.prg b/harbour/contrib/hbct/tests/charnlst.prg index 4e4def09c5..8ac75576d0 100644 --- a/harbour/contrib/hbct/tests/charnlst.prg +++ b/harbour/contrib/hbct/tests/charnlst.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charnot.prg b/harbour/contrib/hbct/tests/charnot.prg index e992706efd..60d9efddaf 100644 --- a/harbour/contrib/hbct/tests/charnot.prg +++ b/harbour/contrib/hbct/tests/charnot.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charodd.prg b/harbour/contrib/hbct/tests/charodd.prg index e322d69c0c..b27af5d401 100644 --- a/harbour/contrib/hbct/tests/charodd.prg +++ b/harbour/contrib/hbct/tests/charodd.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charone.prg b/harbour/contrib/hbct/tests/charone.prg index d308534f09..f30b46e3d4 100644 --- a/harbour/contrib/hbct/tests/charone.prg +++ b/harbour/contrib/hbct/tests/charone.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charonly.prg b/harbour/contrib/hbct/tests/charonly.prg index b9f01d862a..64bba98874 100644 --- a/harbour/contrib/hbct/tests/charonly.prg +++ b/harbour/contrib/hbct/tests/charonly.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charor.prg b/harbour/contrib/hbct/tests/charor.prg index a0971f2ca2..ee2f2b0acd 100644 --- a/harbour/contrib/hbct/tests/charor.prg +++ b/harbour/contrib/hbct/tests/charor.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charrem.prg b/harbour/contrib/hbct/tests/charrem.prg index 4a38af6c70..f96c98f8bb 100644 --- a/harbour/contrib/hbct/tests/charrem.prg +++ b/harbour/contrib/hbct/tests/charrem.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charrepl.prg b/harbour/contrib/hbct/tests/charrepl.prg index 3d67a75c3c..ecd94fe424 100644 --- a/harbour/contrib/hbct/tests/charrepl.prg +++ b/harbour/contrib/hbct/tests/charrepl.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charrll.prg b/harbour/contrib/hbct/tests/charrll.prg index ae6ff9e3dd..ccb4016d4a 100644 --- a/harbour/contrib/hbct/tests/charrll.prg +++ b/harbour/contrib/hbct/tests/charrll.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charrlr.prg b/harbour/contrib/hbct/tests/charrlr.prg index aa6365c7de..2cd0382080 100644 --- a/harbour/contrib/hbct/tests/charrlr.prg +++ b/harbour/contrib/hbct/tests/charrlr.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charshl.prg b/harbour/contrib/hbct/tests/charshl.prg index d4df99917e..b64db0f407 100644 --- a/harbour/contrib/hbct/tests/charshl.prg +++ b/harbour/contrib/hbct/tests/charshl.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charshr.prg b/harbour/contrib/hbct/tests/charshr.prg index c86a6a976d..80539aa1d4 100644 --- a/harbour/contrib/hbct/tests/charshr.prg +++ b/harbour/contrib/hbct/tests/charshr.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charslst.prg b/harbour/contrib/hbct/tests/charslst.prg index 87c91cfbe1..8cfd477bf0 100644 --- a/harbour/contrib/hbct/tests/charslst.prg +++ b/harbour/contrib/hbct/tests/charslst.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charsort.prg b/harbour/contrib/hbct/tests/charsort.prg index 476b64d930..f16647560a 100644 --- a/harbour/contrib/hbct/tests/charsort.prg +++ b/harbour/contrib/hbct/tests/charsort.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charsub.prg b/harbour/contrib/hbct/tests/charsub.prg index 3cb7dd55c6..611be86d9b 100644 --- a/harbour/contrib/hbct/tests/charsub.prg +++ b/harbour/contrib/hbct/tests/charsub.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charswap.prg b/harbour/contrib/hbct/tests/charswap.prg index 1152c6ba9f..38a27ebefc 100644 --- a/harbour/contrib/hbct/tests/charswap.prg +++ b/harbour/contrib/hbct/tests/charswap.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/charxor.prg b/harbour/contrib/hbct/tests/charxor.prg index 4ede7e7342..8b30753c0e 100644 --- a/harbour/contrib/hbct/tests/charxor.prg +++ b/harbour/contrib/hbct/tests/charxor.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/csetarge.prg b/harbour/contrib/hbct/tests/csetarge.prg index 9ba2943851..202749e78e 100644 --- a/harbour/contrib/hbct/tests/csetarge.prg +++ b/harbour/contrib/hbct/tests/csetarge.prg @@ -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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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, "" ) + 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, "") - 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 : " 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 : " 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( " @@ -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 diff --git a/harbour/contrib/hbct/tests/csetref.prg b/harbour/contrib/hbct/tests/csetref.prg index 5b3b2d73a5..28c67efe31 100644 --- a/harbour/contrib/hbct/tests/csetref.prg +++ b/harbour/contrib/hbct/tests/csetref.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/ctwtest.prg b/harbour/contrib/hbct/tests/ctwtest.prg index 1718cf7ce9..30a5239bcd 100644 --- a/harbour/contrib/hbct/tests/ctwtest.prg +++ b/harbour/contrib/hbct/tests/ctwtest.prg @@ -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 diff --git a/harbour/contrib/hbct/tests/datetime.prg b/harbour/contrib/hbct/tests/datetime.prg index 09f8ebd32d..3a35d8e001 100644 --- a/harbour/contrib/hbct/tests/datetime.prg +++ b/harbour/contrib/hbct/tests/datetime.prg @@ -56,1189 +56,1220 @@ #include "inkey.ch" #include "setcurs.ch" - // TODO: add language module request(s) and an achoice to select different lang modules -*:-------------------------------------------------------------------- -PROCEDURE main () -*:-------------------------------------------------------------------- -local cScr -local nchoice -local c := .T. -local farr := { "addmonth ( ddate ) Add a month to ddate ", ; - "bom () Beginning of month ", ; - "boq () Returns first date of qtr", ; - "boy () Beginning of year ", ; - "ctodow () Day name to day number ", ; - "ctomonth () Month name to number ", ; - "daysInMonth () number of days in xMonth ", ; - "daystomonth (ddate) Returns num days TO month", ; - "dmy ( ddate, lmode) date as DD month YY ", ; - "doy ( ddate ) Returns day of the year ", ; - "eom ( ddate ) Returns last day of month", ; - "eoq ( ddate ) Returns last date of qtr ", ; - "eoy ( ddate ) Returns last day of year ", ; - "isleap ( ddate ) Returns .T. if leap year ", ; - "lastdayom ( ddate ) Returns num days in month", ; - "mdy ( dDate ) Returns stg Month DD, YY ", ; - "ntocdow ( nDay ) Returns name of day ", ; - "ntocmonth ( nMth ) Returns name of month ", ; - "quarter (date) Returns qtr number of date", ; - "stod( ansi date) Returns Clipper date ", ; - "week( ddate, lSWN ) Returns numbef of week ", } +//:-------------------------------------------------------------------- - set date british - set century on +PROCEDURE Main() + + //:-------------------------------------------------------------------- + LOCAL cScr + LOCAL nchoice + LOCAL c := .T. + LOCAL farr := { "addmonth( ddate ) Add a month to ddate ", ; + "bom() Beginning of month ", ; + "boq() Returns first date of qtr", ; + "boy() Beginning of year ", ; + "ctodow() Day name to day number ", ; + "ctomonth() Month name to number ", ; + "daysInMonth() number of days in xMonth ", ; + "daystomonth(ddate) Returns num days TO month", ; + "dmy( ddate, lmode) date as DD month YY ", ; + "doy( ddate ) Returns day of the year ", ; + "eom( ddate ) Returns last day of month", ; + "eoq( ddate ) Returns last date of qtr ", ; + "eoy( ddate ) Returns last day of year ", ; + "isleap( ddate ) Returns .T. if leap year ", ; + "lastdayom( ddate ) Returns num days in month", ; + "mdy( dDate ) Returns stg Month DD, YY ", ; + "ntocdow( nDay ) Returns name of day ", ; + "ntocmonth( nMth ) Returns name of month ", ; + "quarter(date) Returns qtr number of date", ; + "stod( ansi date) Returns Clipper date ", ; + "week( ddate, lSWN ) Returns numbef of week ", } + + SET DATE british + SET CENTURY ON cls - do while c - cScr := savescreen ( 4, 5, 21,66 ) + DO WHILE c + cScr := SaveScreen( 4, 5, 21, 66 ) - @ 4, 5 to 21, 66 - nchoice := achoice ( 5, 7, 20, 65, farr ) //, ,1) + @ 4, 5 TO 21, 66 + nchoice := AChoice( 5, 7, 20, 65, farr ) //, ,1) - if empty ( nchoice ) - return - endif + IF Empty( nchoice ) + RETURN + ENDIF - @ 0, 0 clear to maxrow(), maxcol() + @ 0, 0 CLEAR TO MaxRow(), MaxCol() - do case - case nchoice == 1 - addmtest() - case nchoice == 2 - bomtest () - case nchoice == 3 - boqtest () - case nchoice == 4 - boytest () - case nchoice == 5 - ctodowtest () - case nchoice == 6 - ctomonthtest () - case nchoice == 7 - dInMonthtest () - case nchoice == 8 - d2month () - case nchoice == 9 - dmytest () - case nchoice == 10 - doytest () - case nchoice == 11 - eomtest () - case nchoice == 12 - eoqtest () - case nchoice == 13 - eoytest () - case nchoice == 14 - isleaptest () - case nchoice == 15 - lastdayomtest () - case nchoice == 16 - mdytest () - case nchoice == 17 - ntocdowtest () - case nchoice == 18 - ntocmthtest () - case nchoice == 19 - qtrtest () - case nchoice == 20 - stodtest() - case nchoice == 21 - weektest () - endcase + DO CASE + CASE nchoice == 1 + addmtest() + CASE nchoice == 2 + bomtest() + CASE nchoice == 3 + boqtest() + CASE nchoice == 4 + boytest() + CASE nchoice == 5 + ctodowtest() + CASE nchoice == 6 + ctomonthtest() + CASE nchoice == 7 + dInMonthtest() + CASE nchoice == 8 + d2month() + CASE nchoice == 9 + dmytest() + CASE nchoice == 10 + doytest() + CASE nchoice == 11 + eomtest() + CASE nchoice == 12 + eoqtest() + CASE nchoice == 13 + eoytest() + CASE nchoice == 14 + isleaptest() + CASE nchoice == 15 + lastdayomtest() + CASE nchoice == 16 + mdytest() + CASE nchoice == 17 + ntocdowtest() + CASE nchoice == 18 + ntocmthtest() + CASE nchoice == 19 + qtrtest() + CASE nchoice == 20 + stodtest() + CASE nchoice == 21 + weektest() + ENDCASE - restscreen ( 4, 5, 21, 66, cScr) - enddo + RestScreen( 4, 5, 21, 66, cScr ) + ENDDO - return + RETURN + + //:-------------------------------------------------------------------- -*:-------------------------------------------------------------------- FUNCTION addmtest() -*:-------------------------------------------------------------------- -*: addmonth (ddate, nMonths) -*: ========================= -*: This version will only accept an nMonths value of from 0 to 70 -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local mnth := 0 -local nKey + //:-------------------------------------------------------------------- + //: addmonth(ddate, nMonths) + //: ========================= + //: This version will only accept an nMonths value of from 0 to 70 -do while c - @ 5, 10 say "addmonth (ddate) returns the date incremented by" - @ 6, 10 say "the number of days in months." - @ 7, 10 say "Insert a date" - @ 8, 10 say "How many months" - @ 7, 60 get ddate - @ 8, 60 get mnth picture "99" + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL mnth := 0 + LOCAL nKey - set confirm on - set escape on - read - set escape off - set confirm on + DO WHILE c + @ 5, 10 SAY "addmonth(ddate) returns the date incremented by" + @ 6, 10 SAY "the number of days in months." + @ 7, 10 SAY "Insert a date" + @ 8, 10 SAY "How many months" + @ 7, 60 GET ddate + @ 8, 60 GET mnth PICTURE "99" - nKey := lastkey() + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON - if nKey == K_ESC - c := .F. - else + nKey := LastKey() - @ 11, 39 say "The returned date is " + dtoc ( addmonth (ddate, mnth) ) - - set cursor off - inkey(0) - set cursor on - - endif - - enddo - - @ 0, 0 clear - - return NIL - -*:-------------------------------------------------------------------- -FUNCTION bomtest() -*:-------------------------------------------------------------------- -*: bom ( ddate ) -*: ============= - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - -do while c - @ 5, 10 say "bom (ddate) returns the date of the first day of ddate" - @ 6, 10 say "If ddate is 15/10/2002 (that's in dd/mm/yyy), bom ()" - @ 7, 10 say "should return 01/10/2002. Test it, Insert a date" - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - @ 11, 10 say "The returned date is " + dtoc ( bom (ddate) ) - - set cursor off - inkey(0) - set cursor on - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:-------------------------------------------------------------------- -FUNCTION boqtest () -*:-------------------------------------------------------------------- -*: bom ( ddate ) -*: ============= - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - - do while c - @ 5, 10 say "boq (ddate) returns the date of the first day of the" - @ 6, 10 say "quarter in which ddate is situated. If ddate is" - @ 7, 10 say "15/10/2002 (that's in dd/mm/yyy), BOQ () should return" - @ 8, 10 say "01/09/2002. Test it, Insert a date" - - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC + IF nKey == K_ESC c := .F. - else - @ 11, 10 say "The returned date is " + dtoc ( boq (ddate) ) + ELSE - set cursor off - inkey(0) - set cursor on + @ 11, 39 SAY "The returned date is " + DToC( addmonth( ddate, mnth ) ) - endif + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON - enddo + ENDIF - @ 0, 0 clear - - return NIL - - -*:-------------------------------------------------------------------- -FUNCTION boytest () -*:-------------------------------------------------------------------- -*: boy ( ddate ) -*: ============= - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nkey - -do while c - @ 5, 10 say "boy (ddate) returns the date of the first day of ddate" - @ 6, 10 say "If ddate is 15/10/2002 (that's in dd/mm/yyy), boy ()" - @ 7, 10 say "should return 01/01/2002. Test it, Insert a date" - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - @ 11, 10 say "The returned date is " + dtoc ( boy (ddate) ) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION ctodowtest () -*:---------------------------------------------------------------- -*: ctodow ( cDow) -*: ============== -*: Convert name of day of the week to its ordinal number -*: if cDow is invalid, returns 0 -*: English day names only. - -local getlist := {} -local cDow := space (9) -local nkey -local c := .T. - -do while c - @ 5, 10 say "ctodow (ddate) receives the name of a day of the week and " - @ 6, 10 say "returns a number representing its position in the week" - @ 7, 10 say "Sunday returns 1. Test it, Insert a day" - @ 9, 10 get cDow - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - @ 11, 10 say "The day number is " + str ( ctodow ( upper (alltrim (cDow))) ) - - set cursor off - inkey(0) - set cursor on - - cDow := space (9) - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION ctomonthtest () -*:---------------------------------------------------------------- -*: ctomonth (cDom ) -*: =============== -*: Convert the name of a month to its ordinal number. If cMonth is -*: invalid, ctomonth() Returns 0. English month names only - -local getlist := {} -local cDom := space (9) -local c := .T. -local nKey - -do while c - @ 5, 10 say "ctomonth (ddate) receives the name of a month and returns" - @ 6, 10 say "a number representing its position in the month. April" - @ 7, 10 say "returns 4. Test it, Insert a month" - @ 9, 10 get cDom picture "!!!!!!!!!" - - set confirm on - set escape on - read - set escape off - set confirm on - - cDom := alltrim ( cDom ) - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - @ 11, 10 say "The day number is " + str ( ctomonth ( cDom) ) - set cursor off - inkey(0) - set cursor on - - cDom := space (9) - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION dInMonthtest () -*:---------------------------------------------------------------- -*: daysInMonth ( xDate, lleap ) -*: ============================ -*: Returns the number of days in nMonth, either whose name as a -*: string or month number is passed. English Month names only. - -local getlist := {} -local cMonth := space (9) -local c := .T. -local nMonth -local nKey -local cLeap := "N" -local lleap := .F. - - do while c - @ 5, 10 say "daysInmonth () receives either the number of a month or" - @ 6, 10 say "its name and returns the number of days in the month. " - @ 7, 10 say "April returns 30. Test it. Insert a month number" - @ 8, 10 say "Is it a leap year?" - @ 7, 60 get cMonth picture "XXXXXXXXX" - @ 8, 60 get cleap picture "Y" - - set confirm on - set escape on - read - set escape off - set confirm on - - cMonth := upper (rtrim (cMonth)) - nMonth := val (cMonth) - - do case - case valtype ( cMonth ) == "C" .and. nmonth == 0 - nMonth := ctomonth ( cMonth) - - case nMonth == 0 .or. ; - nMonth > 12 - - loop - endcase - - if cLeap == "Y" - lleap := .T. - endif - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 10, 40 say "The day number is " + ; - ltrim (str ( daysInMonth ( nMonth, lLeap ))) - - set cursor off - inkey(0) - set cursor on - - cMonth := space (9) - cLeap := "N" - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION d2month () -*:---------------------------------------------------------------- -*: daystomonth() -*: ============= -*: Total number days from first of Jan to beginning of nMonth. -*: lLeap is .F. for a non-leap year but .T. if it is. If so and -*: nMonth is greater than 2, ndays is incremented. - -local getlist := {} -local cMonth := space (2) -local cLeap := "N" -local c := .T. -local nMonth -local lLeap -local nKey - -do while c - @ 5, 10 say "daystomonth () receives the number a month and returns" - @ 6, 10 say "the number of days in the year up to that month. March" - @ 7, 10 say "returns 59 or 60 in a leap year. Test it." - @ 8, 10 say "Insert a month number" - @ 9, 10 say "Leap year Y/N?" - @ 8, 33 get cMonth picture "99" - @ 9, 33 get cLeap picture "Y" - - set confirm on - set escape on - read - set escape off - set confirm on - - nMonth := val ( cMonth ) - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - if cLeap == "Y" - lLeap := .T. - endif - - @ 11, 10 say "The day number is " + ; - ltrim (str ( daystomonth ( nMonth, lLeap ))) - - set cursor off - inkey(0) - set cursor on - - cMonth := space (2) - cLeap := "N" - - endif - - enddo - - @ 0, 0 clear - - return NIL - -*:---------------------------------------------------------------- -FUNCTION dmytest () -*:---------------------------------------------------------------- -*: dmy ( ddate, lmode) -*: =================== -*: Returns the date as a string in DD Month YY format. If lmode -*: is .T., a "." is inserted after the DD -*: This version does not observe the Nations module. English -*: only. - -local getlist := {} -local ddate := ctod (" / / ") -local cMode := space (1) -local lmode -local c := .T. -local nKey - - do while c - @ 5, 10 say "dmy() receives a date and logical lmode. If lmode is" - @ 6, 10 say "is either missing or FALSE, dmy returns the date as" - @ 7, 10 say "a string in DD Month YY format. If lmode is TRUE, a" - @ 8, 10 say "full stop or perod '.' is inserted after DD. Test it" - @ 9, 10 say "Insert a date" - @ 10, 10 say "inssert a full stop Y/N?" - @ 9, 36 get ddate picture "@D / / " - @ 10, 45 get cMode picture "Y" - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - if (cMode == "Y", lMode := .T., lMode := .F.) - - @ 12, 10 say "The date string returned is " + ; - ltrim (dmy ( ddate, lmode )) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - cMode := space (1) - - endif - - enddo - - @ 0, 0 clear - - return NIL - -*:---------------------------------------------------------------- -FUNCTION doytest () -*:---------------------------------------------------------------- -*: doy ( ddate ) -*: ============= -*: Determines the day of the year for a specific date -*: if dDate is invalid, returns 0 - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - -do while c - @ 5, 10 say "doy (ddate) returns the day of the year for the" - @ 6, 10 say "date passed. Test it, Insert a date" - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - @ 11, 10 say "The day of the date entered is " + ; - ltrim ( str (doy ( ddate ))) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION eomtest () -*:---------------------------------------------------------------- -*: dBom := eom ( ddate ) -*: ===================== -*: Returns the last date in the month of the month appearing in -*: date. - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - -do while c - @ 5, 10 say "eom (ddate) returns the last date in the month of the" - @ 6, 10 say "month appearing in ddate. Test it, Insert a date" - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 11, 10 say "The last date in the month is " + ; - ltrim ( dtoc (eom ( ddate ))) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION eoqtest () -*:---------------------------------------------------------------- -*: dret := eoq ( ddate ) -*: ===================== -*: Returns the last date in the quarter in which ddate falls. - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - - do while c - @ 5, 10 say "EOQ (ddate) returns the last date in the quarter in" - @ 6, 10 say "which ddate falls. Test it, Insert a date" - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 11, 10 say "The last date in the month is " + ; - ltrim ( dtoc (eoq ( ddate ))) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION eoytest () -*:---------------------------------------------------------------- -*: dEoy := eoy ( ddate ) -*: ===================== -*: Returns the last date in the year of the year appearing in -*: date. - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - - do while c - @ 5, 10 say "eoy (ddate) returns the last date in the year of the" - @ 6, 10 say "year appearing in ddate. Test it, Insert a date" - @ 9, 10 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 11, 10 say "The last date in the year is " + ; - ltrim ( dtoc (eoy ( ddate ))) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - - endif - - enddo + ENDDO @ 0, 0 clear - return NIL + RETURN NIL + //:-------------------------------------------------------------------- -*:---------------------------------------------------------------- -FUNCTION isleaptest () -*:---------------------------------------------------------------- -*: lRet := isleap ( ddate ) -*: ======================== -*: if ddate is a leap year, lRet is .T., otherwise .F.. -*: Leap years are exactly divisible by 4 and 1,000 but not 100. +FUNCTION bomtest() -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local cResult -local nKey + //:-------------------------------------------------------------------- + //: bom( ddate ) + //: ============= - do while c - @ 5, 10 say "isleap (ddate) returns TRUE if ddate is a leap year" - @ 6, 10 say "Test it, Insert a date" - @ 9, 10 get ddate + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey - set confirm on - set escape on - read - set escape off - set confirm on + DO WHILE c + @ 5, 10 SAY "bom(ddate) returns the date of the first day of ddate" + @ 6, 10 SAY "If ddate is 15/10/2002(that's in dd/mm/yyy), bom()" + @ 7, 10 SAY "should return 01/10/2002. Test it, Insert a date" + @ 9, 10 GET ddate - nKey := lastkey() + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON - if nKey == K_ESC + nKey := LastKey() + + IF nKey == K_ESC c := .F. - else + ELSE + @ 11, 10 SAY "The returned date is " + DToC( bom( ddate ) ) - if isleap ( ddate ) + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:-------------------------------------------------------------------- + +FUNCTION boqtest() + + //:-------------------------------------------------------------------- + //: bom( ddate ) + //: ============= + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "boq(ddate) returns the date of the first day of the" + @ 6, 10 SAY "quarter in which ddate is situated. If ddate is" + @ 7, 10 SAY "15/10/2002 (that's in dd/mm/yyy), BOQ() should return" + @ 8, 10 SAY "01/09/2002. Test it, Insert a date" + + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + @ 11, 10 SAY "The returned date is " + DToC( boq( ddate ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:-------------------------------------------------------------------- + +FUNCTION boytest() + + //:-------------------------------------------------------------------- + //: boy( ddate ) + //: ============= + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nkey + + DO WHILE c + @ 5, 10 SAY "boy(ddate) returns the date of the first day of ddate" + @ 6, 10 SAY "If ddate is 15/10/2002(that's in dd/mm/yyy), boy()" + @ 7, 10 SAY "should return 01/01/2002. Test it, Insert a date" + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + @ 11, 10 SAY "The returned date is " + DToC( boy( ddate ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION ctodowtest() + + //:---------------------------------------------------------------- + //: ctodow( cDow) + //: ============== + //: Convert name of day of the week to its ordinal number + //: if cDow is invalid, returns 0 + //: English day names only. + + LOCAL getlist := {} + LOCAL cDow := Space( 9 ) + LOCAL nkey + LOCAL c := .T. + + DO WHILE c + @ 5, 10 SAY "ctodow(ddate) receives the name of a day of the week and " + @ 6, 10 SAY "returns a number representing its position in the week" + @ 7, 10 SAY "Sunday returns 1. Test it, Insert a day" + @ 9, 10 GET cDow + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + @ 11, 10 SAY "The day number is " + Str( ctodow( Upper(AllTrim(cDow ) ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + cDow := Space( 9 ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION ctomonthtest() + + //:---------------------------------------------------------------- + //: ctomonth(cDom ) + //: =============== + //: Convert the name of a month to its ordinal number. If cMonth is + //: invalid, ctomonth() Returns 0. English month names only + + LOCAL getlist := {} + LOCAL cDom := Space( 9 ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "ctomonth(ddate) receives the name of a month and returns" + @ 6, 10 SAY "a number representing its position in the month. April" + @ 7, 10 SAY "returns 4. Test it, Insert a month" + @ 9, 10 GET cDom PICTURE "!!!!!!!!!" + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + cDom := AllTrim( cDom ) + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + @ 11, 10 SAY "The day number is " + Str( ctomonth( cDom ) ) + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + cDom := Space( 9 ) + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION dInMonthtest() + + //:---------------------------------------------------------------- + //: daysInMonth( xDate, lleap ) + //: ============================ + //: Returns the number of days in nMonth, either whose name as a + //: string or month number is passed. English Month names only. + + LOCAL getlist := {} + LOCAL cMonth := Space( 9 ) + LOCAL c := .T. + LOCAL nMonth + LOCAL nKey + LOCAL cLeap := "N" + LOCAL lleap := .F. + + DO WHILE c + @ 5, 10 SAY "daysInmonth() receives either the number of a month or" + @ 6, 10 SAY "its name and returns the number of days in the month. " + @ 7, 10 SAY "April returns 30. Test it. Insert a month number" + @ 8, 10 SAY "Is it a leap year?" + @ 7, 60 GET cMonth PICTURE "XXXXXXXXX" + @ 8, 60 GET cleap PICTURE "Y" + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + cMonth := Upper( RTrim( cMonth ) ) + nMonth := Val( cMonth ) + + DO CASE + CASE ValType( cMonth ) == "C" .AND. nmonth == 0 + nMonth := ctomonth( cMonth ) + + CASE nMonth == 0 .OR. ; + nMonth > 12 + + LOOP + ENDCASE + + IF cLeap == "Y" + lleap := .T. + ENDIF + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 10, 40 SAY "The day number is " + ; + LTrim( Str( daysInMonth( nMonth, lLeap ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + cMonth := Space( 9 ) + cLeap := "N" + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION d2month() + + //:---------------------------------------------------------------- + //: daystomonth() + //: ============= + //: Total number days from first of Jan to beginning of nMonth. + //: lLeap is .F. for a non-leap year but .T. if it is. If so and + //: nMonth is greater than 2, ndays is incremented. + + LOCAL getlist := {} + LOCAL cMonth := Space( 2 ) + LOCAL cLeap := "N" + LOCAL c := .T. + LOCAL nMonth + LOCAL lLeap + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "daystomonth() receives the number a month and returns" + @ 6, 10 SAY "the number of days in the year up to that month. March" + @ 7, 10 SAY "returns 59 or 60 in a leap year. Test it." + @ 8, 10 SAY "Insert a month number" + @ 9, 10 SAY "Leap year Y/N?" + @ 8, 33 GET cMonth PICTURE "99" + @ 9, 33 GET cLeap PICTURE "Y" + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nMonth := Val( cMonth ) + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + IF cLeap == "Y" + lLeap := .T. + ENDIF + + @ 11, 10 SAY "The day number is " + ; + LTrim( Str( daystomonth( nMonth, lLeap ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + cMonth := Space( 2 ) + cLeap := "N" + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION dmytest() + + //:---------------------------------------------------------------- + //: dmy( ddate, lmode) + //: =================== + //: Returns the date as a string in DD Month YY format. If lmode + //: is .T., a "." is inserted after the DD + //: This version does not observe the Nations module. English + //: only. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL cMode := Space( 1 ) + LOCAL lmode + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "dmy() receives a date and logical lmode. If lmode is" + @ 6, 10 SAY "is either missing or FALSE, dmy returns the date as" + @ 7, 10 SAY "a string in DD Month YY format. If lmode is TRUE, a" + @ 8, 10 SAY "full stop or perod '.' is inserted after DD. Test it" + @ 9, 10 SAY "Insert a date" + @ 10, 10 SAY "inssert a full stop Y/N?" + @ 9, 36 GET ddate PICTURE "@D / / " + @ 10, 45 GET cMode PICTURE "Y" + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + iif( cMode == "Y", lMode := .T. , lMode := .F. ) + + @ 12, 10 SAY "The date string returned is " + ; + LTrim( dmy( ddate, lmode ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + cMode := Space( 1 ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION doytest() + + //:---------------------------------------------------------------- + //: doy( ddate ) + //: ============= + //: Determines the day of the year for a specific date + //: if dDate is invalid, returns 0 + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "doy(ddate) returns the day of the year for the" + @ 6, 10 SAY "date passed. Test it, Insert a date" + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + @ 11, 10 SAY "The day of the date entered is " + ; + LTrim( Str( doy( ddate ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION eomtest() + + //:---------------------------------------------------------------- + //: dBom := eom( ddate ) + //: ===================== + //: Returns the last date in the month of the month appearing in + //: date. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "eom(ddate) returns the last date in the month of the" + @ 6, 10 SAY "month appearing in ddate. Test it, Insert a date" + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 11, 10 SAY "The last date in the month is " + ; + LTrim( DToC( eom( ddate ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION eoqtest() + + //:---------------------------------------------------------------- + //: dret := eoq( ddate ) + //: ===================== + //: Returns the last date in the quarter in which ddate falls. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "EOQ(ddate) returns the last date in the quarter in" + @ 6, 10 SAY "which ddate falls. Test it, Insert a date" + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 11, 10 SAY "The last date in the month is " + ; + LTrim( DToC( eoq( ddate ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION eoytest() + + //:---------------------------------------------------------------- + //: dEoy := eoy( ddate ) + //: ===================== + //: Returns the last date in the year of the year appearing in + //: date. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "eoy(ddate) returns the last date in the year of the" + @ 6, 10 SAY "year appearing in ddate. Test it, Insert a date" + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 11, 10 SAY "The last date in the year is " + ; + LTrim( DToC( eoy( ddate ) ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION isleaptest() + + //:---------------------------------------------------------------- + //: lRet := isleap( ddate ) + //: ======================== + //: if ddate is a leap year, lRet is .T., otherwise .F.. + //: Leap years are exactly divisible by 4 and 1,000 but not 100. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL cResult + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "isleap(ddate) returns TRUE if ddate is a leap year" + @ 6, 10 SAY "Test it, Insert a date" + @ 9, 10 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + IF isleap( ddate ) cResult := "TRUE " - else + ELSE cResult := "FALSE" - endif + ENDIF - @ 11, 10 say "The result is " + cResult + @ 11, 10 SAY "The result is " + cResult - set cursor off - inkey(0) - set cursor on + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON - ddate := ctod (" / / ") + ddate := CToD( " / / " ) - endif + ENDIF - enddo + ENDDO - @ 0, 0 clear + @ 0, 0 clear - return NIL + RETURN NIL -*:---------------------------------------------------------------- -FUNCTION lastdayomtest () -*:---------------------------------------------------------------- -*: ndays := lastdayom ( xDate ) -*:-------------------------------------------------------------- -*: Returns the the number of days in the month. -*: xDate can be a date or a month number. If empty uses the -*: system date. -*: If xDate is invalid, returns 0 + //:---------------------------------------------------------------- -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey -local cMth := " " +FUNCTION lastdayomtest() - do while c - @ 5, 10 say "lastdayom (xDate) returns the number of days in the" - @ 6, 10 say "month appearing in date. Or, if only a month number" - @ 7, 10 say "is passed, in that month. Test it. " - @ 9, 10 say "Insert a date (or)" - @ 10, 10 say "a month" + //:---------------------------------------------------------------- + //: ndays := lastdayom( xDate ) + //:-------------------------------------------------------------- + //: Returns the the number of days in the month. + //: xDate can be a date or a month number. If empty uses the + //: system date. + //: If xDate is invalid, returns 0 - @ 9, 30 get ddate - @ 10, 38 get cMth picture "99" //valid val (cmth) < 12 + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + LOCAL cMth := " " - set confirm on - set escape on - read - set escape off - set confirm on + DO WHILE c + @ 5, 10 SAY "lastdayom(xDate) returns the number of days in the" + @ 6, 10 SAY "month appearing in date. Or, if only a month number" + @ 7, 10 SAY "is passed, in that month. Test it. " + @ 9, 10 SAY "Insert a date(or)" + @ 10, 10 SAY "a month" - nKey := lastkey() + @ 9, 30 GET ddate + @ 10, 38 GET cMth PICTURE "99" //valid val(cmth) < 12 - if nKey == K_ESC - c := .F. - else + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON - if (empty (ddate), ddate := val (cMth), ddate) + nKey := LastKey() - @ 12, 10 say "The number of days in the month is " + ; - ltrim (str (lastdayom ( ddate ))) - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - cMth := " " - - endif - - enddo - - @ 0, 0 clear - - return NIL - -*:---------------------------------------------------------------- -FUNCTION mdytest () -*:---------------------------------------------------------------- -*: cDate := mdy ( dDate ) -*: ====================== -*: Returns the date as a string in "Month DD, YY" or "Month DD, YYYY" -*: If dDate is NULL, the system date is used -*: This version does not observe the Nations module. English only. - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - - do while c - @ 5, 10 say "mdy() receives a date. mdy returns the date as" - @ 6, 10 say "a string in month DD YY format. Test it" - @ 8, 10 say "Insert a date" - @ 8, 30 get ddate picture "@D / / " - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 11, 10 say "The date string returned is " + ; - ltrim (mdy ( ddate )) - - set cursor off - inkey(0) - set cursor on - - ddate := ctod (" / / ") - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION ntocdowtest () -*:---------------------------------------------------------------- -*: cDay := ntocdow ( nDayNum ) -*: ================================== -*: ntocdow() receives the number of a day and returns its -*: name as a string. This version does not observe the Nations -*: module. English only. - -local getlist := {} -local cDay := " " -local c := .T. -local nKey - -do while c - @ 5, 10 say "ntocdow(n) returns the name of the day number n" - @ 6, 10 say "Test it, Insert a day number" - @ 6, 60 get cDay - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 11, 10 say "The day selected is " + ; - padr (ntocdow ( val (cDay) ), 10) - - set cursor off - inkey(0) - set cursor on - - cDay := " " - - endif - - enddo - - @ 0, 0 clear - - return NIL - - -*:---------------------------------------------------------------- -FUNCTION ntocmthtest () -*:---------------------------------------------------------------- -*: cMonth := ntocmonth ( nMonthNum ) -*: ================================== -*: ntocmonth() receives the number of a month and returns its -*: name as a string. This version does not observe the Nations -*: module. English only. - -local getlist := {} -local cMonth := " " -local c := .T. -local nKey - -do while c - @ 5, 10 say "ntocmonth(n) returns the name of the month number n" - @ 6, 10 say "Test it, Insert a month number" - @ 6, 60 get cMonth - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC - c := .F. - else - - @ 11, 10 say "The month selected is " + ; - padr (ntocmonth ( val (cMonth) ), 10) - - set cursor off - inkey(0) - set cursor on - - cMonth := " " - - endif - - enddo - - @ 0, 0 clear - - return NIL - -*:---------------------------------------------------------------- -FUNCTION qtrtest () -*:---------------------------------------------------------------- -*: nqtr := quarter ( ddate ) -*: =========================== -*: Returns the quarter as a number. If no date is specified, -*: the system date is used. - -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey - - do while c - @ 5, 10 say "quarter (ddate) returns the number of the quarter" - @ 6, 10 say "Test it, Insert a date" - @ 6, 52 get ddate - - set confirm on - set escape on - read - set escape off - set confirm on - - nKey := lastkey() - - if nKey == K_ESC + IF nKey == K_ESC c := .F. - else + ELSE - @ 8, 10 say "The quarter number is " + ; - padr (ltrim ( str ( quarter ( ddate ))), 10) + iif( Empty( ddate ), ddate := Val( cMth ), ddate ) - set cursor off - inkey(0) - set cursor on + @ 12, 10 SAY "The number of days in the month is " + ; + LTrim( Str( lastdayom( ddate ) ) ) + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON - ddate := ctod (" / / ") + ddate := CToD( " / / " ) + cMth := " " - endif + ENDIF - enddo + ENDDO - @ 0, 0 clear + @ 0, 0 clear - return NIL + RETURN NIL + //:---------------------------------------------------------------- + +FUNCTION mdytest() + + //:---------------------------------------------------------------- + //: cDate := mdy( dDate ) + //: ====================== + //: Returns the date as a string in "Month DD, YY" or "Month DD, YYYY" + //: If dDate is NULL, the system date is used + //: This version does not observe the Nations module. English only. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "mdy() receives a date. mdy returns the date as" + @ 6, 10 SAY "a string in month DD YY format. Test it" + @ 8, 10 SAY "Insert a date" + @ 8, 30 GET ddate PICTURE "@D / / " + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 11, 10 SAY "The date string returned is " + ; + LTrim( mdy( ddate ) ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION ntocdowtest() + + //:---------------------------------------------------------------- + //: cDay := ntocdow( nDayNum ) + //: ================================== + //: ntocdow() receives the number of a day and returns its + //: name as a string. This version does not observe the Nations + //: module. English only. + + LOCAL getlist := {} + LOCAL cDay := " " + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "ntocdow(n) returns the name of the day number n" + @ 6, 10 SAY "Test it, Insert a day number" + @ 6, 60 GET cDay + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 11, 10 SAY "The day selected is " + ; + PadR( ntocdow( Val(cDay ) ), 10 ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + cDay := " " + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION ntocmthtest() + + //:---------------------------------------------------------------- + //: cMonth := ntocmonth( nMonthNum ) + //: ================================== + //: ntocmonth() receives the number of a month and returns its + //: name as a string. This version does not observe the Nations + //: module. English only. + + LOCAL getlist := {} + LOCAL cMonth := " " + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "ntocmonth(n) returns the name of the month number n" + @ 6, 10 SAY "Test it, Insert a month number" + @ 6, 60 GET cMonth + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 11, 10 SAY "The month selected is " + ; + PadR( ntocmonth( Val(cMonth ) ), 10 ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + cMonth := " " + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- + +FUNCTION qtrtest() + + //:---------------------------------------------------------------- + //: nqtr := quarter( ddate ) + //: =========================== + //: Returns the quarter as a number. If no date is specified, + //: the system date is used. + + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + + DO WHILE c + @ 5, 10 SAY "quarter(ddate) returns the number of the quarter" + @ 6, 10 SAY "Test it, Insert a date" + @ 6, 52 GET ddate + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC + c := .F. + ELSE + + @ 8, 10 SAY "The quarter number is " + ; + PadR( LTrim( Str( quarter( ddate ) ) ), 10 ) + + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON + + ddate := CToD( " / / " ) + + ENDIF + + ENDDO + + @ 0, 0 clear + + RETURN NIL + + //:---------------------------------------------------------------- -*:---------------------------------------------------------------- FUNCTION stodtest() -*:---------------------------------------------------------------- -*: stod ( ansi-date) -*: ================ -*: Returns a Clipper format date. If Ansi date is invalid, a -*: null date is returned. -local getlist := {} -local ddate -local cAnsidate := space(8) -local c := .T. -local nKey + //:---------------------------------------------------------------- + //: stod( ansi-date) + //: ================ + //: Returns a Clipper format date. If Ansi date is invalid, a + //: null date is returned. - do while c - @ 5, 10 say "stod ( ansi-date ) receives an ANSI date string and" - @ 6, 10 say "returns a Clipper format date" - @ 8, 10 say "Enter an ANSI date string in the form YYYYMMDD" - @ 8, 57 get cAnsidate picture "999999999" valid chkansi (cAnsidate) + LOCAL getlist := {} + LOCAL ddate + LOCAL cAnsidate := Space( 8 ) + LOCAL c := .T. + LOCAL nKey - set confirm on - set escape on - read - set escape off - set confirm on + DO WHILE c + @ 5, 10 SAY "stod( ansi-date ) receives an ANSI date string and" + @ 6, 10 SAY "returns a Clipper format date" + @ 8, 10 SAY "Enter an ANSI date string in the form YYYYMMDD" + @ 8, 57 GET cAnsidate PICTURE "999999999" VALID chkansi( cAnsidate ) - nKey := lastkey() + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON - if nKey == K_ESC + nKey := LastKey() + + IF nKey == K_ESC c := .F. - else + ELSE - ddate := stod ( cAnsidate ) + ddate := SToD( cAnsidate ) - @ 10, 10 say "The Clipper format date is " + ; - padr (ltrim ( dtoc ( ddate )), 10) + @ 10, 10 SAY "The Clipper format date is " + ; + PadR( LTrim( DToC( ddate ) ), 10 ) - set cursor off - inkey(0) - set cursor on + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON - cAnsidate := space(8) + cAnsidate := Space( 8 ) - endif + ENDIF - enddo - return NIL + ENDDO + RETURN NIL -*:---------------------------------------------------------------- -FUNCTION chkansi (cAnsidate) -*:---------------------------------------------------------------- -local nYear -local nMonth -local nDay -local lretval := .T. + //:---------------------------------------------------------------- - nYear := val ( left ( cAnsidate, 4)) - nMonth := val (substr ( cAnsidate, 5, 2)) - nDay := val ( right ( cAnsidate, 2)) +FUNCTION chkansi( cAnsidate ) - do case + //:---------------------------------------------------------------- + LOCAL nYear + LOCAL nMonth + LOCAL nDay + LOCAL lretval := .T. - case nYear < 1 - lretval := .F. - case nMonth < 1 .or. nMonth > 12 - lretval := .F. - case nday < 0 .or. nday > 31 - lretval := .F. - endcase + nYear := Val( Left( cAnsidate, 4 ) ) + nMonth := Val( SubStr( cAnsidate, 5, 2 ) ) + nDay := Val( Right( cAnsidate, 2 ) ) - return lretval + DO CASE + CASE nYear < 1 + lretval := .F. + CASE nMonth < 1 .OR. nMonth > 12 + lretval := .F. + CASE nday < 0 .OR. nday > 31 + lretval := .F. + ENDCASE -*:---------------------------------------------------------------- -FUNCTION weektest () -*:---------------------------------------------------------------- -*: nWeek := week ( ddate, lSWN ) -*: ============================= -*: Returns the calendar week as a number. If no date is specified, -*: the system date is used. An empty date viz ctod(" / / ") -*: returns 0. + RETURN lretval -local getlist := {} -local ddate := ctod (" / / ") -local c := .T. -local nKey -local cMode := space(1) + //:---------------------------------------------------------------- - do while c - @ 5, 10 say "week (ddate, lSWN) returns the calendar number of the week" - @ 6, 10 say "if lSWN == .T., the simple week number is returned" - @ 7, 10 say "if lSWN == .F.(default), the ISO8601 week number is returned" +FUNCTION weektest() - @ 8, 10 say "Test it, Insert a date and " - @ 9, 52 get ddate - @ 10, 61 get cMode picture "Y" + //:---------------------------------------------------------------- + //: nWeek := week( ddate, lSWN ) + //: ============================= + //: Returns the calendar week as a number. If no date is specified, + //: the system date is used. An empty date viz ctod(" / / ") + //: returns 0. - set confirm on - set escape on - read - set escape off - set confirm on + LOCAL getlist := {} + LOCAL ddate := CToD( " / / " ) + LOCAL c := .T. + LOCAL nKey + LOCAL cMode := Space( 1 ) - nKey := lastkey() + DO WHILE c + @ 5, 10 SAY "week(ddate, lSWN) returns the calendar number of the week" + @ 6, 10 SAY "if lSWN == .T., the simple week number is returned" + @ 7, 10 SAY "if lSWN == .F.(default), the ISO8601 week number is returned" - if nKey == K_ESC + @ 8, 10 SAY "Test it, Insert a date and " + @ 9, 52 GET ddate + @ 10, 61 GET cMode PICTURE "Y" + + SET CONFIRM ON + SET ESCAPE ON + READ + SET ESCAPE OFF + SET CONFIRM ON + + nKey := LastKey() + + IF nKey == K_ESC c := .F. - else + ELSE - @ 8, 10 say "The week number is " + ; - padr (ltrim ( str (week ( ddate, cMode=="Y"))), 10) + @ 8, 10 SAY "The week number is " + ; + PadR( LTrim( Str(week( ddate, cMode == "Y" ) ) ), 10 ) - set cursor off - inkey(0) - set cursor on + SET CURSOR OFF + Inkey( 0 ) + SET CURSOR ON - ddate := ctod (" / / ") + ddate := CToD( " / / " ) - endif + ENDIF - enddo + ENDDO - @ 0, 0 clear + @ 0, 0 clear - return NIL + RETURN NIL diff --git a/harbour/contrib/hbct/tests/expomant.prg b/harbour/contrib/hbct/tests/expomant.prg index 615b23e7b3..778705f3a0 100644 --- a/harbour/contrib/hbct/tests/expomant.prg +++ b/harbour/contrib/hbct/tests/expomant.prg @@ -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 diff --git a/harbour/contrib/hbct/tests/finan.prg b/harbour/contrib/hbct/tests/finan.prg index d89678e287..dba24c8583 100644 --- a/harbour/contrib/hbct/tests/finan.prg +++ b/harbour/contrib/hbct/tests/finan.prg @@ -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 - * * 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 diff --git a/harbour/contrib/hbct/tests/math.prg b/harbour/contrib/hbct/tests/math.prg index 6e9f6a75a8..ce70e2f70c 100644 --- a/harbour/contrib/hbct/tests/math.prg +++ b/harbour/contrib/hbct/tests/math.prg @@ -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 - * * 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 diff --git a/harbour/contrib/hbct/tests/num1.prg b/harbour/contrib/hbct/tests/num1.prg index 9d93885663..a50cdad970 100644 --- a/harbour/contrib/hbct/tests/num1.prg +++ b/harbour/contrib/hbct/tests/num1.prg @@ -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 - * * 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 diff --git a/harbour/contrib/hbct/tests/numtoken.prg b/harbour/contrib/hbct/tests/numtoken.prg index a4b5215402..b959209f95 100644 --- a/harbour/contrib/hbct/tests/numtoken.prg +++ b/harbour/contrib/hbct/tests/numtoken.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/rangerem.prg b/harbour/contrib/hbct/tests/rangerem.prg index 1d54a328c8..da5ac2295a 100644 --- a/harbour/contrib/hbct/tests/rangerem.prg +++ b/harbour/contrib/hbct/tests/rangerem.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/rangerep.prg b/harbour/contrib/hbct/tests/rangerep.prg index 5b68d77860..c1995d374e 100644 --- a/harbour/contrib/hbct/tests/rangerep.prg +++ b/harbour/contrib/hbct/tests/rangerep.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/setatlik.prg b/harbour/contrib/hbct/tests/setatlik.prg index f315932b9b..5cf9facc8f 100644 --- a/harbour/contrib/hbct/tests/setatlik.prg +++ b/harbour/contrib/hbct/tests/setatlik.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/strdiff.prg b/harbour/contrib/hbct/tests/strdiff.prg index ac6c929112..e656862de5 100644 --- a/harbour/contrib/hbct/tests/strdiff.prg +++ b/harbour/contrib/hbct/tests/strdiff.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/tab.prg b/harbour/contrib/hbct/tests/tab.prg index 6397a0b2a5..36e0ac08d1 100644 --- a/harbour/contrib/hbct/tests/tab.prg +++ b/harbour/contrib/hbct/tests/tab.prg @@ -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 diff --git a/harbour/contrib/hbct/tests/token.prg b/harbour/contrib/hbct/tests/token.prg index 48bada190a..37294b3007 100644 --- a/harbour/contrib/hbct/tests/token.prg +++ b/harbour/contrib/hbct/tests/token.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/token2.prg b/harbour/contrib/hbct/tests/token2.prg index 87d0a2ad8f..aa5caf91e1 100644 --- a/harbour/contrib/hbct/tests/token2.prg +++ b/harbour/contrib/hbct/tests/token2.prg @@ -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 diff --git a/harbour/contrib/hbct/tests/tokenlow.prg b/harbour/contrib/hbct/tests/tokenlow.prg index 1edce62438..4986318167 100644 --- a/harbour/contrib/hbct/tests/tokenlow.prg +++ b/harbour/contrib/hbct/tests/tokenlow.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/tokensep.prg b/harbour/contrib/hbct/tests/tokensep.prg index 4176e58f65..6350ac7dd3 100644 --- a/harbour/contrib/hbct/tests/tokensep.prg +++ b/harbour/contrib/hbct/tests/tokensep.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/tokenupp.prg b/harbour/contrib/hbct/tests/tokenupp.prg index 47b3dd64af..f6e8d303c8 100644 --- a/harbour/contrib/hbct/tests/tokenupp.prg +++ b/harbour/contrib/hbct/tests/tokenupp.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/trig.prg b/harbour/contrib/hbct/tests/trig.prg index 8f0801ed10..eeb3f36948 100644 --- a/harbour/contrib/hbct/tests/trig.prg +++ b/harbour/contrib/hbct/tests/trig.prg @@ -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 - * * 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 diff --git a/harbour/contrib/hbct/tests/valpos.prg b/harbour/contrib/hbct/tests/valpos.prg index 19ee7d72fb..9550dd6210 100644 --- a/harbour/contrib/hbct/tests/valpos.prg +++ b/harbour/contrib/hbct/tests/valpos.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/wordone.prg b/harbour/contrib/hbct/tests/wordone.prg index c86cef0172..11e5795ec5 100644 --- a/harbour/contrib/hbct/tests/wordone.prg +++ b/harbour/contrib/hbct/tests/wordone.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/wordonly.prg b/harbour/contrib/hbct/tests/wordonly.prg index 9b89fc933d..0c02e31d8d 100644 --- a/harbour/contrib/hbct/tests/wordonly.prg +++ b/harbour/contrib/hbct/tests/wordonly.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/wordrem.prg b/harbour/contrib/hbct/tests/wordrem.prg index 5080ef73f9..80103187a5 100644 --- a/harbour/contrib/hbct/tests/wordrem.prg +++ b/harbour/contrib/hbct/tests/wordrem.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/wordrepl.prg b/harbour/contrib/hbct/tests/wordrepl.prg index d66ee69c08..2f50279843 100644 --- a/harbour/contrib/hbct/tests/wordrepl.prg +++ b/harbour/contrib/hbct/tests/wordrepl.prg @@ -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 @@ -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 diff --git a/harbour/contrib/hbct/tests/wordswap.prg b/harbour/contrib/hbct/tests/wordswap.prg index dc9c6e93d0..a808e87f11 100644 --- a/harbour/contrib/hbct/tests/wordswap.prg +++ b/harbour/contrib/hbct/tests/wordswap.prg @@ -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 @@ -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 diff --git a/harbour/tests/stripem.prg b/harbour/tests/stripem.prg index 0badf13d9c..3b7d44d370 100644 --- a/harbour/tests/stripem.prg +++ b/harbour/tests/stripem.prg @@ -1,8 +1,9 @@ -// -// $Id$ -// +/* + * $Id$ + */ #include "set.ch" + #xtranslate Default( , ) => IIF( == NIL, , ) // @@ -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 -// -// file name. No wild characters -// mode for opening. Default "R" -// Optional maximum blocksize -// -function New( cFileName, cMode, nBlock ) + // + // Method TextFile:New -> Create a new text file + // + // file name. No wild characters + // mode for opening. Default "R" + // 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 -// -// Text to write. May be any type. May also be an array containing -// one or more strings -// End with Carriage Return/Line Feed (Default == TRUE) -// -function WriteLn( xTxt, lCRLF ) + // + // WriteLn -> Write a line to a file + // + // Text to write. May be any type. May also be an array containing + // one or more strings + // 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 "?" diff --git a/harbour/tests/testbrw.prg b/harbour/tests/testbrw.prg index c3562b7859..d8c4f076a9 100644 --- a/harbour/tests/testbrw.prg +++ b/harbour/tests/testbrw.prg @@ -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