From e788d6d3e866fe37db2f81d7d830cbbeca5fa3c2 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 18 Jul 2012 12:00:10 +0000 Subject: [PATCH] 2012-07-18 13:54 UTC+0200 Viktor Szakats (harbour syenar.net) + contrib/hbgt/tests + contrib/hbgt/tests/test.prg + contrib/hbmisc/tests/rtfclass.prg - tests/rtfclass.prg - tests/test10.prg - tests/testgt.prg * tests/ac_test.prg * tests/alias.prg * tests/begin.prg * tests/boxtest.prg * tests/cdow.prg * tests/clasinh.prg * tests/dates.prg * tests/dates2.prg * tests/dates3.prg * tests/dates4.prg * tests/ddate.prg * tests/debugtst.prg * tests/delimtst.prg * tests/devtest.prg * tests/disptest.prg * tests/foreach.prg * tests/gtstdtst.prg * tests/ipclnt.prg * tests/ipsvr.prg * tests/langapi.prg * tests/memtst.prg * tests/memvar.prg * tests/menutest.prg * tests/mousetst.prg * tests/multiarg.prg * tests/newrdd.prg * tests/nums.prg * tests/objarr.prg * tests/objasign.prg * tests/objects.prg * tests/omacro.prg * tests/onidle.prg * tests/os.prg * tests/output.prg * tests/overload.prg * tests/parexpr.prg * tests/passref.prg * tests/procline.prg * tests/procname.prg * tests/recursiv.prg * tests/returns.prg * tests/round.prg * tests/say.prg * tests/sbartest.prg * tests/scroll.prg * tests/sdf_test.prg * tests/seconds.prg * tests/server.prg * tests/set_num.prg * tests/set_test.prg * tests/setkeys.prg * tests/sound.prg * tests/speed.prg * tests/statfun.prg * tests/statics.prg * tests/statics1.prg * tests/statics2.prg * tests/statinit.prg * tests/strdelim.prg * tests/stripem.prg * tests/switch.prg * tests/symbolt.prg * tests/t1.prg * tests/tb1.prg * tests/testbrdb.prg * tests/testbrw.prg * tests/testcdx.prg * tests/testcls.prg * tests/testdbf.prg * tests/testdecl.prg * tests/testerro.prg * tests/testfor.prg * tests/testget.prg * tests/testhrb.prg * tests/testhtml.prg * tests/testidle.prg * tests/testmem.prg * tests/testpers.prg * tests/testtok.prg * tests/testwarn.prg * tests/tstalias.prg * tests/tstasort.prg * tests/tstblock.prg * tests/tstdbi.prg * tests/tstmacro.prg * tests/varparam.prg * tests/wvt_fs.prg * cleaning up tests --- harbour/ChangeLog | 96 +++++ harbour/contrib/hbgt/tests/test.prg | 25 ++ harbour/contrib/hbmisc/tests/rtfclass.prg | 166 ++++++++ harbour/tests/ac_test.prg | 2 +- harbour/tests/alias.prg | 231 +++++------ harbour/tests/begin.prg | 188 ++++----- harbour/tests/boxtest.prg | 26 +- harbour/tests/cdow.prg | 2 +- harbour/tests/clasinh.prg | 38 +- harbour/tests/dates.prg | 114 +++--- harbour/tests/dates2.prg | 69 ++-- harbour/tests/dates3.prg | 36 +- harbour/tests/dates4.prg | 18 +- harbour/tests/ddate.prg | 9 +- harbour/tests/debugtst.prg | 246 ++++++------ harbour/tests/delimtst.prg | 47 +-- harbour/tests/devtest.prg | 36 +- harbour/tests/disptest.prg | 71 ++-- harbour/tests/foreach.prg | 115 +++--- harbour/tests/gtstdtst.prg | 92 ++--- harbour/tests/ipclnt.prg | 2 +- harbour/tests/ipsvr.prg | 2 +- harbour/tests/langapi.prg | 53 ++- harbour/tests/memtst.prg | 2 +- harbour/tests/memvar.prg | 455 ++++++++++++---------- harbour/tests/menutest.prg | 82 ++-- harbour/tests/mousetst.prg | 2 +- harbour/tests/multiarg.prg | 21 +- harbour/tests/newrdd.prg | 233 +++++------ harbour/tests/nums.prg | 22 +- harbour/tests/objarr.prg | 47 +-- harbour/tests/objasign.prg | 42 +- harbour/tests/objects.prg | 41 +- harbour/tests/omacro.prg | 37 +- harbour/tests/onidle.prg | 130 ++++--- harbour/tests/os.prg | 12 +- harbour/tests/output.prg | 32 +- harbour/tests/overload.prg | 51 ++- harbour/tests/parexpr.prg | 40 +- harbour/tests/passref.prg | 37 +- harbour/tests/procline.prg | 17 +- harbour/tests/procname.prg | 35 +- harbour/tests/recursiv.prg | 20 +- harbour/tests/returns.prg | 32 +- harbour/tests/round.prg | 29 +- harbour/tests/rtfclass.prg | 142 ------- harbour/tests/say.prg | 34 +- harbour/tests/sbartest.prg | 2 +- harbour/tests/scroll.prg | 75 ++-- harbour/tests/sdf_test.prg | 47 +-- harbour/tests/seconds.prg | 27 +- harbour/tests/server.prg | 8 +- harbour/tests/set_num.prg | 15 +- harbour/tests/set_test.prg | 137 +++---- harbour/tests/setkeys.prg | 113 +++--- harbour/tests/sound.prg | 23 +- harbour/tests/speed.prg | 33 +- harbour/tests/statfun.prg | 14 +- harbour/tests/statics.prg | 68 ++-- harbour/tests/statics1.prg | 12 +- harbour/tests/statics2.prg | 12 +- harbour/tests/statinit.prg | 10 +- harbour/tests/strdelim.prg | 18 +- harbour/tests/stripem.prg | 54 +-- harbour/tests/switch.prg | 24 +- harbour/tests/symbolt.prg | 8 +- harbour/tests/t1.prg | 24 +- harbour/tests/tb1.prg | 2 +- harbour/tests/test10.prg | 16 - harbour/tests/testbrdb.prg | 9 +- harbour/tests/testbrw.prg | 8 +- harbour/tests/testcdx.prg | 66 ++-- harbour/tests/testcls.prg | 19 +- harbour/tests/testdbf.prg | 119 +++--- harbour/tests/testdecl.prg | 69 ++-- harbour/tests/testerro.prg | 12 +- harbour/tests/testfor.prg | 8 +- harbour/tests/testget.prg | 21 +- harbour/tests/testgt.prg | 29 -- harbour/tests/testhrb.prg | 69 ++-- harbour/tests/testhtml.prg | 25 +- harbour/tests/testidle.prg | 4 +- harbour/tests/testmem.prg | 2 +- harbour/tests/testpers.prg | 29 +- harbour/tests/testtok.prg | 2 +- harbour/tests/testwarn.prg | 8 +- harbour/tests/tstalias.prg | 26 +- harbour/tests/tstasort.prg | 4 +- harbour/tests/tstblock.prg | 12 +- harbour/tests/tstdbi.prg | 2 +- harbour/tests/tstmacro.prg | 38 +- harbour/tests/varparam.prg | 300 +++++++------- harbour/tests/wvt_fs.prg | 2 +- 93 files changed, 2559 insertions(+), 2345 deletions(-) create mode 100644 harbour/contrib/hbgt/tests/test.prg create mode 100644 harbour/contrib/hbmisc/tests/rtfclass.prg delete mode 100644 harbour/tests/rtfclass.prg delete mode 100644 harbour/tests/test10.prg delete mode 100644 harbour/tests/testgt.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3a50b38548..aea214cafc 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,102 @@ The license applies to all entries newer than 2009-04-28. */ +2012-07-18 13:54 UTC+0200 Viktor Szakats (harbour syenar.net) + + contrib/hbgt/tests + + contrib/hbgt/tests/test.prg + + contrib/hbmisc/tests/rtfclass.prg + - tests/rtfclass.prg + - tests/test10.prg + - tests/testgt.prg + * tests/ac_test.prg + * tests/alias.prg + * tests/begin.prg + * tests/boxtest.prg + * tests/cdow.prg + * tests/clasinh.prg + * tests/dates.prg + * tests/dates2.prg + * tests/dates3.prg + * tests/dates4.prg + * tests/ddate.prg + * tests/debugtst.prg + * tests/delimtst.prg + * tests/devtest.prg + * tests/disptest.prg + * tests/foreach.prg + * tests/gtstdtst.prg + * tests/ipclnt.prg + * tests/ipsvr.prg + * tests/langapi.prg + * tests/memtst.prg + * tests/memvar.prg + * tests/menutest.prg + * tests/mousetst.prg + * tests/multiarg.prg + * tests/newrdd.prg + * tests/nums.prg + * tests/objarr.prg + * tests/objasign.prg + * tests/objects.prg + * tests/omacro.prg + * tests/onidle.prg + * tests/os.prg + * tests/output.prg + * tests/overload.prg + * tests/parexpr.prg + * tests/passref.prg + * tests/procline.prg + * tests/procname.prg + * tests/recursiv.prg + * tests/returns.prg + * tests/round.prg + * tests/say.prg + * tests/sbartest.prg + * tests/scroll.prg + * tests/sdf_test.prg + * tests/seconds.prg + * tests/server.prg + * tests/set_num.prg + * tests/set_test.prg + * tests/setkeys.prg + * tests/sound.prg + * tests/speed.prg + * tests/statfun.prg + * tests/statics.prg + * tests/statics1.prg + * tests/statics2.prg + * tests/statinit.prg + * tests/strdelim.prg + * tests/stripem.prg + * tests/switch.prg + * tests/symbolt.prg + * tests/t1.prg + * tests/tb1.prg + * tests/testbrdb.prg + * tests/testbrw.prg + * tests/testcdx.prg + * tests/testcls.prg + * tests/testdbf.prg + * tests/testdecl.prg + * tests/testerro.prg + * tests/testfor.prg + * tests/testget.prg + * tests/testhrb.prg + * tests/testhtml.prg + * tests/testidle.prg + * tests/testmem.prg + * tests/testpers.prg + * tests/testtok.prg + * tests/testwarn.prg + * tests/tstalias.prg + * tests/tstasort.prg + * tests/tstblock.prg + * tests/tstdbi.prg + * tests/tstmacro.prg + * tests/varparam.prg + * tests/wvt_fs.prg + * cleaning up tests + 2012-07-18 12:43 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib/hbct/addascii.c * contrib/hbct/ascpos.c diff --git a/harbour/contrib/hbgt/tests/test.prg b/harbour/contrib/hbgt/tests/test.prg new file mode 100644 index 0000000000..7f6db7e083 --- /dev/null +++ b/harbour/contrib/hbgt/tests/test.prg @@ -0,0 +1,25 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + QOut( 'gt_ascpos("Harbour",1) => ' + LTrim( Str(gt_ascpos("Harbour",1 ) ) ) ) + QOut( 'gt_atdiff("This Is Harbour","This Is Clipper") => ' + LTrim( Str(gt_atdiff("This Is Harbour","This Is Clipper" ) ) ) ) + QOut( 'gt_chareven("The_Power_Of_Harbour") => ' + gt_chareven( "The_Power_Of_Harbour" ) ) + QOut( 'gt_charodd("The_Power_Of_Harbour") => ' + gt_charodd( "The_Power_Of_Harbour" ) ) + QOut( 'gt_chrcount("s","she sells shells by the sea shore") => ' + LTrim( Str(gt_chrcount("s","she sells shells by the sea shore" ) ) ) ) + QOut( 'gt_chrtotal("sl","she sells shells by the sea shore") => ' + LTrim( Str(gt_chrtotal("sl","she sells shells by the sea shore" ) ) ) ) + QOut( 'gt_charmix("CLIPPER","harbour") => ' + gt_charmix( "CLIPPER","harbour" ) ) + QOut( 'gt_asciisum("harbour") => ' + LTrim( Str(gt_asciisum("harbour" ) ) ) ) + QOut( 'gt_chrfirst("Ho", "the power of Harbour") => ' + LTrim( Str(gt_chrfirst("Ho", "the power of Harbour" ) ) ) ) + QOut( 'gt_strcount("the", "the cat sat on the mat") => ' + LTrim( Str(gt_strcount("the", "the cat sat on the mat" ) ) ) ) + QOut( 'gt_strcspn("this is a test", "as ") => ' + LTrim( Str(gt_strcspn("this is a test", "as " ) ) ) ) + QOut( 'gt_strcspn("this is a test", "elnjpq") => ' + LTrim( Str(gt_strcspn("this is a test", "elnjpq" ) ) ) ) + QOut( 'gt_strDiff("the cat", "the rat") => ' + gt_strDiff( "the cat", "the rat" ) ) + QOut( 'gt_strexpand("HARBOUR", 2,"-") => ' + gt_strexpand( "HARBOUR", 2,"-" ) ) + QOut( 'gt_strleft("this is a test", "hsit ") => ' + LTrim( Str(gt_strleft("this is a test", "hsit " ) ) ) ) + QOut( 'gt_strpbrk("this is a test", "sa ") => ' + gt_strpbrk( "this is a test", "sa " ) ) + QOut( 'gt_strright("this is a test", "teas ") => ' + LTrim( Str(gt_strright("this is a test", "teas " ) ) ) ) + + RETURN diff --git a/harbour/contrib/hbmisc/tests/rtfclass.prg b/harbour/contrib/hbmisc/tests/rtfclass.prg new file mode 100644 index 0000000000..62efb1eca8 --- /dev/null +++ b/harbour/contrib/hbmisc/tests/rtfclass.prg @@ -0,0 +1,166 @@ +/* + * $Id$ + */ + +/* + * harbour rtfclass demo + * notes : - raw enough but it works + - using hb_f*() - some compilers are not friendly with this :( + - rtf is assumed to have association + * initial release : 23 June 1999 Andi Jahja + * tested under Windows 98 only with RTF associated to Winword + * works with printable ascii only + * placed in the public domain +*/ + +#define CRLF CHR(13) + CHR(10) + +PROCEDURE Main() + + LOCAL ortf := trtf():new( "test.rtf" ) + LOCAL htest := FCreate( "rtf_test.txt" ) + LOCAL ctest := "" + + // create a plain text file + ctest += "This is +bHarbour © RTF Class-b" + CRLF + ctest += "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG" + CRLF + ctest += "+bTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-b" + CRLF + ctest += "+iTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-i" + CRLF + ctest += "+buTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bu" + CRLF + ctest += "+buiTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bui" + CRLF + ctest += "THE +bQUICK-b +buBROWN-bu +buiFOX-bui +iJUMPS-i +uOVER-u +ilTHE-il +uLAZY-u +buDOG-bu" + CRLF + + FWrite( htest, ctest ) + FClose( htest ) + + // convert text file to rtf + ortf:write( "rtf_test.txt" ) + ortf:close() + + // execute file association ( windows only ) + IF Lower( OS() ) == "windows" + // assuming start.exe is exist + __Run( "start test.rtf" ) + ENDIF + + RETURN + +FUNCTION trtf() + + STATIC oclass + + IF oclass == nil + oclass := HBClass():new( "trtf" ) + oclass:adddata( "nhandle" ) + oclass:addmethod( "new", @new() ) + oclass:addmethod( "write", @write() ) + oclass:addmethod( "close", @close() ) + oclass:create() + ENDIF + + RETURN oclass:instance() + +STATIC FUNCTION new( cfilename ) + + LOCAL self := qself() + + ::nhandle := FCreate( cfilename ) + FWrite( ::nhandle, ; + "{\rtf1\ansi\deff0{\fonttbl {\f0\fnil\fcharset0 Courier New;}{\f1\fnil\fcharset0 Arial;}}" + ; + "\uc1\pard\lang1033\ulnone\f0\fs20" + CRLF ) + + RETURN self + +STATIC FUNCTION write( csource ) + + LOCAL self := qself() + LOCAL cchar, cline, xatt, i, _xatt + LOCAL n, nchar, xchar, y + + // These are character attributes, self-defined + // + means a turn-on + // - means a turn-off + LOCAL attrib := { ; + { "+b" , "\b " } /* turn bold on*/ + , ; + { "+bu" , "\ul\b " } /* turn bold_underline on */ + , ; + { "+bi" , "\b\i " } /* turn bold_italic on */ + , ; + { "+bui", "\ul\b\i " } /* turn bold_underline_italic on */ + , ; + { "+i" , "\i " } /* turn italic on */ + , ; + { "+il" , "\ul\i " } /* turn italic_underline on */ + , ; + { "+u" , "\ul " } /* turn underline on */ + , ; + { "-b" , "\b0 " } /* turn bold off */ + , ; + { "-bu" , "\b0\ulnone " } /* turn bold_underline off */ + , ; + { "-bi" , "\b0\i0 " } /* turn bold_italic off */ + , ; + { "-bui", "\b0\i0\ulnone " } /* turn bold_underline_italic off */ + , ; + { "-i" , "\i0 " } /* turn italic off */ + , ; + { "-il" , "\ulnone\i0 " } /* turn italic_underline off */ + , ; + { "-u" , "\ulnone " } /* turn underline off */ + } + + hb_fuse( csource ) // open source file + WHILE !hb_FEof() // read the file line by line + cline := hb_freadln() + "\par" + y := Len( cline ) + for nchar := 1 TO y + cchar := SubStr( cline, nchar, 1 ) + + // todo : i need function dec2hex() + // to convert ascii to 2-characters hex + // ie : dec2hex( "H" ) -> 48 + IF cchar == "+" .OR. cchar == "-" + xatt := cchar + ; + SubStr( cline, nchar + 1, 1 ) + ; + SubStr( cline, nchar + 2, 1 ) + ; + SubStr( cline, nchar + 3, 1 ) + IF ( i := AScan( attrib, { |e| e[1] == xatt } ) ) > 0 + FWrite( ::nhandle, attrib[i][2] ) + nchar := nchar + Len( xatt ) - 1 + ELSE + // 3 attributes + xatt := Left( xatt, 3 ) + IF ( i := AScan( attrib, { |e| e[1] == xatt } ) ) > 0 + FWrite( ::nhandle, attrib[i][2] ) + nchar := nchar + Len( xatt ) - 1 + ELSE + // 2 attributes + xatt := Left( xatt, 2 ) + IF ( i := AScan( attrib, { |e| e[1] == xatt } ) ) > 0 + FWrite( ::nhandle, attrib[i][2] ) + nchar := nchar + Len( xatt ) - 1 + ELSE + FWrite( ::nhandle, cchar ) + ENDIF + ENDIF + ENDIF + ELSE + FWrite( ::nhandle, cchar ) + ENDIF + next + FWrite( ::nhandle, CRLF ) + hb_fskip() // read next line + ENDDO + hb_fuse() + + RETURN ( self ) + +STATIC FUNCTION CLOSE() + + LOCAL self := qself() + + FWrite( ::nhandle, "\f1\fs16\par" + CRLF + "}" ) + FClose( ::nhandle ) + + RETURN self diff --git a/harbour/tests/ac_test.prg b/harbour/tests/ac_test.prg index e7e45f0d97..82807c2636 100644 --- a/harbour/tests/ac_test.prg +++ b/harbour/tests/ac_test.prg @@ -27,7 +27,7 @@ //+-------------------------------------------------------------------- //+ -PROCEDURE main() +PROCEDURE Main() LOCAL aPrompts := { ; "AGRI-PLANTS" , ; diff --git a/harbour/tests/alias.prg b/harbour/tests/alias.prg index 74a4347b14..a5c641a2e4 100644 --- a/harbour/tests/alias.prg +++ b/harbour/tests/alias.prg @@ -1,133 +1,136 @@ //NOTEST -// $Id$ -// -//It is used to check if pcode is generated correctly for aliased expressions -//(you must check it visually :) -// -PROCEDURE MAIN() -LOCAL localVar -STATIC staticVar -FIELD fieldVar -FIELD aliasedField IN aaa -MEMVAR memvarVar -PRIVATE privateVar +/* + * $Id$ + */ - ? privateVar - ? memvarVar - ? localVar - ? staticVar - ? fieldVar - ? aliasedField - ? unknVar +// It is used to check if pcode is generated correctly for aliased expressions +// (you must check it visually :) - ? 1->privateVar - ? 1->memvarVar - ? 1->localVar - ? 1->staticVar - ? 1->fieldVar - ? 1->aliasedField - ? 1->unknVar +PROCEDURE Main() - ? alias->privateVar - ? alias->memvarVar - ? alias->localVar - ? alias->staticVar - ? alias->fieldVar - ? alias->aliasedField - ? alias->unknVar + LOCAL localVar + STATIC staticVar + FIELD fieldVar + FIELD aliasedField IN aaa + MEMVAR memvarVar + PRIVATE privateVar - ? ( localVar )->privateVar - ? ( localVar )->memvarVar - ? ( localVar )->localVar - ? ( localVar )->staticVar - ? ( localVar )->fieldVar - ? ( localVar )->aliasedField - ? ( localVar )->unknVar + ? privateVar + ? memvarVar + ? localVar + ? staticVar + ? fieldVar + ? aliasedField + ? unknVar - ? ( localVar )->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) - ? alias->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) - ? 2->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) - ? ( localVar, 2 )->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) + ? 1->privateVar + ? 1->memvarVar + ? 1->localVar + ? 1->staticVar + ? 1->fieldVar + ? 1->aliasedField + ? 1->unknVar - ? privateVar++ - ? memvarVar++ - ? localVar++ - ? staticVar++ - ? fieldVar++ - ? aliasedField++ - ? unknVar++ + ? alias->privateVar + ? alias->memvarVar + ? alias->localVar + ? alias->staticVar + ? alias->fieldVar + ? alias->aliasedField + ? alias->unknVar - ? 1->privateVar++ - ? 1->memvarVar++ - ? 1->localVar++ - ? 1->staticVar++ - ? 1->fieldVar++ - ? 1->aliasedField++ - ? 1->unknVar++ + ? ( localVar )->privateVar + ? ( localVar )->memvarVar + ? ( localVar )->localVar + ? ( localVar )->staticVar + ? ( localVar )->fieldVar + ? ( localVar )->aliasedField + ? ( localVar )->unknVar - ? alias->privateVar++ - ? alias->memvarVar++ - ? alias->localVar++ - ? alias->staticVar++ - ? alias->fieldVar++ - ? alias->aliasedField++ - ? alias->unknVar++ + ? ( localVar )->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) + ? alias->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) + ? 2->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) + ? ( localVar, 2 )->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar ) - ? ( localVar )->privateVar++ - ? ( localVar )->memvarVar++ - ? ( localVar )->localVar++ - ? ( localVar )->staticVar++ - ? ( localVar )->fieldVar++ - ? ( localVar )->aliasedField++ - ? ( localVar )->unknVar++ + ? privateVar ++ + ? memvarVar ++ + ? localVar ++ + ? staticVar ++ + ? fieldVar ++ + ? aliasedField ++ + ? unknVar ++ - ? privateVar +=privateVar - ? memvarVar +=memvarVar - ? localVar +=localVar - ? staticVar +=staticVar - ? fieldVar +=fieldVar - ? aliasedField +=aliasedField - ? unknVar +=unknVar + ? 1->privateVar ++ + ? 1->memvarVar ++ + ? 1->localVar ++ + ? 1->staticVar ++ + ? 1->fieldVar ++ + ? 1->aliasedField ++ + ? 1->unknVar ++ - ? 1->privateVar +=1->privateVar - ? 1->memvarVar +=1->memvarVar - ? 1->localVar +=1->localVar - ? 1->staticVar +=1->staticVar - ? 1->fieldVar +=1->fieldVar - ? 1->aliasedField +=1->aliasedField - ? 1->unknVar +=1->unknVar + ? alias->privateVar ++ + ? alias->memvarVar ++ + ? alias->localVar ++ + ? alias->staticVar ++ + ? alias->fieldVar ++ + ? alias->aliasedField ++ + ? alias->unknVar ++ - ? alias->privateVar +=alias->privateVar - ? alias->memvarVar +=alias->memvarVar - ? alias->localVar +=alias->localVar - ? alias->staticVar +=alias->staticVar - ? alias->fieldVar +=alias->fieldVar - ? alias->aliasedField +=alias->aliasedField - ? alias->unknVar +=alias->unknVar + ? ( localVar )->privateVar ++ + ? ( localVar )->memvarVar ++ + ? ( localVar )->localVar ++ + ? ( localVar )->staticVar ++ + ? ( localVar )->fieldVar ++ + ? ( localVar )->aliasedField ++ + ? ( localVar )->unknVar ++ - ? ( localVar )->privateVar +=( localVar )->privateVar - ? ( localVar )->memvarVar +=( localVar )->memvarVar - ? ( localVar )->localVar +=( localVar )->localVar - ? ( localVar )->staticVar +=( localVar )->staticVar - ? ( localVar )->fieldVar +=( localVar )->fieldVar - ? ( localVar )->aliasedField +=( localVar )->aliasedField - ? ( localVar )->unknVar +=( localVar )->unknVar + ? privateVar += privateVar + ? memvarVar += memvarVar + ? localVar += localVar + ? staticVar += staticVar + ? fieldVar += fieldVar + ? aliasedField += aliasedField + ? unknVar += unknVar - ? ( localVar )->privateVar +=2->privateVar - ? ( localVar )->memvarVar +=2->memvarVar - ? ( localVar )->localVar +=2->localVar - ? ( localVar )->staticVar +=2->staticVar - ? ( localVar )->fieldVar +=2->fieldVar - ? ( localVar )->aliasedField +=2->aliasedField - ? ( localVar )->unknVar +=2->unknVar + ? 1->privateVar += 1->privateVar + ? 1->memvarVar += 1->memvarVar + ? 1->localVar += 1->localVar + ? 1->staticVar += 1->staticVar + ? 1->fieldVar += 1->fieldVar + ? 1->aliasedField += 1->aliasedField + ? 1->unknVar += 1->unknVar - ? alias->( aliasedField, MEMVAR->privateVar, 1->(Test( 2->fieldVar )) ) + ? alias->privateVar += alias->privateVar + ? alias->memvarVar += alias->memvarVar + ? alias->localVar += alias->localVar + ? alias->staticVar += alias->staticVar + ? alias->fieldVar += alias->fieldVar + ? alias->aliasedField += alias->aliasedField + ? alias->unknVar += alias->unknVar - MEMVAR->privateVar :=0 - M->localVar :=1 - MEMVA->fieldVar :=2 + ? ( localVar )->privateVar += ( localVar )->privateVar + ? ( localVar )->memvarVar += ( localVar )->memvarVar + ? ( localVar )->localVar += ( localVar )->localVar + ? ( localVar )->staticVar += ( localVar )->staticVar + ? ( localVar )->fieldVar += ( localVar )->fieldVar + ? ( localVar )->aliasedField += ( localVar )->aliasedField + ? ( localVar )->unknVar += ( localVar )->unknVar - FIELD->fieldVar :=0 - FIEL->aliasedFieldVar :=1 + ? ( localVar )->privateVar += 2->privateVar + ? ( localVar )->memvarVar += 2->memvarVar + ? ( localVar )->localVar += 2->localVar + ? ( localVar )->staticVar += 2->staticVar + ? ( localVar )->fieldVar += 2->fieldVar + ? ( localVar )->aliasedField += 2->aliasedField + ? ( localVar )->unknVar += 2->unknVar -RETURN + ? alias->( aliasedField, MEMVAR->privateVar, 1->( Test( 2->fieldVar ) ) ) + + MEMVAR->privateVar := 0 + M->localVar := 1 + MEMVA->fieldVar := 2 + + FIELD->fieldVar := 0 + FIEL->aliasedFieldVar := 1 + + RETURN diff --git a/harbour/tests/begin.prg b/harbour/tests/begin.prg index 7539e4378f..1a3e436508 100644 --- a/harbour/tests/begin.prg +++ b/harbour/tests/begin.prg @@ -1,132 +1,134 @@ -// -// $Id$ -// +/* + * $Id$ + */ + // This files demonstrates the use of BEGIN/RECOVER/END SEQUENCE // and BREAK statement -// + MEMVAR oMemvar MEMVAR mPrivate -PROCEDURE MAIN -LOCAL oLocal -PRIVATE mPrivate:='private value in MAIN' +PROCEDURE Main() + + LOCAL oLocal + PRIVATE mPrivate := 'private value in MAIN' + + BEGIN SEQUENCE + ? " Inside SEQUENCE 1" + ? " No break issued...." + RECOVER + ? " Recovering in 1 ..." + END SEQUENCE + ? "After SEQUENCE 1" - BEGIN SEQUENCE - ? " Inside SEQUENCE 1" - ? " No break issued...." - RECOVER - ? " Recovering in 1 ..." - END SEQUENCE - ? "After SEQUENCE 1" + BEGIN SEQUENCE + ? " Inside SEQUENCE 2" + Break( "VALUE 2" ) + RECOVER USING oLocal + ? " Recovering in 2 using....", oLocal + END SEQUENCE + ? "After SEQUENCE 2" - BEGIN SEQUENCE - ? " Inside SEQUENCE 2" - Break( "VALUE 2" ) - RECOVER USING oLocal - ? " Recovering in 2 using....", oLocal - END SEQUENCE - ? "After SEQUENCE 2" + BEGIN SEQUENCE + ? " Inside SEQUENCE 3" + Break + RECOVER USING oLocal + ? " Recovering in 3 using....", oLocal + END SEQUENCE + ? "After SEQUENCE 3" - BEGIN SEQUENCE - ? " Inside SEQUENCE 3" - Break - RECOVER USING oLocal - ? " Recovering in 3 using....", oLocal - END SEQUENCE - ? "After SEQUENCE 3" + BEGIN SEQUENCE + ? " Inside SEQUENCE 4" + Break + ? " Recovering in 4 using....", oLocal + END SEQUENCE + ? "After SEQUENCE 4" - BEGIN SEQUENCE - ? " Inside SEQUENCE 4" - Break - ? " Recovering in 4 using....", oLocal - END SEQUENCE - ? "After SEQUENCE 4" + BEGIN SEQUENCE + ? " Inside SEQUENCE 5" + Break1( ) + ? " Recovering in 5 using....", oLocal + END SEQUENCE + ? "After SEQUENCE 5" - BEGIN SEQUENCE - ? " Inside SEQUENCE 5" - Break1( ) - ? " Recovering in 5 using....", oLocal - END SEQUENCE - ? "After SEQUENCE 5" + BEGIN SEQUENCE + ? " Inside SEQUENCE 6" + Break1( ) + RECOVER USING oMemvar + ? " Recovering in 6 using... ", oMemvar + END SEQUENCE + ? "After SEQUENCE 6" - BEGIN SEQUENCE - ? " Inside SEQUENCE 6" - Break1( ) - RECOVER USING oMemvar - ? " Recovering in 6 using... ", oMemvar - END SEQUENCE - ? "After SEQUENCE 6" + BEGIN SEQUENCE + ? " Inside SEQUENCE 7" + Break2( ) + RECOVER USING oMemvar + ? " Recovering in 7 using... ", oMemvar + END SEQUENCE + ? "After SEQUENCE 7" + ? M->mPrivate + Break( "exit from MAIN" ) + ? "This text will be not printed" - BEGIN SEQUENCE - ? " Inside SEQUENCE 7" - Break2( ) - RECOVER USING oMemvar - ? " Recovering in 7 using... ", oMemvar - END SEQUENCE - ? "After SEQUENCE 7" - - ? M->mPrivate - BREAK( "exit from MAIN" ) - ? "This text will be not printed" - -RETURN + RETURN PROCEDURE Break1() -PRIVATE mPrivate:='VALUE from Break1' - BREAK M->mPrivate + PRIVATE mPrivate := 'VALUE from Break1' -RETURN + BREAK M->mPrivate + + RETURN PROCEDURE Break2() - BEGIN SEQUENCE - ? " Inside SEQUENCE 8" - Break3( ) - RECOVER USING oMemvar - ? " Recovering in 8 using...", EVAL( oMemvar, ' eval in 8' ) - BREAK( "BREAK from recovery code" ) - END SEQUENCE - ? "After SEQUENCE 8" - -RETURN + BEGIN SEQUENCE + ? " Inside SEQUENCE 8" + Break3( ) + RECOVER USING oMemvar + ? " Recovering in 8 using...", Eval( oMemvar, ' eval in 8' ) + Break( "BREAK from recovery code" ) + END SEQUENCE + ? "After SEQUENCE 8" + RETURN PROCEDURE Break3() -STATIC oStatic - BEGIN SEQUENCE - ? " Inside SEQUENCE 9" + STATIC oStatic - BEGIN SEQUENCE - ? " Inside SEQUENCE 10" - Break( "value from nested SEQUENCE 10" ) - RECOVER USING oStatic - ? " Recovering in 10 using...", oStatic - END SEQUENCE - ? "After SEQUENCE 10" + BEGIN SEQUENCE + ? " Inside SEQUENCE 9" - Break4( " and parameter" ) + BEGIN SEQUENCE + ? " Inside SEQUENCE 10" + Break( "value from nested SEQUENCE 10" ) + RECOVER USING oStatic + ? " Recovering in 10 using...", oStatic + END SEQUENCE + ? "After SEQUENCE 10" - RECOVER USING oMemvar - ? " Recovering in 9 using...", EVAL( oMemvar, ' eval in 9' ) - BREAK( oMemvar ) - END SEQUENCE - ? "After SEQUENCE 9" + Break4( " and parameter" ) -RETURN + RECOVER USING oMemvar + ? " Recovering in 9 using...", Eval( oMemvar, ' eval in 9' ) + Break( oMemvar ) + END SEQUENCE + ? "After SEQUENCE 9" + RETURN PROCEDURE Break4( cValue ) -LOCAL oLocal:=' detached Break4 ' - BREAK( {|x| oLocal + x + cValue} ) + LOCAL oLocal := ' detached Break4 ' -RETURN \ No newline at end of file + Break( {| x | oLocal + x + cValue } ) + + RETURN diff --git a/harbour/tests/boxtest.prg b/harbour/tests/boxtest.prg index 4627465edc..983e08ba97 100644 --- a/harbour/tests/boxtest.prg +++ b/harbour/tests/boxtest.prg @@ -2,30 +2,32 @@ * $Id$ */ -function main() +PROCEDURE Main() CLS @ 0, 0, 15, 50 BOX " " COLOR "W+/B" MESSAGE( [@ 0, 0, 15, 50 BOX " " COLOR "W+/B"] ) - __BOX( 1, 1, 5, 7 ) + __Box( 1, 1, 5, 7 ) MESSAGE( [__BOX( 1, 1, 5, 7 )] ) - __BOX( 1, 1, 5, 7, "X" ) + __Box( 1, 1, 5, 7, "X" ) MESSAGE( [__BOX( 1, 1, 5, 7, "X" )] ) - __BOXD( 2, 2, 6, 8 ) + __BoxD( 2, 2, 6, 8 ) MESSAGE( [__BOXD( 2, 2, 6, 8 )] ) - __BOXS( 3, 3, 7, 9 ) + __BoxS( 3, 3, 7, 9 ) MESSAGE( [__BOXS( 3, 3, 7, 9 )] ) -return nil + RETURN -procedure MESSAGE( cText ) - @ 16,0 CLEAR TO 16,79 - @ 16,0 SAY cText - OUTSTD( CHR( 7 ) ) - INKEY( 0 ) -return \ No newline at end of file +PROCEDURE MESSAGE( cText ) + + @ 16, 0 CLEAR TO 16, 79 + @ 16, 0 SAY cText + OutStd( Chr( 7 ) ) + Inkey( 0 ) + + RETURN diff --git a/harbour/tests/cdow.prg b/harbour/tests/cdow.prg index 8220b0f6ad..b06633a179 100644 --- a/harbour/tests/cdow.prg +++ b/harbour/tests/cdow.prg @@ -2,7 +2,7 @@ * $Id$ */ -PROCEDURE main() +PROCEDURE Main() OutStd( cMonth( date() ) + hb_eol() ) OutStd( cMonth( date() + 31 ) + hb_eol() ) diff --git a/harbour/tests/clasinh.prg b/harbour/tests/clasinh.prg index 4c18762d34..7052887d02 100644 --- a/harbour/tests/clasinh.prg +++ b/harbour/tests/clasinh.prg @@ -4,25 +4,35 @@ #include "hbclass.ch" -function main() - local oObject, oBase +PROCEDURE Main() + + LOCAL oObject, oBase + oObject := TAnyClass():New() oBase := TClassBase():New() -return nil -class TClassBase - method New() - method Test() INLINE Alert( "Test" ) -endclass + RETURN -method New() class TClassBase -return Self +CREATE CLASS TClassBase -class TAnyClass from TClassBase - method New() -endclass + METHOD New() + METHOD Test() INLINE Alert( "Test" ) + +ENDCLASS + +METHOD New() CLASS TClassBase + + RETURN Self + +CREATE CLASS TAnyClass FROM TClassBase + + METHOD New() + +ENDCLASS + +METHOD New() CLASS TAnyClass -method New() class TAnyClass super:New() super:Test() -return Self \ No newline at end of file + + RETURN Self diff --git a/harbour/tests/dates.prg b/harbour/tests/dates.prg index 1e86df7acf..7af28e1c08 100644 --- a/harbour/tests/dates.prg +++ b/harbour/tests/dates.prg @@ -6,84 +6,86 @@ #include "set.ch" -function Main() +PROCEDURE Main() - local dDate, dDate2, cMask, cDate + LOCAL dDate, dDate2, cMask, cDate - OUTSTD (hb_eol(), "Testing Harbour dates management on", DATE()) + OutStd( hb_eol(), "Testing Harbour dates management on", Date() ) TestCentury() - OUTSTD (hb_eol(), "") - OUTSTD (hb_eol(), "dDate := CToD( '02/04/1999' ) =>", dDate := CToD( "02/04/1999" )) + OutStd( hb_eol(), "" ) + OutStd( hb_eol(), "dDate := CToD( '02/04/1999' ) =>", dDate := CToD( "02/04/1999" ) ) - OUTSTD (hb_eol(), "ValType( dDate ) =", ValType( dDate )) + OutStd( hb_eol(), "ValType( dDate ) =", ValType( dDate ) ) - OUTSTD (hb_eol(), "Day( dDate ) =", Day( dDate )) - OUTSTD (hb_eol(), "Month( dDate ) =", Month( dDate )) - OUTSTD (hb_eol(), "Year( dDate ) =", Year( dDate ), hb_eol()) + OutStd( hb_eol(), "Day( dDate ) =", Day( dDate ) ) + OutStd( hb_eol(), "Month( dDate ) =", Month( dDate ) ) + OutStd( hb_eol(), "Year( dDate ) =", Year( dDate ), hb_eol() ) - OUTSTD (hb_eol(), "dDate + 5 =", dDate2 := dDate + 5) - OUTSTD (hb_eol(), "dDate - 5 =", dDate - 5, hb_eol() ) + OutStd( hb_eol(), "dDate + 5 =", dDate2 := dDate + 5 ) + OutStd( hb_eol(), "dDate - 5 =", dDate - 5, hb_eol() ) - OUTSTD (hb_eol(), "dDate2 - dDate =", dDate2 - dDate) + OutStd( hb_eol(), "dDate2 - dDate =", dDate2 - dDate ) - OUTSTD (hb_eol(), "") - OUTSTD (hb_eol(), dDate, DTOS (dDate)) + OutStd( hb_eol(), "" ) + OutStd( hb_eol(), dDate, DToS ( dDate ) ) - OUTSTD (hb_eol(), "19990429", STOD ("19990429")) + OutStd( hb_eol(), "19990429", SToD ( "19990429" ) ) - OUTSTD (hb_eol(), "") - SET (_SET_EPOCH, 1950) + OutStd( hb_eol(), "" ) + SET ( _SET_EPOCH, 1950 ) cMask := "dd/mm/yyyy" cDate := "02/04/49" - SET (_SET_DATEFORMAT, cMask) - dDate := CTOD (cDate) - OUTSTD (hb_eol(), cDate, cMask, dDate, DTOS (dDate), DTOC (dDate)) + SET ( _SET_DATEFORMAT, cMask ) + dDate := CToD ( cDate ) + OutStd( hb_eol(), cDate, cMask, dDate, DToS ( dDate ), DToC ( dDate ) ) - OUTSTD (hb_eol(), "") + OutStd( hb_eol(), "" ) cMask := "mm/dd/yyyy" - SET (_SET_DATEFORMAT, cMask) - dDate := CTOD (cDate) - OUTSTD (hb_eol(), cDate, cMask, dDate, DTOS (dDate), DTOC (dDate)) + SET ( _SET_DATEFORMAT, cMask ) + dDate := CToD ( cDate ) + OutStd( hb_eol(), cDate, cMask, dDate, DToS ( dDate ), DToC ( dDate ) ) - OUTSTD (hb_eol(), "") + OutStd( hb_eol(), "" ) cMask := "yyyy/mm/dd" - SET (_SET_DATEFORMAT, cMask) - dDate := CTOD (cDate) - OUTSTD (hb_eol(), cDate, cMask, dDate, DTOS (dDate), DTOC (dDate)) - OUTSTD (hb_eol(), "") - OUTSTD (hb_eol(), "49/02/04", cMask, CTOD ("49/02/04")) + SET ( _SET_DATEFORMAT, cMask ) + dDate := CToD ( cDate ) + OutStd( hb_eol(), cDate, cMask, dDate, DToS ( dDate ), DToC ( dDate ) ) + OutStd( hb_eol(), "" ) + OutStd( hb_eol(), "49/02/04", cMask, CToD ( "49/02/04" ) ) - TestCentury(hb_eol()) + TestCentury( hb_eol() ) - OUTSTD (hb_eol(), "") + OutStd( hb_eol(), "" ) cMask := "yyyy/dd/mm" - SET (_SET_DATEFORMAT, cMask) - dDate := CTOD (cDate) - OUTSTD (hb_eol(), cDate, cMask, dDate, DTOS (dDate), DTOC (dDate)) - OUTSTD (hb_eol(), "") - OUTSTD (hb_eol(), "49/02/04", cMask, CTOD ("49/02/04")) + SET ( _SET_DATEFORMAT, cMask ) + dDate := CToD ( cDate ) + OutStd( hb_eol(), cDate, cMask, dDate, DToS ( dDate ), DToC ( dDate ) ) + OutStd( hb_eol(), "" ) + OutStd( hb_eol(), "49/02/04", cMask, CToD ( "49/02/04" ) ) - OUTSTD (hb_eol(), "") + OutStd( hb_eol(), "" ) cMask := "ddd/mmm/yy" - SET (_SET_DATEFORMAT, cMask) - dDate := CTOD (cDate) - OUTSTD (hb_eol(), cDate, cMask, dDate, DTOS (dDate), DTOC (dDate)) + SET ( _SET_DATEFORMAT, cMask ) + dDate := CToD ( cDate ) + OutStd( hb_eol(), cDate, cMask, dDate, DToS ( dDate ), DToC ( dDate ) ) - return nil + RETURN -procedure TestCentury() - OUTSTD (hb_eol(), "") - OUTSTD (hb_eol(), __SETCENTURY ()) - __SETCENTURY ("ON") - OUTSTD (__SETCENTURY ()) - __SETCENTURY ("OFF") - OUTSTD (__SETCENTURY ()) - __SETCENTURY ("GIBBERISH") - OUTSTD (__SETCENTURY ()) - __SETCENTURY (.T.) - OUTSTD (__SETCENTURY ()) - __SETCENTURY (5) - OUTSTD (__SETCENTURY ()) - return +PROCEDURE TestCentury() + + OutStd( hb_eol(), "" ) + OutStd( hb_eol(), __SetCentury () ) + __SetCentury ( "ON" ) + OutStd ( __SetCentury () ) + __SetCentury ( "OFF" ) + OutStd ( __SetCentury () ) + __SetCentury ( "GIBBERISH" ) + OutStd ( __SetCentury () ) + __SetCentury ( .T. ) + OutStd ( __SetCentury () ) + __SetCentury ( 5 ) + OutStd ( __SetCentury () ) + + RETURN diff --git a/harbour/tests/dates2.prg b/harbour/tests/dates2.prg index 9f41446684..34a3712b6b 100644 --- a/harbour/tests/dates2.prg +++ b/harbour/tests/dates2.prg @@ -4,39 +4,40 @@ #include "set.ch" -function main() - local dDate := CTOD ("04/30/99") +PROCEDURE Main() - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - set (_SET_DATEFORMAT, "yyy/mm/ddd") - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "on" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "off" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - set (_SET_DATEFORMAT, "yyy/m/d/yyy") - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "on" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "off" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - set (_SET_DATEFORMAT, "m/d/y/m/d") - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "on" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "off" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - set (_SET_DATEFORMAT, "mmmm/ddddd") - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "on" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "off" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - set (_SET_DATEFORMAT, "mmmmm/dd") - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "on" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) - __SETCENTURY ( "off" ) - outstd (SET (_SET_DATEFORMAT), dDate, hb_eol()) + LOCAL dDate := hb_SToD( "19990430" ) - return nil + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + SET( _SET_DATEFORMAT, "yyy/mm/ddd" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "on" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "off" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + SET( _SET_DATEFORMAT, "yyy/m/d/yyy" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "on" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "off" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + SET( _SET_DATEFORMAT, "m/d/y/m/d" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "on" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "off" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + SET( _SET_DATEFORMAT, "mmmm/ddddd" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "on" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "off" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + SET( _SET_DATEFORMAT, "mmmmm/dd" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "on" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + __SetCentury( "off" ) + OutStd( Set( _SET_DATEFORMAT ), dDate, hb_eol() ) + + RETURN diff --git a/harbour/tests/dates3.prg b/harbour/tests/dates3.prg index 98fec2eb74..43ef30c4f2 100644 --- a/harbour/tests/dates3.prg +++ b/harbour/tests/dates3.prg @@ -6,46 +6,48 @@ #include "set.ch" -function main() +PROCEDURE Main() LOCAL dDate, i - set( _SET_DATEFORMAT, "dd/mm/yyyy" ) - dDate := cToD( "25/05/1999" ) + SET( _SET_DATEFORMAT, "dd/mm/yyyy" ) + dDate := hb_SToD( "19990525" ) - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) OutStd( LastMonday( dDate ), hb_eol() ) dDate += 3 - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) dDate += 4 - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) - set( _SET_DATEFORMAT, "mm/dd/yyyy" ) - dDate := cToD( "05/25/1999" ) + SET( _SET_DATEFORMAT, "mm/dd/yyyy" ) + dDate := hb_SToD( "19990525" ) - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) OutStd( LastMonday( dDate ), hb_eol() ) dDate += 3 - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) dDate += 4 - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) OutStd( hb_eol() ) - dDate := DATE () + dDate := Date () FOR i := 1 TO 7 - OutStd( dDate, dow( dDate ), hb_eol() ) + OutStd( dDate, DOW( dDate ), hb_eol() ) dDate++ NEXT - OutStd( ctod( "" ), dow( ctod( "" ) ), hb_eol() ) + OutStd( CToD( "" ), DOW( CToD( "" ) ), hb_eol() ) - return nil + RETURN // Like NG's sample -function LastMonday( dDate ) - return dDate - dow( dDate ) + 2 + +FUNCTION LastMonday( dDate ) + + RETURN dDate - DOW( dDate ) + 2 diff --git a/harbour/tests/dates4.prg b/harbour/tests/dates4.prg index 71fb0bf362..d918894767 100644 --- a/harbour/tests/dates4.prg +++ b/harbour/tests/dates4.prg @@ -5,20 +5,22 @@ // Testing Harbour dates management. #include "set.ch" -function main() +PROCEDURE Main() + LOCAL i - LOCAL dDate := date() + LOCAL dDate := Date() - set( _SET_DATEFORMAT, "dd/mm/yyyy" ) + SET( _SET_DATEFORMAT, "dd/mm/yyyy" ) - for i := 7 to 49 step 7 + for i := 7 TO 49 STEP 7 CheckDate( dDate ) dDate += i next - return nil + RETURN + +FUNCTION CheckDate( dDate ) -function CheckDate( dDate ) OutStd( "Testing date:", dDate , hb_eol() ) OutStd( "Days in month..:", daysinmonth( dDate ), hb_eol() ) OutStd( "Day of year....:", doy( dDate ), hb_eol() ) @@ -29,6 +31,6 @@ function CheckDate( dDate ) OutStd( "Begin of year..:", boy( dDate ), hb_eol() ) OutStd( "End of year....:", eoy( dDate ), hb_eol() ) __Accept( "Press ENTER to continue..." ) - OutStd( chr( 10 ), chr( 10 ) ) + OutStd( Chr( 10 ), Chr( 10 ) ) - return nil + RETURN nil diff --git a/harbour/tests/ddate.prg b/harbour/tests/ddate.prg index b196abb58b..364073eb80 100644 --- a/harbour/tests/ddate.prg +++ b/harbour/tests/ddate.prg @@ -2,9 +2,10 @@ * $Id$ */ -PROCEDURE MAIN() -LOCAL dDate -LOCAL A +PROCEDURE Main() + + LOCAL dDate + LOCAL A SET DATE FORMAT TO "YYYY.MM.DD" SET CENTURY ON @@ -23,7 +24,7 @@ LOCAL A ? "Should be '4' :", 0d20040229 - 0d20040225 ? "Should be '0' :", 0d20040229 - 0d20040229 - + dDate := 0d20000229 ? "Should be '2000.02.29' :", dDate diff --git a/harbour/tests/debugtst.prg b/harbour/tests/debugtst.prg index b2bdc119d6..d6201b00ee 100644 --- a/harbour/tests/debugtst.prg +++ b/harbour/tests/debugtst.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ /* * $Doc$ @@ -17,10 +17,10 @@ * Placed in the public domain */ -function Main() +PROCEDURE Main() - local oForm := TForm():New() - local nNumber := 15 + LOCAL oForm := TForm():New() + LOCAL nNumber := 15 QOut( oForm:ClassName() ) oForm:Show() @@ -41,79 +41,79 @@ function Main() QOut( "Is unknown METHOD ? ", __objHasMethod( oForm, "Unknown" ) ) QOut( "Set nLeft to 50 and nRight to 100" ) - oForm:Transfer( {"nLeft", 50}, {"nRight", 100} ) + oForm:Transfer( { "nLeft", 50 }, { "nRight", 100 } ) Debug( oForm:Transfer() ) Pause() - QOut( "-DEBUG Functions-") + QOut( "-DEBUG Functions-" ) QOut( "-Statics-" ) - Debug( __dbgvmVarSList() ) + Debug( __dbgVMVarSList() ) QOut( "-Global Stack-" ) - Debug ( __dbgvmStkGList() ) + Debug ( __dbgVMStkGList() ) QOut( "-Local Stack-" ) - Debug ( __dbgvmStkLList() ) + Debug ( __dbgVMStkLList() ) QOut( "-Parameters-" ) - Debug ( __dbgvmParLList() ) + Debug ( __dbgVMParLList() ) Pause() FuncSecond( 241, "Hello" ) -return nil + RETURN +FUNCTION Pause() -function Pause() -return __Accept("") + RETURN __Accept( "" ) +FUNCTION FuncSecond( nParam, cParam, uParam ) -function FuncSecond( nParam, cParam, uParam ) - - local cWhat := "Something" - local nNumber := 2 - local xParam - local xStack + LOCAL cWhat := "Something" + LOCAL nNumber := 2 + LOCAL xParam + LOCAL xStack QOut() - QOut( "-Second procedure-") + QOut( "-Second procedure-" ) QOut() QOut( "-Statics-" ) - Debug ( __dbgvmVarSList() ) + Debug ( __dbgVMVarSList() ) QOut() - QOut( "-Global Stack- Len=", __dbgvmStkGCount() ) - Debug ( __dbgvmStkGList() ) + QOut( "-Global Stack- Len=", __dbgVMStkGCount() ) + Debug ( __dbgVMStkGList() ) QOut() - QOut( "-Local Stack- Len=", __dbgvmStkLCount() ) - xStack := Debug ( __dbgvmStkLList() ) + QOut( "-Local Stack- Len=", __dbgVMStkLCount() ) + xStack := Debug ( __dbgVMStkLList() ) QOut() QOut( "-Parameters-" ) - xParam := Debug( __dbgvmParLList() ) - if xParam[ xStack[ 7 ] ] == "Hello" + xParam := Debug( __dbgVMParLList() ) + IF xParam[ xStack[ 7 ] ] == "Hello" QOut( ":-)" ) - endif + ENDIF Pause() -return nil + RETURN nil /* $Doc$ * $FuncName$ TForm() * $Description$ Returns TForm object * $End$ */ -function TForm() - static oClass +FUNCTION TForm() - if oClass == nil + STATIC oClass + + IF oClass == nil oClass := HBClass():New( "TFORM" ) // starts a new class definition oClass:AddData( "cName" ) // define this class objects datas @@ -129,129 +129,131 @@ function TForm() oClass:AddMethod( "Transfer", @Transfer() ) oClass:Create() // builds this class - endif + ENDIF -return oClass:Instance() // builds an object of this class + RETURN oClass:Instance() // builds an object of this class /* $Doc$ * $FuncName$ TForm:New() * $Description$ Constructor * $End$ */ -static function New() - local Self := QSelf() +STATIC FUNCTION New() + + LOCAL Self := QSelf() ::nTop := 10 ::nLeft := 10 ::nBottom := 20 ::nRight := 40 -return Self + RETURN Self /* $Doc$ * $FuncName$ TForm:Show() * $Description$ Show a form * $End$ */ -static function Show() - local Self := QSelf() +STATIC FUNCTION Show() + + LOCAL Self := QSelf() QOut( "lets show a form from here :-)" ) -return nil + RETURN nil + // + // TForm:Transfer( [] ) + // + // Generic object import and export function + // + // is present. + // + // Maximum number of arguments passed is limited to 10 ! + // + // An argument can be one of the following : + // + // { , } Set DATA to + // { { , }, { , }, ... } + // Set a whole list symbols to value + // Normal way of set objects from external + // sources, like memo files. + // Set self according to the DATA + // contained in + // Can be used to transfer info from + // one class to another + // + // If is not present, the current object will be returned as an array + // for description see __objSetValueList / __objGetValueList. + // + // The method aExcept() is called to determine the DATA which should not + // be returned. Eg. hWnd ( do not copy this DATA from external source ) + // + // Say we want to copy oSource into oTarget we say : + // + // oTarget:Transfer( oSource ) + // + // If we do not want 'cName' duplicated we have to use __objGetValueList : + // + // aNewExcept := aClone( oSource:aExcept() ) + // aAdd( aNewExcept, "cName" ) /* Add cName to exception list */ + // oTarget:Transfer( __objGetValueList( oSource, aNewExcept ) ) + // /* Get DATA from oSource with new exceptions */ + // /* Transfer DATA to oTarget */ + // + // To set two DATA of oTarget : + // + // oTarget:Transfer( { "nLeft", 10 }, { "nRight", 5 } ) + // + // or : + // + // aCollect := {} + // aAdd( aCollect, { "nLeft" , 10 } ) + // aAdd( aCollect, { "nRight", 5 } ) + // oTarget:Transfer( aCollect ) + // + // Copy oSource to a memo field : + // + // DbObject->Memo := oSource:Transfer() + // + // (Re)create oTarget from the memo field : + // + // oTarget := TTarget():New() + // oTarget:Transfer( DbObject->Memo ) + // -// -// TForm:Transfer( [] ) -// -// Generic object import and export function -// -// is present. -// -// Maximum number of arguments passed is limited to 10 ! -// -// An argument can be one of the following : -// -// { , } Set DATA to -// { { , }, { , }, ... } -// Set a whole list symbols to value -// Normal way of set objects from external -// sources, like memo files. -// Set self according to the DATA -// contained in -// Can be used to transfer info from -// one class to another -// -// If is not present, the current object will be returned as an array -// for description see __objSetValueList / __objGetValueList. -// -// The method aExcept() is called to determine the DATA which should not -// be returned. Eg. hWnd ( do not copy this DATA from external source ) -// -// Say we want to copy oSource into oTarget we say : -// -// oTarget:Transfer( oSource ) -// -// If we do not want 'cName' duplicated we have to use __objGetValueList : -// -// aNewExcept := aClone( oSource:aExcept() ) -// aAdd( aNewExcept, "cName" ) /* Add cName to exception list */ -// oTarget:Transfer( __objGetValueList( oSource, aNewExcept ) ) -// /* Get DATA from oSource with new exceptions */ -// /* Transfer DATA to oTarget */ -// -// To set two DATA of oTarget : -// -// oTarget:Transfer( { "nLeft", 10 }, { "nRight", 5 } ) -// -// or : -// -// aCollect := {} -// aAdd( aCollect, { "nLeft" , 10 } ) -// aAdd( aCollect, { "nRight", 5 } ) -// oTarget:Transfer( aCollect ) -// -// Copy oSource to a memo field : -// -// DbObject->Memo := oSource:Transfer() -// -// (Re)create oTarget from the memo field : -// -// oTarget := TTarget():New() -// oTarget:Transfer( DbObject->Memo ) -// -static function Transfer( x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 /* etc */ ) +STATIC FUNCTION Transfer( x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 ) /* etc */ - local self := QSelf() - local aParam := __dbgvmParLList() - local nLen := PCount() - local xRet - local xData - local n + LOCAL self := QSelf() + LOCAL aParam := __dbgVMParLList() + LOCAL nLen := PCount() + LOCAL xRet + LOCAL xData + LOCAL n - if nLen == 0 - xRet := __objGetValueList( self, ::aExcept() ) - else - for n := 1 to nLen + IF nLen == 0 + xRet := __objGetValueLIST( self, ::aExcept() ) + ELSE + for n := 1 TO nLen xData := aParam[ n ] - if ValType( xData ) == "A" + IF ValType( xData ) == "A" - if ValType( xData[1] ) == "A" // 2D array passed + IF ValType( xData[1] ) == "A" // 2D array passed xRet := __objSetValueList( self, xData ) - else // 1D array passed - xRet := __objSetValueList( self, {xData} ) - endif + ELSE // 1D array passed + xRet := __objSetValueList( self, { xData } ) + ENDIF - elseif ValType( xData ) == "O" // Object passed + ELSEIF ValType( xData ) == "O" // Object passed xRet := ::Transfer( xData:Transfer() ) - elseif ValType( xData ) != "U" + ELSEIF ValType( xData ) != "U" QOut( "TRANSFER: Incorrect argument(", n, ") ", xData ) - endif + ENDIF next n - endif + ENDIF -return xRet + RETURN xRet diff --git a/harbour/tests/delimtst.prg b/harbour/tests/delimtst.prg index 84f2282a42..5250380861 100644 --- a/harbour/tests/delimtst.prg +++ b/harbour/tests/delimtst.prg @@ -1,50 +1,53 @@ //NOTEST -// $Id$ -// +/* + * $Id$ + */ -// Test program for COPY TO DELIMITED and APPEND FROM DELIMITED -// Note: Only COPY TO DELIMITED is fully implemented at this time... + // Test program for COPY TO DELIMITED and APPEND FROM DELIMITED + // Note: Only COPY TO DELIMITED is fully implemented at this time... /* Harbour Project source code http://harbour-project.org/ Donated to the public domain on 2001-04-18 by David G. Holm */ -procedure main() - local nCount := 0 - use test new +PROCEDURE Main() + + LOCAL nCount := 0 + + USE test NEW // Copy all records and fields. - copy to test1 delimited + COPY TO test1 DELIMITED // Copy only address fields for records with salary over 50,000. - copy field first,last,street,city,state,zip to test2 delimited for _field->salary>50000 + COPY FIELD first, last, street, city, state, zip TO test2 delimited for _field->salary > 50000 // Only copy record 3. - copy record 3 to test3 delimited + COPY RECORD 3 TO test3 DELIMITED // Copy records 4 through 7. - copy next 4 to test4 delimited + COPY NEXT 4 TO test4 DELIMITED // Try to copy 10 records, starting 5 records from EOF, using WHILE - go bottom + GO BOTTOM skip -4 - copy while ncount++ < 9 to test4a delimited + COPY WHILE ncount++ < 9 TO test4a DELIMITED // Copy the last 10 records. - go bottom + GO BOTTOM skip -9 - copy rest to test5 delimited + COPY REST TO test5 DELIMITED // Copy the last 10 records again. - go bottom + GO BOTTOM skip -9 - copy to test6 delimited while !eof() + COPY TO test6 delimited WHILE ! EOF() // Copy only some of the last 10 records. - go bottom + GO BOTTOM skip -9 - copy rest to test7 delimited for _field->married + COPY REST TO test7 DELIMITED FOR _field->married // Try to append from a file that we know does not exist. - delete file test8.txt - append from test8 delimited -quit \ No newline at end of file + DELETE file test8.txt + APPEND FROM test8 delimited + QUIT diff --git a/harbour/tests/devtest.prg b/harbour/tests/devtest.prg index 8722996502..1b7d5e847b 100644 --- a/harbour/tests/devtest.prg +++ b/harbour/tests/devtest.prg @@ -11,35 +11,37 @@ Public domain program written by David G. Holm */ -procedure main() +PROCEDURE Main() + #ifdef __HARBOUR__ + SET PRINTER TO devtesth #else SET PRINTER TO devtestc #endif SET DEVICE TO PRINTER - DevPos( -2, 76 ) - ? Prow(), Pcol() + DevPos( - 2, 76 ) + ? PRow(), PCol() DevOut( "First text written!" ) - ? Prow(), Pcol() + ? PRow(), PCol() DevOut( "Hello" ) - ? Prow(), Pcol() + ? PRow(), PCol() DevPos( 6, 74 ) - ? Prow(), Pcol() + ? PRow(), PCol() DevOut( "Off to the side!!" ) - ? Prow(), Pcol() - DevPos( 8, -12 ) - ? Prow(), Pcol() - DevPos( 13, -12 ) - ? Prow(), Pcol() + ? PRow(), PCol() + DevPos( 8, - 12 ) + ? PRow(), PCol() + DevPos( 13, - 12 ) + ? PRow(), PCol() DevOut( "More test text!" ) - ? Prow(), Pcol() + ? PRow(), PCol() DevOut( "Yet more text!" ) - ? Prow(), Pcol() + ? PRow(), PCol() DevPos( 19, 85 ) - ? Prow(), Pcol() + ? PRow(), PCol() DevPos( 500, 20 ) - ? Prow(), Pcol() + ? PRow(), PCol() DevOut( "!" ) - ? Prow(), Pcol() -quit \ No newline at end of file + ? PRow(), PCol() + QUIT diff --git a/harbour/tests/disptest.prg b/harbour/tests/disptest.prg index abb5d3ff08..1d2a2a0dcd 100644 --- a/harbour/tests/disptest.prg +++ b/harbour/tests/disptest.prg @@ -11,54 +11,57 @@ http://harbour-project.org/ Public domain program written by David G. Holm */ -procedure main() -local a,b,c,d,e,f,g,h,i,j,k,l - SetPos( -2, 76 ) + +PROCEDURE Main() + + LOCAL a, b, c, d, e, f, g, h, i, j, k, l + + SetPos( - 2, 76 ) DispOut( "You won't see this!" ) - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) a := Row() b := Col() ?? a, b - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) c := Row() d := Col() ?? c, d - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) e := Row() f := Row() ?? e, f - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) g := Row() h := Col() ?? g, h - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) i := Row() j := Col() ?? i, j - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) k := Row() l := Col() ?? k, l - tone(440,1) - inkey(0) + Tone( 440, 1 ) + Inkey( 0 ) CLS - ?? a,b - ?? c,d - ?? e,f - ?? g,h - ?? i,j - ?? k,l + ?? a, b + ?? c, d + ?? e, f + ?? g, h + ?? i, j + ?? k, l DispOut( "Hello" ) SetPos( 6, 74 ) DispOut( "Partly off screen!" ) ? Row(), Col() - SetPos( 8, -12 ) + SetPos( 8, - 12 ) a := Row() b := Col() ?? "PA" @@ -67,10 +70,10 @@ local a,b,c,d,e,f,g,h,i,j,k,l ?? "ll on screen!" e := Row() f := Row() - ? a,b - ? c,d - ? e,f - SetPos( 13, -12 ) + ? a, b + ? c, d + ? e, f + SetPos( 13, - 12 ) a := Row() b := Col() DispOut( "All off screen!" ) @@ -79,13 +82,13 @@ local a,b,c,d,e,f,g,h,i,j,k,l DispOut( "All on screen!" ) e := Row() f := Row() - ? a,b - ? c,d - ? e,f + ? a, b + ? c, d + ? e, f SetPos( 19, 85 ) ?? "All on screen??" - tone(880,1) - inkey(0) + Tone( 880, 1 ) + Inkey( 0 ) SetPos( 50, 20 ) ?? "On screen??" -quit \ No newline at end of file + QUIT diff --git a/harbour/tests/foreach.prg b/harbour/tests/foreach.prg index a1ad316a52..394acbb5db 100644 --- a/harbour/tests/foreach.prg +++ b/harbour/tests/foreach.prg @@ -1,99 +1,101 @@ /* * $Id$ */ - -PROCEDURE MAIN() -LOCAL A:={ "one ", "two ", "three" } -LOCAL AA:={ "AA-one ", "AA-two ", "AA-three", "AA-four " } -LOCAL c:="abcdefghij" -LOCAL enum:="b" -LOCAL bb, cc -LOCAL i + +PROCEDURE Main() + + LOCAL A := { "one ", "two ", "three" } + LOCAL AA := { "AA-one ", "AA-two ", "AA-three", "AA-four " } + LOCAL c := "abcdefghij" + LOCAL enum := "b" + LOCAL bb, cc + LOCAL i /* test(@a,b) test(a,@b) test(@a,@b) */ + ? "========================================================" - ? "before loop: ENUM=",ENUM - ? 'before loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "before loop: ENUM=", ENUM + ? "before loop: a[1]=", a[1], "a[2]=", a[2], "a[3]=", a[3] FOR EACH enum IN A ? "start: ENUM=", ENUM - IF ENUM = 'two' - ENUM := UPPER( ENUM ) + IF ENUM = "two" + ENUM := Upper( ENUM ) ENDIF - ? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + ? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase ) NEXT ? "after loop ENUM=", ENUM - ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "after loop: a[1]=", a[1], "a[2]=", a[2], "a[3]=", a[3] ? "-----------------" ? - inkey(0) + Inkey( 0 ) + - ? "========================================================" ? "Testing passing by reference" - ? "before loop: ENUM=",ENUM - ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "before loop: ENUM=", ENUM + ? "after loop: a[1]=", a[1], "a[2]=", a[2], "a[3]=", a[3] FOR EACH ENUM IN A - IF UPPER(ENUM) = 'TWO' - ENUM := UPPER( ENUM ) - ? "before passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + IF Upper( ENUM ) = "TWO" + ENUM := Upper( ENUM ) + ? "before passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase ) testBYREF( @ENUM ) - ? " after passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + ? " after passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase ) ENDIF NEXT ? "after loop ENUM=", ENUM - ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] - inkey(0) + ? "after loop: a[1]=", a[1], "a[2]=", a[2], "a[3]=", a[3] + Inkey( 0 ) ? "========================================================" ? "Testing BREAK" - ? "before loop: ENUM=",ENUM - ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "before loop: ENUM=", ENUM + ? "after loop: a[1]=", a[1], "a[2]=", a[2], "a[3]=", a[3] BEGIN SEQUENCE FOR EACH enum IN A DESCEND - ? "loop: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + ? "loop: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase ) TESTbreak( ENUM ) NEXT - + RECOVER USING i ? "after loop ENUM=", ENUM - ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "after loop: a[1]=", a[1], "a[2]=", a[2], "a[3]=", a[3] ? "recover variable i=", i END SEQUENCE - inkey(0) + Inkey( 0 ) ? "========================================================" - ? "before loop: ENUM=",ENUM - ? 'before loop: c=',c + ? "before loop: ENUM=", ENUM + ? "before loop: c=", c BEGIN SEQUENCE FOR EACH enum IN c ? "start: ENUM=", ENUM - IF enum = 'd' - enum := UPPER( enum ) + IF enum = "d" + enum := Upper( enum ) ENDIF Testbreak( enum ) - ? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + ? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", ValType( ENUM:__enumBase ) NEXT RECOVER USING i ? "after loop ENUM=", ENUM - ? 'after loop: c=', c + ? "after loop: c=", c ? "recover variable i=", i END SEQUENCE - + ? "========================================================" - FOR EACH enum,bb,cc IN A,AA,c + FOR EACH enum, bb, cc IN A, AA, c ? enum, enum:__enumIndex, enum:__enumValue ? bb, bb:__enumIndex, bb:__enumValue ? cc, cc:__enumIndex, cc:__enumValue NEXT - inkey(0) - + Inkey( 0 ) + ? "========================================================" - FOR EACH enum,bb,cc IN A,AA,c DESCEND + FOR EACH enum, bb, cc IN A, AA, c DESCEND ? enum, enum:__enumIndex, enum:__enumValue ? bb, bb:__enumIndex, bb:__enumValue ? cc, cc:__enumIndex, cc:__enumValue @@ -101,41 +103,42 @@ LOCAL i FOR EACH enum IN a BEGIN SEQUENCE - IF enum = '2' - BREAK - ENDIF + IF enum = "2" + BREAK + ENDIF END SEQUENCE NEXT FOR EACH enum IN a BEGIN SEQUENCE - IF enum = '2' - ? "Breaking... enum=", enum - BREAK enum - ENDIF + IF enum = "2" + ? "Breaking... enum=", enum + BREAK enum + ENDIF RECOVER USING enum ? "after recovery: enum=", enum END SEQUENCE NEXT - -RETURN + RETURN PROCEDURE TESTbreak( v ) - IF v = '2' .or. v = 'd' + + IF v = "2" .OR. v = "d" ? "issuing break" - BREAK( v ) + Break( v ) ENDIF - -RETURN + + RETURN PROCEDURE TESTBYREF( enum ) + ? "start of testBYREF ENUM=", ENUM - FOR EACH ENUM IN {1,2,3} + FOR EACH ENUM IN { 1, 2, 3 } ? " -testBYREF=", ENUM NEXT ? "end of loop: ENUM=", ENUM ENUM := "22222" ? "end of testBYREF ENUM=", ENUM -RETURN + RETURN diff --git a/harbour/tests/gtstdtst.prg b/harbour/tests/gtstdtst.prg index 4ca044b7b2..77fe370e70 100644 --- a/harbour/tests/gtstdtst.prg +++ b/harbour/tests/gtstdtst.prg @@ -1,59 +1,63 @@ -// -// $Id$ -// +/* + * $Id$ + */ /* gtstd test */ -func Main() - local n +PROCEDURE Main() - PosNow() - ?? "Output test. First line, no newlines." + LOCAL n - ? "Press a key to continue: " - ?? inkey(0) + PosNow() + ?? "Output test. First line, no newlines." - ? "This is row " + alltrim(str(row())) - - @ 7, 30 say "@ 7,30" - @ 7, 10 say "@ 7,10" - @ 7, 60 say "@ 7,60" - @ 7, 75 say "9876543210" - @ 6, 10 say "@ 6,10.." - PosNow() + ? "Press a key to continue: " + ?? Inkey( 0 ) - ? - ? "Scroll test: pre = " - PosNow() - // scroll(0,0,maxrow(),maxcol(),-3,0) - ?? " post = " - PosNow() + ? "This is row " + AllTrim( Str( Row() ) ) - ? - ? "Press key to test CLS" - inkey(0) - CLS + @ 7, 30 SAY "@ 7,30" + @ 7, 10 SAY "@ 7,10" + @ 7, 60 SAY "@ 7,60" + @ 7, 75 SAY "9876543210" + @ 6, 10 SAY "@ 6,10.." + PosNow() - PosNow() + ? + ? "Scroll test: pre = " + PosNow() +// Scroll( 0, 0, MaxRow(), MaxCol(), -3, 0 ) + ?? " post = " + PosNow() - ? - ? "Press key to test for n := 100 to 120 ; tone(n, 1) ; next" - inkey(0) - for n := 100 to 120 ; tone(n, 1) ; next + ? + ? "Press key to test CLS" + Inkey( 0 ) + CLS - ? "Done.." - ? "Testing long string via QOUT. 50 characters follow here: 98765432109876543210987654321098765432109876543210" - ? "Done.. testing end of screen scroll" + PosNow() - for n := 1 to 25 - ? "This line is on row " - ?? alltrim(str(row())) - inkey(0) - next + ? + ? "Press key to test for n := 100 to 120 ; tone(n, 1) ; next" + Inkey( 0 ) + FOR n := 100 TO 120 + Tone( n, 1 ) + NEXT - return NIL + ? "Done.." + ? "Testing long string via QOUT. 50 characters follow here: 98765432109876543210987654321098765432109876543210" + ? "Done.. testing end of screen scroll" -func PosNow() - ?? "[" + alltrim(str(row())) + "," + alltrim(str(col())) + "]" - return NIL + FOR n := 1 TO 25 + ? "This line is on row " + ?? AllTrim( Str( Row() ) ) + Inkey( 0 ) + NEXT + RETURN + +FUNCTION PosNow() + + ?? "[" + AllTrim( Str( Row() ) ) + "," + AllTrim( Str( Col() ) ) + "]" + + RETURN NIL diff --git a/harbour/tests/ipclnt.prg b/harbour/tests/ipclnt.prg index bf4b74633f..b474ddcc87 100644 --- a/harbour/tests/ipclnt.prg +++ b/harbour/tests/ipclnt.prg @@ -10,7 +10,7 @@ #define PORT 10000 #define EOT ( Chr( 4 ) ) -PROCEDURE main() +PROCEDURE Main() LOCAL hSocket diff --git a/harbour/tests/ipsvr.prg b/harbour/tests/ipsvr.prg index 45c5716df6..8764257c96 100644 --- a/harbour/tests/ipsvr.prg +++ b/harbour/tests/ipsvr.prg @@ -13,7 +13,7 @@ REQUEST HB_MT -PROCEDURE main() +PROCEDURE Main() LOCAL hListen LOCAL hSocket diff --git a/harbour/tests/langapi.prg b/harbour/tests/langapi.prg index 988daa9903..9673dbb0b1 100644 --- a/harbour/tests/langapi.prg +++ b/harbour/tests/langapi.prg @@ -8,35 +8,34 @@ REQUEST HB_LANG_HU852 REQUEST HB_LANG_KO -func main() +PROCEDURE Main() -? "Prev:", hb_langselect() -? hb_langName() -? NationMsg( 1 ) -? CMonth( Date() ) -? CDOW( Date() ) -? "---------" + ? "Prev:", hb_langSelect() + ? hb_langName() + ? NationMsg( 1 ) + ? CMonth( Date() ) + ? CDOW( Date() ) + ? "---------" -? "Prev:", hb_langSelect( "HU852" ) -? hb_langName() -? NationMsg( 1 ) -? CMonth( Date() ) -? CDOW( Date() ) -? "---------" + ? "Prev:", hb_langSelect( "HU852" ) + ? hb_langName() + ? NationMsg( 1 ) + ? CMonth( Date() ) + ? CDOW( Date() ) + ? "---------" -? "Prev:", hb_langSelect( "NOTHERE" ) -? hb_langName() -? NationMsg( 1 ) -? CMonth( Date() ) -? CDOW( Date() ) -? "---------" + ? "Prev:", hb_langSelect( "NOTHERE" ) + ? hb_langName() + ? NationMsg( 1 ) + ? CMonth( Date() ) + ? CDOW( Date() ) + ? "---------" -? "Prev:", hb_langSelect( "KO" ) -? hb_langName() -? NationMsg( 1 ) -? CMonth( Date() ) -? CDOW( Date() ) -? "---------" - -return nil + ? "Prev:", hb_langSelect( "KO" ) + ? hb_langName() + ? NationMsg( 1 ) + ? CMonth( Date() ) + ? CDOW( Date() ) + ? "---------" + RETURN diff --git a/harbour/tests/memtst.prg b/harbour/tests/memtst.prg index 2e36ecae4f..8461c181e0 100644 --- a/harbour/tests/memtst.prg +++ b/harbour/tests/memtst.prg @@ -15,7 +15,7 @@ #include "hbmemory.ch" #endif -proc main() +PROCEDURE Main() local nCPUSec, nRealSec, i, a #ifdef __HARBOUR__ diff --git a/harbour/tests/memvar.prg b/harbour/tests/memvar.prg index e61741daf0..69bbb16d57 100644 --- a/harbour/tests/memvar.prg +++ b/harbour/tests/memvar.prg @@ -1,9 +1,10 @@ -// Basic test for memvars handling -// -// $Id$ -// +/* + * $Id$ + */ -MEMVAR memvar +// Basic test for memvars handling + +MEMVAR MEMVAR MEMVAR memvar1 MEMVAR memvar2 MEMVAR memvar3 @@ -28,319 +29,349 @@ MEMVAR param1 MEMVAR param2 MEMVAR initmem -PROCEDURE MAIN() -LOCAL main:=0 +PROCEDURE Main() - Test1() - __accept( "press Enter..." ) - Test2() - __accept( "press Enter..." ) - Test3() - __accept( "press Enter..." ) - Test4() - __accept( "press Enter..." ) - Test5() - __accept( "press Enter..." ) - Test6() - __accept( "press Enter..." ) - Test7( 'value1', 2, .T. ) - __accept( "press Enter..." ) - Test8() - __accept( "press Enter..." ) - Test9() + LOCAL main := 0 -RETURN + Test1() + __Accept( "press Enter..." ) + Test2() + __Accept( "press Enter..." ) + Test3() + __Accept( "press Enter..." ) + Test4() + __Accept( "press Enter..." ) + Test5() + __Accept( "press Enter..." ) + Test6() + __Accept( "press Enter..." ) + Test7( 'value1', 2, .T. ) + __Accept( "press Enter..." ) + Test8() + __Accept( "press Enter..." ) + Test9() -///////////////////////////////////////////////////////////////////////// + RETURN + + ///////////////////////////////////////////////////////////////////////// PROCEDURE Test1() -// PUBLIC overrided by PRIVATE overrided by uninitialized PUBLIC -PUBL memvar1 - Qout( "==Test 1==PUBLIC -> PRIVATE -> PUBLIC" ) - Qout( memvar1 ) - memvar1 ='main' - Qout( 'in MAIN=', memvar1 ) - Scope( memvar1 ) - Qout( 'back in MAIN=', memvar1 ) - Qout( "" ) + // PUBLIC overrided by PRIVATE overrided by uninitialized PUBLIC + PUBL memvar1 -RETURN + QOut( "==Test 1==PUBLIC -> PRIVATE -> PUBLIC" ) + QOut( memvar1 ) + memvar1 = 'main' + QOut( 'in MAIN=', memvar1 ) + Scope( memvar1 ) + QOut( 'back in MAIN=', memvar1 ) + QOut( "" ) + + RETURN FUNCTION Scope( value ) -PRIVA memvar1:='scope' - Scope2() - Qout( "in SCOPE=", memvar1 ) + PRIVA memvar1 := 'scope' -RETURN( value ) + Scope2() + QOut( "in SCOPE=", memvar1 ) + + RETURN( value ) PROCEDURE Scope2() -PUBLIC memvar1 - Qout( "in SCOPE2=", memvar1 ) -RETURN -/////////////////////////////////////////////////////////////////// + PUBLIC memvar1 + + QOut( "in SCOPE2=", memvar1 ) + + RETURN + + /////////////////////////////////////////////////////////////////// PROCEDURE Test2() -// PUBLIC overrided by PUBLIC overrided by uninitialized PUBLIC -PUBLIC memvar2 - Qout( "==Test 2==PUBLIC -> PUBLIC -> PUBLIC" ) - Qout( memvar2 ) - memvar2 ='main' - Qout( 'in MAIN=', memvar2 ) - Scope3( memvar2 ) - Qout( 'back in MAIN=', memvar2 ) - Qout( "" ) + // PUBLIC overrided by PUBLIC overrided by uninitialized PUBLIC + PUBLIC memvar2 -RETURN + QOut( "==Test 2==PUBLIC -> PUBLIC -> PUBLIC" ) + QOut( memvar2 ) + memvar2 = 'main' + QOut( 'in MAIN=', memvar2 ) + Scope3( memvar2 ) + QOut( 'back in MAIN=', memvar2 ) + QOut( "" ) + + RETURN FUNCTION Scope3( value ) -PUBLIC memvar2:='scope' - Scope4() - Qout( "in SCOPE=", memvar2 ) + PUBLIC memvar2 := 'scope' -RETURN( value ) + Scope4() + QOut( "in SCOPE=", memvar2 ) + + RETURN( value ) PROCEDURE Scope4() -PUBLIC memvar2 - Qout( "in SCOPE2=", memvar2 ) -RETURN -//////////////////////////////////////////////////////////////////////////// + PUBLIC memvar2 + + QOut( "in SCOPE2=", memvar2 ) + + RETURN + + //////////////////////////////////////////////////////////////////////////// PROCEDURE Test3() -// PUBLIC overrided by PRIVATE overrided by initialized PUBLIC -PUBLIC memvar3 - Qout( "==Test 3==PUBLIC -> PRIVATE -> PUBLIC:=" ) - Qout( memvar3 ) - memvar3 ='main' - Qout( 'in MAIN=', memvar3 ) - Scope5( memvar3 ) - Qout( 'back in MAIN=', memvar3 ) - Qout( "" ) + // PUBLIC overrided by PRIVATE overrided by initialized PUBLIC + PUBLIC memvar3 -RETURN + QOut( "==Test 3==PUBLIC -> PRIVATE -> PUBLIC:=" ) + QOut( memvar3 ) + memvar3 = 'main' + QOut( 'in MAIN=', memvar3 ) + Scope5( memvar3 ) + QOut( 'back in MAIN=', memvar3 ) + QOut( "" ) + + RETURN FUNCTION Scope5( value ) -PRIVATE memvar3:='scope' - Scope6() - Qout( "in SCOPE=", memvar3 ) + PRIVATE memvar3 := 'scope' -RETURN( value ) + Scope6() + QOut( "in SCOPE=", memvar3 ) + + RETURN( value ) PROCEDURE Scope6() -PUBLIC memvar3:='scope2' - Qout( "in SCOPE2=", memvar3 ) -RETURN -/////////////////////////////////////////////////////////////////////// + PUBLIC memvar3 := 'scope2' + + QOut( "in SCOPE2=", memvar3 ) + + RETURN + + /////////////////////////////////////////////////////////////////////// PROCEDURE Test4() -// PUBLIC overrided by PUBLIC overrided by initialized PUBLIC -PUBLIC memvar4 - Qout( "==Test 4==PUBLIC -> PUBLIC -> PUBLIC:=" ) - Qout( memvar4 ) - memvar4 ='main' - Qout( 'in MAIN=', memvar4 ) - Scope7( memvar4 ) - Qout( 'back in MAIN=', memvar4 ) - Qout( "" ) + // PUBLIC overrided by PUBLIC overrided by initialized PUBLIC + PUBLIC memvar4 -RETURN + QOut( "==Test 4==PUBLIC -> PUBLIC -> PUBLIC:=" ) + QOut( memvar4 ) + memvar4 = 'main' + QOut( 'in MAIN=', memvar4 ) + Scope7( memvar4 ) + QOut( 'back in MAIN=', memvar4 ) + QOut( "" ) + + RETURN FUNCTION Scope7( value ) -PUBLIC memvar4:='scope' - Scope8() - Qout( "in SCOPE=", memvar4 ) + PUBLIC memvar4 := 'scope' -RETURN( value ) + Scope8() + QOut( "in SCOPE=", memvar4 ) + + RETURN( value ) PROCEDURE Scope8() -PUBLIC memvar4:='scope2' - Qout( "in SCOPE2=", memvar4 ) -RETURN -/////////////////////////////////////////////////////////////////////// + PUBLIC memvar4 := 'scope2' + + QOut( "in SCOPE2=", memvar4 ) + + RETURN + + /////////////////////////////////////////////////////////////////////// PROCEDURE TEST5() -PUBLIC mempublic, public3:=3 -//PUBLIC public2[ 10 ] //unsupported yet -PRIVATE memprivate -PARAMETERS memparam - Qout( "==Test for memvars passed by reference and __PUBLIC/__PRIVATE " ) - Qout( " uninitialized PUBLIC= ", mempublic ) -// Qout( "uninitialized PUBLIC array (first item)=", public2[1] ) - Qout( "initialized PUBLIC= ", public3 ) - Qout( " uninitialized PRIVATE= ", memprivate ) - Qout( "uninitialized PARAMETER= ", memparam ) -// Qout( memnone ) + PUBLIC mempublic, public3 := 3 - mempublic ='PUBLIC' - Qout( " PUBLIC with new value= ", mempublic ) - memprivate ='PRIVATE' - Qout( " PRIVATE with new value= ", memprivate ) - memparam ='PARAMETER' - Qout( "PARAMETER with new value= ", memparam ) -// memnone =4 -// Qout( memnone ) +// PUBLIC public2[ 10 ] //unsupported yet + PRIVATE memprivate + PARAMETERS memparam - Qout( " PUBLIC after passing by reference= ", UseVar( @mempublic ) ) - Qout( " PRIVATE after passing by reference= ", UseVar( @memprivate ) ) - Qout( "PARAMETER after passing by reference= ", UseVar( @memparam ) ) -// Qout( Use( @memnone ) ) + QOut( "==Test for memvars passed by reference and __PUBLIC/__PRIVATE " ) + QOut( " uninitialized PUBLIC= ", mempublic ) + // QOut( "uninitialized PUBLIC array (first item)=", public2[1] ) + QOut( "initialized PUBLIC= ", public3 ) + QOut( " uninitialized PRIVATE= ", memprivate ) + QOut( "uninitialized PARAMETER= ", memparam ) + // QOut( memnone ) + + mempublic = 'PUBLIC' + QOut( " PUBLIC with new value= ", mempublic ) + memprivate = 'PRIVATE' + QOut( " PRIVATE with new value= ", memprivate ) + memparam = 'PARAMETER' + QOut( "PARAMETER with new value= ", memparam ) + // memnone =4 + // Qout( memnone ) + + QOut( " PUBLIC after passing by reference= ", UseVar( @mempublic ) ) + QOut( " PRIVATE after passing by reference= ", UseVar( @memprivate ) ) + QOut( "PARAMETER after passing by reference= ", UseVar( @memparam ) ) + // Qout( Use( @memnone ) ) #ifdef __HARBOUR__ - Qout( "PUBLIC created by __PUBLIC function=", public1 ) + QOut( "PUBLIC created by __PUBLIC function=", public1 ) #endif - Qout( "" ) - -RETURN + QOut( "" ) + RETURN FUNCTION UseVar( value ) - UseRef( @value ) + UseRef( @value ) #ifdef __HARBOUR__ - __mvPUBLIC( "public1" ) //, "public21" ) -// __mvPRIVATE( "private1", "private2", "private3" ) - __mvPRIVATE( {"private1", "private2", "private3"} ) - Qout( "undeclared PUBLIC created by __PUBLIC function=", public1 ) - Qout( "undeclared PRIVATE created by __PRIVATE function=", private1 ) - Qout( "undeclared PRIVATE created by __PRIVATE function=", private2 ) - Qout( "undeclared PRIVATE created by __PRIVATE function=", private3 ) + __mvPublic( "public1" ) //, "public21" ) + // __mvPRIVATE( "private1", "private2", "private3" ) + __mvPrivate( { "private1", "private2", "private3" } ) + QOut( "undeclared PUBLIC created by __PUBLIC function=", public1 ) + QOut( "undeclared PRIVATE created by __PRIVATE function=", private1 ) + QOut( "undeclared PRIVATE created by __PRIVATE function=", private2 ) + QOut( "undeclared PRIVATE created by __PRIVATE function=", private3 ) - public1 :='public created by __PUBLIC' + public1 := 'public created by __PUBLIC' #endif - Qout( "" ) + QOut( "" ) -RETURN( value ) + RETURN( value ) PROCEDURE UseRef( reference ) - reference +=' variable' + reference += ' variable' -RETURN + RETURN -////////////////////////////////////////////////////////////////////// + ////////////////////////////////////////////////////////////////////// PROCEDURE Test6() -PUBLIC publCB -PRIVATE privVar:=' (PRIVATE in MAIN) ' - Qout( "== Test for detached PRIVATE variables" ) - DetachMemvar( 'detached memvar' ) - Qout( EVAL( publCB, 'in Main: ' ) ) + PUBLIC publCB + PRIVATE privVar := ' (PRIVATE in MAIN) ' -RETURN + QOut( "== Test for detached PRIVATE variables" ) + DetachMemvar( 'detached memvar' ) + QOut( Eval( publCB, 'in Main: ' ) ) + + RETURN PROCEDURE DetachMemvar( cValue ) -PRIVATE privVar:=' (PRIVATE in DetachMemvar) ' - publCB ={|x| x+privVar+cValue} - Qout( EVAL( publCB, "in DetachMemvar: " ) ) + PRIVATE privVar := ' (PRIVATE in DetachMemvar) ' -RETURN + publCB = {| x | x + privVar + cValue } + QOut( Eval( publCB, "in DetachMemvar: " ) ) -//////////////////////////////////////////////////////////////////////// + RETURN + + //////////////////////////////////////////////////////////////////////// PROCEDURE Test7( ) -PARAMETERS para1, para2, para3 -PARAM parameter1again - Qout( "Parameter 1 =", para1 ) - Qout( "Parameter 2 =", para2 ) - Qout( "Parameter 3 =", para3 ) - Qout( "Parameter 4 =", parameter1again ) + PARAMETERS para1, para2, para3 + PARAM parameter1again -RETURN + QOut( "Parameter 1 =", para1 ) + QOut( "Parameter 2 =", para2 ) + QOut( "Parameter 3 =", para3 ) + QOut( "Parameter 4 =", parameter1again ) -///////////////////////////////////////////////////////////////////////// + RETURN + + ///////////////////////////////////////////////////////////////////////// PROCEDURE Test8() -PRIVATE private1:='PRIVATE1' - Qout( 'In Test8 before UsePriv' ) - Qout( "Private1 = ", private1 ) - UsePriv( private1 ) - Qout( 'In Test8 after UsePriv' ) - Qout( "Private1 = ", private1 ) + PRIVATE private1 := 'PRIVATE1' - __accept( "press Enter..." ) + QOut( 'In Test8 before UsePriv' ) + QOut( "Private1 = ", private1 ) + UsePriv( private1 ) + QOut( 'In Test8 after UsePriv' ) + QOut( "Private1 = ", private1 ) - Qout( 'In Test8 before UsePriv with reference' ) - Qout( "Private1 = ", private1 ) - UsePriv( @private1 ) - Qout( 'In Test8 after UsePriv with reference' ) - Qout( "Private1 = ", private1 ) + __Accept( "press Enter..." ) + QOut( 'In Test8 before UsePriv with reference' ) + QOut( "Private1 = ", private1 ) + UsePriv( @private1 ) + QOut( 'In Test8 after UsePriv with reference' ) + QOut( "Private1 = ", private1 ) -RETURN + RETURN PROCEDURE UsePriv() -PARAMETERS param1 - Qout( 'In UsePriv before UseParam' ) - Qout( "Private1 = ", private1 ) - Qout( "Param1 = ", param1 ) - UseParam() - Qout( 'In UsePriv after UseParam' ) - Qout( "Private1 = ", private1 ) - Qout( "Param1 = ", param1 ) + PARAMETERS param1 -RETURN + QOut( 'In UsePriv before UseParam' ) + QOut( "Private1 = ", private1 ) + QOut( "Param1 = ", param1 ) + UseParam() + QOut( 'In UsePriv after UseParam' ) + QOut( "Private1 = ", private1 ) + QOut( "Param1 = ", param1 ) + + RETURN PROCEDURE UseParam() -PARAMETER param2 - Qout( 'In UseParam before assignment' ) - Qout( "Private1 = ", private1 ) - Qout( "Param1 = ", param1 ) - Qout( "Param2 = ", param2 ) - param2 :='PARAM2' - param1 :="new value" - Qout( 'In UseParam after assignment' ) - Qout( "Private1 = ", private1 ) - Qout( "Param1 = ", param1 ) - Qout( "Param2 = ", param2 ) + PARAMETER param2 -RETURN + QOut( 'In UseParam before assignment' ) + QOut( "Private1 = ", private1 ) + QOut( "Param1 = ", param1 ) + QOut( "Param2 = ", param2 ) + param2 := 'PARAM2' + param1 := "new value" + QOut( 'In UseParam after assignment' ) + QOut( "Private1 = ", private1 ) + QOut( "Param1 = ", param1 ) + QOut( "Param2 = ", param2 ) -////////////////////////////////////////////////////////////////////// + RETURN + + ////////////////////////////////////////////////////////////////////// PROCEDURE TEST9() -PUBLIC memvar -PUBLIC memfunc - memvar :=19 - Qout( "Variable with the name of module (memvar)=", memvar ) + PUBLIC MEMVAR + PUBLIC memfunc - memfunc := 33 - Qout( "Variable with the name of function =", memfunc ) - Qout( "Return value from a function=", memfunc( 9 ) ) + memvar := 19 -// mem() + QOut( "Variable with the name of module (memvar)=", memvar ) -RETURN + memfunc := 33 + QOut( "Variable with the name of function =", memfunc ) + QOut( "Return value from a function=", memfunc( 9 ) ) + + // mem() + + RETURN STATIC FUNCTION memfunc( memfunc ) -RETURN memfunc * memfunc + RETURN memfunc * memfunc -INIT PROCEDURE initmem() -PARA memvar -PARA initmem - Qout( "Tests for PARAMETERS, PRIVATE nad PUBLIC variables" ) - Qout( "" ) - Qout( 'in INIT function - Passed parameter = ', memvar ) - Qout( 'in INIT function - Passed parameter with different name = ', initmem ) - Qout( "" ) -RETURN + INIT PROCEDURE initmem() + PARA MEMVAR + PARA initmem + QOut( "Tests for PARAMETERS, PRIVATE nad PUBLIC variables" ) + QOut( "" ) + QOut( 'in INIT function - Passed parameter = ', memvar ) + QOut( 'in INIT function - Passed parameter with different name = ', initmem ) + QOut( "" ) + + RETURN diff --git a/harbour/tests/menutest.prg b/harbour/tests/menutest.prg index ec3bea589a..5480c8c11f 100644 --- a/harbour/tests/menutest.prg +++ b/harbour/tests/menutest.prg @@ -1,70 +1,70 @@ -// -// $Id$ -// +/* + * $Id$ + */ #include "inkey.ch" -procedure main() +PROCEDURE Main() - memvar ptestvar + MEMVAR ptestvar - local testvar + LOCAL testvar - set key K_F8 to RECURSE() + SET KEY K_F8 TO RECURSE() - clear screen + CLEAR SCREEN - @ 1, 10 prompt 'Menu Item 1' message 'Menu Message 1' - @ 2, 10 prompt 'Menu Item 2' message 'Menu Message 2' - @ 3, 10 prompt 'Menu Item 3' message 'Menu Message 3' - @ 4, 10 prompt 'Menu Item 4' message 'Menu Message 4' + @ 1, 10 PROMPT 'Menu Item 1' MESSAGE 'Menu Message 1' + @ 2, 10 PROMPT 'Menu Item 2' MESSAGE 'Menu Message 2' + @ 3, 10 PROMPT 'Menu Item 3' MESSAGE 'Menu Message 3' + @ 4, 10 PROMPT 'Menu Item 4' MESSAGE 'Menu Message 4' - @ 6, 10 say 'Testing with LOCAL parameter' - @ 7, 10 say 'Press F8 to recurse into MENU TO' + @ 6, 10 SAY 'Testing with LOCAL parameter' + @ 7, 10 SAY 'Press F8 to recurse into MENU TO' - menu to testvar + MENU TO testvar - @ 9, 10 say 'Your Choice = ' + str( testvar, 1 ) + @ 9, 10 SAY 'Your Choice = ' + Str( testvar, 1 ) - Inkey(0) + Inkey( 0 ) - set key K_F8 to RECURSE() + SET KEY K_F8 TO RECURSE() - clear screen + CLEAR SCREEN - @ 1, 10 prompt 'Menu Item 1' message 'Menu Message 1' - @ 2, 10 prompt 'Menu Item 2' message 'Menu Message 2' - @ 3, 10 prompt 'Menu Item 3' message 'Menu Message 3' - @ 4, 10 prompt 'Menu Item 4' message 'Menu Message 4' + @ 1, 10 PROMPT 'Menu Item 1' MESSAGE 'Menu Message 1' + @ 2, 10 PROMPT 'Menu Item 2' MESSAGE 'Menu Message 2' + @ 3, 10 PROMPT 'Menu Item 3' MESSAGE 'Menu Message 3' + @ 4, 10 PROMPT 'Menu Item 4' MESSAGE 'Menu Message 4' - @ 6, 10 say 'Testing with MEMVAR parameter' - @ 7, 10 say 'Press F8 to recurse into MENU TO' + @ 6, 10 SAY 'Testing with MEMVAR parameter' + @ 7, 10 SAY 'Press F8 to recurse into MENU TO' - menu to ptestvar + MENU TO ptestvar - @ 9, 10 say 'Your Choice = ' + str( ptestvar, 1 ) + @ 9, 10 SAY 'Your Choice = ' + Str( ptestvar, 1 ) - return + RETURN -procedure RECURSE() +PROCEDURE RECURSE() - local testvar + LOCAL testvar - set key K_F8 to + SET KEY K_F8 TO - @ 6, 10 say ' ' + @ 6, 10 SAY ' ' - @ 1, 50 prompt 'Menu Item 1' message 'Menu Message 1' - @ 2, 50 prompt 'Menu Item 2' message 'Menu Message 2' - @ 3, 50 prompt 'Menu Item 3' message 'Menu Message 3' - @ 4, 50 prompt 'Menu Item 4' message 'Menu Message 4' + @ 1, 50 PROMPT 'Menu Item 1' MESSAGE 'Menu Message 1' + @ 2, 50 PROMPT 'Menu Item 2' MESSAGE 'Menu Message 2' + @ 3, 50 PROMPT 'Menu Item 3' MESSAGE 'Menu Message 3' + @ 4, 50 PROMPT 'Menu Item 4' MESSAGE 'Menu Message 4' - menu to testvar + MENU TO testvar - @ 7, 10 say 'Press F8 to recurse into MENU TO' + @ 7, 10 SAY 'Press F8 to recurse into MENU TO' - @ 9, 50 say 'Your Choice = ' + str( testvar, 1 ) + @ 9, 50 SAY 'Your Choice = ' + Str( testvar, 1 ) - set key K_F8 to RECURSE() + SET KEY K_F8 TO RECURSE() - return + RETURN diff --git a/harbour/tests/mousetst.prg b/harbour/tests/mousetst.prg index d1af48cd04..427cc8f48f 100644 --- a/harbour/tests/mousetst.prg +++ b/harbour/tests/mousetst.prg @@ -10,7 +10,7 @@ #include "inkey.ch" -PROCEDURE main() +PROCEDURE Main() LOCAL nR := 5, nC := 38 diff --git a/harbour/tests/multiarg.prg b/harbour/tests/multiarg.prg index 0fcd88a4de..b14e7e3118 100644 --- a/harbour/tests/multiarg.prg +++ b/harbour/tests/multiarg.prg @@ -1,10 +1,7 @@ -// -// $Id$ -// +/* + * $Id$ + */ -// -// MultiArg -// // Testing of multiple arguments // // Date : 1999/05/24 @@ -14,17 +11,19 @@ // // Placed in the public domain // -function Main() + +PROCEDURE Main() ShoutArg( 1, "1", 2.5, .T. ) ShoutArg( 2, "1", 2.5, .T. ) ShoutArg( 3, "1", 2.5, .T. ) ShoutArg( 4, "1", 2.5, .T. ) ShoutArg( 5, "1", 2.5, .T. ) -return nil + RETURN -function ShoutArg( nArg, x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 ) +FUNCTION ShoutArg( nArg, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 ) - QOut( nArg, "==", HB_PValue( nArg ) ) -return nil + QOut( nArg, "==", hb_PValue( nArg ) ) + + RETURN nil diff --git a/harbour/tests/newrdd.prg b/harbour/tests/newrdd.prg index 461337b175..109a5015e4 100644 --- a/harbour/tests/newrdd.prg +++ b/harbour/tests/newrdd.prg @@ -1,18 +1,19 @@ -// -// $Id$ -// +/* + * $Id$ + */ -function Main() +PROCEDURE Main() - local nI, aArray + LOCAL nI, aArray REQUEST _DBF + rddSetDefault( "DBF" ) SET EXCLUSIVE OFF CLS - dbUseArea( .T., "DBF", "test", "TESTDBF", .T., .F. ) + dbUseArea( .T. , "DBF", "test", "TESTDBF", .T. , .F. ) ? "RecCount:", TESTDBF->( RecCount() ) ? "Used:", TESTDBF->( Used() ) ? "Select:", TESTDBF->( Select() ) @@ -21,16 +22,16 @@ function Main() ? "NetErr:", TESTDBF->( NetErr() ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS - aArray := RddList( 0 ) + aArray := rddList( 0 ) ? "Rdd's: " - for nI := 1 to Len( aArray ) + FOR nI := 1 TO Len( aArray ) ?? aArray[ nI ], "" - next - ? "RddName:", TESTDBF->( RddName() ) - ? "lUpdate:", TESTDBF->( lUpdate() ) + NEXT + ? "RddName:", TESTDBF->( rddName() ) + ? "lUpdate:", TESTDBF->( LUpdate() ) ? "Header:", TESTDBF->( Header() ) ? "FieldPos( 'LAST' ):", TESTDBF->( FieldPos( "LAST" ) ) ? "FieldName( 2 ):", TESTDBF->( FieldName( 2 ) ) @@ -39,109 +40,109 @@ function Main() ? "dbTableExt():", TESTDBF->( dbTableExt() ) aArray := TESTDBF->( dbStruct() ) ? "dbStruct:" - for nI := 1 to Len( aArray ) + FOR nI := 1 TO Len( aArray ) ? PadR( aArray[ nI ][ 1 ], 10 ) , aArray[ nI ][ 2 ], aArray[ nI ][ 3 ], aArray[ nI ][ 4 ] - next + NEXT ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? "dbGoTop():" dbGoTop() - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( -1 ):" - dbSkip( -1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + dbSkip( - 1 ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( -1 ):" - dbSkip( -1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + dbSkip( - 1 ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( 1 ):" dbSkip( 1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( 1 ):" dbSkip( 1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbGoTop():" dbGoTop() - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( 1 ):" dbSkip( 1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( 1 ):" dbSkip( 1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( -1 ):" - dbSkip( -1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + dbSkip( - 1 ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( -1 ):" - dbSkip( -1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) - InKey( 0 ) + dbSkip( - 1 ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) + Inkey( 0 ) CLS ? "dbGoBottom():" dbGoBottom() - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( 1 ):" dbSkip( 1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( 1 ):" dbSkip( 1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( -1 ):" - dbSkip( -1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + dbSkip( - 1 ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "dbSkip( -1 ):" - dbSkip( -1 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + dbSkip( - 1 ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? "dbGoto( 490 ):" dbGoto( 490 ) - ? "Bof Eof Found Deleted RecNo:", TESTDBF->( Bof() ), TESTDBF->( Eof() ), ; - TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; - TESTDBF->( RecNo() ) + ? "Bof Eof Found Deleted RecNo:", TESTDBF->( BOF() ), TESTDBF->( EOF() ), ; + TESTDBF->( Found() ), TESTDBF->( Deleted() ), TESTDBF->( Deleted() ), ; + TESTDBF->( RecNo() ) ? "FCount:", TESTDBF->( FCount() ) - for nI := 1 to TESTDBF->( FCount() ) + FOR nI := 1 TO TESTDBF->( FCount() ) ? "FieldGet( " + LTrim( Str( nI ) ) + " ):", TESTDBF->( FieldGet( nI ) ) - next + NEXT ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? "while !TESTDBF->( Eof() )" @@ -149,13 +150,13 @@ function Main() ? " TESTDBF->( dbSkip() )" ? "end" ? "" - while !TESTDBF->( Eof() ) + WHILE !TESTDBF->( EOF() ) ? TESTDBF->FIRST, TESTDBF->( RecNo() ) TESTDBF->( dbSkip() ) - end + ENDDO ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? "SET FILTER TO TESTDBF->AGE == 21" @@ -164,20 +165,20 @@ function Main() ? "while !TESTDBF->( Eof() )" ? " ? TESTDBF->FIRST, TESTDBF->AGE, TESTDBF->( RecNo() )" ? " TESTDBF->( dbSkip() )" - ? "end" + ? "enddo" ? "SET FILTER TO" ? "" SET FILTER TO TESTDBF->AGE == 21 ? TESTDBF->( dbFilter() ) TESTDBF->( dbGoTop() ) - while !TESTDBF->( Eof() ) + WHILE !TESTDBF->( EOF() ) ? TESTDBF->FIRST, TESTDBF->AGE, TESTDBF->( RecNo() ) TESTDBF->( dbSkip() ) - end + ENDDO SET FILTER TO ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? "TESTDBF->( Found() )" @@ -188,13 +189,13 @@ function Main() ? "end" TESTDBF->( Found() ) LOCATE FOR TESTDBF->AGE == 23 - while TESTDBF->( Found() ) + WHILE TESTDBF->( Found() ) ? TESTDBF->FIRST, TESTDBF->AGE, TESTDBF->( RecNo() ) CONTINUE - end + ENDDO ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? "TESTDBF->( dbEval( { || QOut( TESTDBF->FIRST, TESTDBF->AGE ) }, ;" @@ -202,11 +203,11 @@ function Main() ? "" ? "dbCommit()" TESTDBF->( dbEval( { || QOut( TESTDBF->FIRST, TESTDBF->AGE ) }, ; - { || TESTDBF->AGE == 23 } ) ) + { || TESTDBF->AGE == 23 } ) ) TESTDBF->( dbCommit() ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? 'dbCreate( "newrdd", { { "First_Name", "C", 20, 0 }, ;' @@ -217,16 +218,16 @@ function Main() ? ' { "Student", "L", 1, 0 } },, .T., "newrdd" )' ? 'SET CENTURY ON' dbCreate( "newrdd", { { "First_Name", "C", 20, 0 }, ; - { "Age", "N", 3, 0 }, ; - { "Date", "D", 8, 0 }, ; - { "Rate", "N", 6, 2 }, ; - { "Memo", "M", 10, 0 }, ; - { "Student", "L", 1, 0 } },, .T., "newrdd" ) + { "Age", "N", 3, 0 }, ; + { "Date", "D", 8, 0 }, ; + { "Rate", "N", 6, 2 }, ; + { "Memo", "M", 10, 0 }, ; + { "Student", "L", 1, 0 } }, , .T. , "newrdd" ) SET CENTURY ON - ? "lUpdate:", NEWRDD->( lUpdate() ) + ? "lUpdate:", NEWRDD->( LUpdate() ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? 'Select( "TESTDBF" )' @@ -255,21 +256,21 @@ function Main() ? "NEWRDD->( dbDelete() )" ? "? NEWRDD->( Deleted() )" ? "NEWRDD->( dbRLock( 3 ) )" - Select( "TESTDBF" ) + SELECT( "TESTDBF" ) SET FILTER TO TESTDBF->SALARY > 120000 TESTDBF->( dbGoTop() ) - while !TESTDBF->( Eof() ) + WHILE !TESTDBF->( EOF() ) NEWRDD->( dbAppend() ) NEWRDD->FIRST_NAME := TESTDBF->FIRST NEWRDD->AGE := TESTDBF->AGE NEWRDD->DATE := TESTDBF->HIREDATE NEWRDD->RATE := Val( Right( LTrim( Str( Seconds() ) ), 5 ) ) NEWRDD->MEMO := TESTDBF->FIRST + Chr( 13 ) + Chr( 10 ) + ; - TESTDBF->LAST + Chr( 13 ) + Chr( 10 ) + ; - TESTDBF->STREET + TESTDBF->LAST + Chr( 13 ) + Chr( 10 ) + ; + TESTDBF->STREET NEWRDD->STUDENT := TESTDBF->MARRIED TESTDBF->( dbSkip() ) - end + ENDDO SET FILTER TO ? NEWRDD->( RecCount() ) NEWRDD->( dbGoTop() ) @@ -283,7 +284,7 @@ function Main() NEWRDD->( dbRLock( 3 ) ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS aArray := NEWRDD->( dbRLockList() ) @@ -292,12 +293,12 @@ function Main() ? " ? aArray[ nI ]" ? "next" ? "dbRLockList(): " - for nI := 1 to Len( aArray ) + FOR nI := 1 TO Len( aArray ) ? aArray[ nI ] - next + NEXT ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? 'NEWRDD->( dbCloseArea() )' @@ -307,18 +308,18 @@ function Main() ? '? "RecCount:", NEWRDD->( RecCount() )' ? "" NEWRDD->( dbCloseArea() ) - dbUseArea( .T., "DBF", "newrdd", "NEWRDD", .F., .F. ) + dbUseArea( .T. , "DBF", "newrdd", "NEWRDD", .F. , .F. ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS nI := 1 - NEWRDD->( __dbPack( { || QOut( nI ), nI++ } ) ) + NEWRDD->( __dbPack( { || QOut( nI ), nI ++ } ) ) ? "RecCount:", NEWRDD->( RecCount() ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? '? "RecCount:", NEWRDD->( RecCount() )' @@ -330,7 +331,7 @@ function Main() ? "RecCount:", NEWRDD->( RecCount() ) ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS ? 'NEWRDD->( dbCloseArea() )' @@ -350,25 +351,25 @@ function Main() ? 'next' ? "Press any key to continue..." - InKey( 0 ) + Inkey( 0 ) CLS NEWRDD->( dbCloseArea() ) - Select( "TESTDBF" ) + SELECT( "TESTDBF" ) SORT ON FIRST /DC, AGE /D TO NEWRDD - dbUseArea( .T., "DBF", "newrdd", "NEWRDD", .F., .F. ) + dbUseArea( .T. , "DBF", "newrdd", "NEWRDD", .F. , .F. ) ? "RecCount:", NEWRDD->( RecCount() ) - for nI := 1 to 8 + FOR nI := 1 TO 8 ? NEWRDD->FIRST, NEWRDD->AGE NEWRDD->( dbSkip() ) - next + NEXT ? "..." NEWRDD->( dbGoBottom() ) - NEWRDD->( dbSkip( -8 ) ) - for nI := 1 to 8 + NEWRDD->( dbSkip( - 8 ) ) + FOR nI := 1 TO 8 ? NEWRDD->FIRST, NEWRDD->AGE NEWRDD->( dbSkip() ) - next + NEXT -return nil \ No newline at end of file + RETURN diff --git a/harbour/tests/nums.prg b/harbour/tests/nums.prg index f331c9393e..eea1ee52bd 100644 --- a/harbour/tests/nums.prg +++ b/harbour/tests/nums.prg @@ -1,17 +1,17 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing the different numeric formats Harbour produces -function main() +PROCEDURE Main() - local a := 0 // it should generate a _ZERO pcode opcode - local b := 123 // it should generate a _PUSHINT pcode opcodes - local c := 50000 // it should generate a _PUSHLONG pcode opcodes - local d := 12000.123 // it should generate a _PUSHDOUBLE pcode opcodes - local e := 0xABAB // Automatic support for hexadecimal numbers - local f := .12 + LOCAL a := 0 // it should generate a _ZERO pcode opcode + LOCAL b := 123 // it should generate a _PUSHINT pcode opcodes + LOCAL c := 50000 // it should generate a _PUSHLONG pcode opcodes + LOCAL d := 12000.123 // it should generate a _PUSHDOUBLE pcode opcodes + LOCAL e := 0xABAB // Automatic support for hexadecimal numbers + LOCAL f := .12 QOut( a ) QOut( b ) @@ -19,4 +19,4 @@ function main() QOut( d ) QOut( e ) -return nil + RETURN diff --git a/harbour/tests/objarr.prg b/harbour/tests/objarr.prg index f8070fdabd..8e7c0285d8 100644 --- a/harbour/tests/objarr.prg +++ b/harbour/tests/objarr.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // // Object Array syntax test @@ -11,9 +11,9 @@ // Placed in the public domain // -Function Main +PROCEDURE Main() - local o := TNumber():New() + LOCAL o := TNumber():New() QOut( "Direct reference : ", ToChar( o:x ) ) @@ -25,9 +25,9 @@ Function Main o:Get()[2] := 4 QOut( "Assign 4 : ", ToChar( o:x ) ) - QOut( "Post increment : ", o:x[1]++ , o:Get()[2]++ ) + QOut( "Post increment : ", o:x[1] ++ , o:Get()[2] ++ ) QOut( "After : ", o:x[1] , o:Get()[2] ) - QOut( "Pre decrement : ", --o:x[1] , --o:Get()[2] ) + QOut( "Pre decrement : ", -- o:x[1] , -- o:Get()[2] ) QOut( "After : ", o:x[1] , o:Get()[2] ) o:x[1] += 2 @@ -55,36 +55,37 @@ Function Main QOut( "To the power 3 : ", ToChar( o:x ) ) QOut( "Global stack" ) - Debug( __dbgvmStkGList() ) - QOut( "Statics") - Debug( __dbgvmVarSList() ) -return NIL + Debug( __dbgVMStkGList() ) + QOut( "Statics" ) + Debug( __dbgVMVarSList() ) -Function TNumber() // Very simple class + RETURN - static oNumber +FUNCTION TNumber() // Very simple class - if oNumber == NIL + STATIC oNumber + + IF oNumber == NIL oNumber := HBClass():New( "TNumber" ) oNumber:AddData ( "x" ) oNumber:AddMethod( "Get", @Get() ) oNumber:AddMethod( "New", @New() ) oNumber:Create() - endif -return oNumber:Instance() + ENDIF + RETURN oNumber:Instance() -static function New() +STATIC FUNCTION New() - local self := QSelf() + LOCAL self := QSelf() - ::x := {1,1} -return self + ::x := { 1, 1 } + RETURN self -static function Get() +STATIC FUNCTION Get() - local self := QSelf() + LOCAL self := QSelf() -return ::x + return ::x diff --git a/harbour/tests/objasign.prg b/harbour/tests/objasign.prg index 40dec48d37..500cb183b1 100644 --- a/harbour/tests/objasign.prg +++ b/harbour/tests/objasign.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // // Object Array syntax test @@ -11,9 +11,9 @@ // Placed in the public domain // -Function Main +PROCEDURE Main() - local o := TNumber():New() + LOCAL o := TNumber():New() QOut( "Direct reference : ", o:x ) @@ -23,9 +23,9 @@ Function Main o:x := 4 QOut( "Assign 4 : ", o:x ) - QOut( "Post increment : ", o:x++ ) + QOut( "Post increment : ", o:x ++ ) QOut( "After : ", o:x ) - QOut( "Pre decrement : ", --o:x ) + QOut( "Pre decrement : ", -- o:x ) QOut( "After : ", o:x ) o:x += 2 @@ -47,30 +47,30 @@ Function Main QOut( "To the power 3 : ", o:x ) QOut( "Global stack" ) - Debug( __dbgvmStkGList() ) - QOut( "Statics") - Debug( __dbgvmVarSList() ) -return NIL + Debug( __dbgVMStkGList() ) + QOut( "Statics" ) + Debug( __dbgVMVarSList() ) -Function TNumber() // Very simple class + RETURN - static oNumber +FUNCTION TNumber() // Very simple class - if oNumber == NIL + STATIC oNumber + + IF oNumber == NIL oNumber := HBClass():New( "TNumber" ) - oNumber:AddData ( "x" ) + oNumber:AddData( "x" ) oNumber:AddMethod( "New", @New() ) oNumber:Create() - endif -return oNumber:Instance() + ENDIF + RETURN oNumber:Instance() -static function New() +STATIC FUNCTION New() - local self := QSelf() + LOCAL self := QSelf() ::x := 1 -return self - + RETURN self diff --git a/harbour/tests/objects.prg b/harbour/tests/objects.prg index 94c26e514e..3c284be203 100644 --- a/harbour/tests/objects.prg +++ b/harbour/tests/objects.prg @@ -1,15 +1,15 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour classes and objects management -// be aware Harbour provides a much simpler way using Class HBClass (source\rtl\class.prg) +// be aware Harbour provides a much simpler way using Class HBClass #include "hboo.ch" -function Main() +PROCEDURE Main() - local oObject := TAny():New() + LOCAL oObject := TAny():New() QOut( ValType( oObject ) ) QOut( Len( oObject ) ) // 3 datas ! @@ -18,49 +18,48 @@ function Main() QOut( oObject:ClassName() ) // retrieves its class name oObject:Test() // This invokes the below defined Test function - // See QSelf() and :: use + // See QSelf() and :: use QOut( oObject:cName ) oObject:DoNothing() // a virtual method does nothing, - // but it is very usefull for Classes building logic + // but it is very usefull for Classes building logic -return nil + RETURN -function TAny() /* builds a class */ +FUNCTION TAny() /* builds a class */ - static hClass + STATIC hClass - if hClass == nil + IF hClass == nil hClass := __clsNew( "TANY", 3 ) // cClassName, nDatas __clsAddMsg( hClass, "cName", 1, HB_OO_MSG_DATA ) // retrieve data __clsAddMsg( hClass, "_cName", 1, HB_OO_MSG_DATA ) // assign data. Note the '_' __clsAddMsg( hClass, "New", @New(), HB_OO_MSG_METHOD ) __clsAddMsg( hClass, "Test", @Test(), HB_OO_MSG_METHOD ) __clsAddMsg( hClass, "DoNothing", 0, HB_OO_MSG_VIRTUAL ) - endif + ENDIF /* warning: we are not defining datas names and methods yet */ -return __clsInst( hClass ) // creates an object of this class + RETURN __clsInst( hClass ) // creates an object of this class -static function New() +STATIC FUNCTION New() - local Self := QSelf() + LOCAL Self := QSelf() QOut( ValType( Self ) ) QOut( "Inside New()" ) ::cName := "Harbour OOP" -return Self + RETURN Self -static function Test() +STATIC FUNCTION Test() - local Self := QSelf() // We access Self for this method + LOCAL Self := QSelf() // We access Self for this method QOut( "Test method invoked!" ) QOut( ::ClassName() ) // :: means Self: It is a Harbour built-in operator -return nil - + RETURN nil diff --git a/harbour/tests/omacro.prg b/harbour/tests/omacro.prg index 90bb8b6b46..4679856c18 100644 --- a/harbour/tests/omacro.prg +++ b/harbour/tests/omacro.prg @@ -7,18 +7,19 @@ * using macro syntax */ -PROCEDURE MAIN() - LOCAL obj:=ErrorNew() +PROCEDURE Main() + + LOCAL obj := ErrorNew() MEMVAR send1, send2 - PRIVATE send1:="_description" - PRIVATE send2:="_tries" + PRIVATE send1 := "_description" + PRIVATE send2 := "_tries" obj:tries := 1 - obj:&send1 := 'test' + obj:&send1 := "test" obj:tries += 1 - obj:tries++ + obj:tries ++ ++obj:tries WITH OBJECT obj @@ -27,25 +28,25 @@ PROCEDURE MAIN() ++:tries /* - Notice that for post/pre increment decrement operators and - for assigments (:=,+=,-=,*=,/=) the macro have to - start from the underscore symbol '_' + Notice that for post/pre increment decrement operators and + for assigments (:=,+=,-=,*=,/=) the macro have to + start from the underscore symbol '_' - To access the object variable using macro the '_' should be omitted + To access the object variable using macro the '_' should be omitted */ - :&send2 +=1 - :&send2++ + :&send2 += 1 + :&send2 ++ ++:&send2 - ++:&(send2) + ++:&( send2 ) - :&( send2 ) := :&( SUBSTR(send2,2) ) +1 + :&( send2 ) := :&( SubStr( send2,2 ) ) + 1 - :&send1 +=' description' - :&(send1) += ' of ' + :&send1 += " description" + :&( send1 ) += " of " ENDWITH - obj:&( "_"+ SUBSTR(send1,2) ) += "Error object" - ? send1, "=", obj:&( SUBSTR(send1,2) ) + obj:&( "_" + SubStr( send1,2 ) ) += "Error object" + ? send1, "=", obj:&( SubStr( send1, 2 ) ) ? send2, "=", obj:tries RETURN diff --git a/harbour/tests/onidle.prg b/harbour/tests/onidle.prg index 0b068f207e..00d7113140 100644 --- a/harbour/tests/onidle.prg +++ b/harbour/tests/onidle.prg @@ -1,75 +1,77 @@ -// -// $Id$ -// +/* + * $Id$ + */ #include "hbmemory.ch" -FUNCTION MAIN -LOCAL nH1, nH2, nH3, nH4 -LOCAL n:=0 -LOCAL aSign:={"|", "/", "-", "\" } -LOCAL nPrev:=SECONDS() +PROCEDURE Main() - CLS - ? " Time: Memory used: Miliseconds elapsed" - ? - ? "Can you see it ??? :) Press any key or wait 30 seconds" - ? - ? - @ 10,2 SAY "Memory before TEST() call" + STR( MEMORY(HB_MEM_USED) ) - TEST() - @ 11,2 SAY "Memory after TEST() and before collecting" + STR( MEMORY(HB_MEM_USED) ) - HB_GCALL() - @ 12,2 SAY "Memory after collecting" + STR( MEMORY(HB_MEM_USED) ) - nH1 := HB_IDLEADD( {|| DEVPOS(0,01), DEVOUT( TIME() ) } ) - nH2 := HB_IDLEADD( {|| DEVPOS(0,21), TEST(), DEVOUT( MEMORY(HB_MEM_USED) ) } ) - nH3 := HB_IDLEADD( {|| DEVPOS(0,41), IIF(n==4,n:=1,n++),DEVOUT(aSign[n]) } ) - nH4 := HB_IDLEADD( {|| DEVPOS(0,61), DEVOUT( 1000*(SECONDS()-nPrev) ), nPrev:=SECONDS() } ) + LOCAL nH1, nH2, nH3, nH4 + LOCAL n := 0 + LOCAL aSign := { "|", "/", "-", "\" } + LOCAL nPrev := Seconds() - ? VALTYPE(nH1), nH1, VALTYPE(nH2), nH2, VALTYPE(nH3), nH3, VALTYPE(nH4), nH4 - - INKEY( 30 ) - IF !EMPTY(nH3) - @ 14,2 SAY "Delete task 3: " + HB_VALTOSTR(nH3) - HB_IDLEDEL( nH3 ) - ENDIF - IF !EMPTY(nH2) - @ 15,2 SAY "Delete task 2: " + HB_VALTOSTR(nH2) - HB_IDLEDEL( nH2 ) - ENDIF - IF !EMPTY(nH1) - @ 16,2 SAY "Delete task 1: " + HB_VALTOSTR(nH1) - HB_IDLEDEL( nH1 ) - ENDIF - IF !EMPTY(nH4) - @ 17,2 SAY "Delete task 4: " + HB_VALTOSTR(nH4) - HB_IDLEDEL( nH4 ) - ENDIF + CLS + ? " Time: Memory used: Miliseconds elapsed" + ? + ? "Can you see it ??? :) Press any key or wait 30 seconds" + ? + ? + @ 10, 2 SAY "Memory before TEST() call" + Str( Memory( HB_MEM_USED ) ) + TEST() + @ 11, 2 SAY "Memory after TEST() and before collecting" + Str( Memory( HB_MEM_USED ) ) + hb_gcAll() + @ 12, 2 SAY "Memory after collecting" + Str( Memory( HB_MEM_USED ) ) + nH1 := hb_idleAdd( { || DevPos( 0,01 ), DevOut( Time() ) } ) + nH2 := hb_idleAdd( { || DevPos( 0,21 ), TEST(), DevOut( Memory(HB_MEM_USED ) ) } ) + nH3 := hb_idleAdd( { || DevPos( 0,41 ), IIF( n == 4,n := 1,n ++ ), DevOut( aSign[n] ) } ) + nH4 := hb_idleAdd( { || DevPos( 0,61 ), DevOut( 1000 * (Seconds() - nPrev ) ), nPrev := Seconds() } ) - @ 18,2 SAY "Memory after idle states" + STR( MEMORY(HB_MEM_USED) ) - HB_GCALL() - @ 19,2 SAY "Memory after collecting" + STR( MEMORY(HB_MEM_USED) ) + ? ValType( nH1 ), nH1, ValType( nH2 ), nH2, ValType( nH3 ), nH3, ValType( nH4 ), nH4 -RETURN 1 + Inkey( 30 ) + IF !Empty( nH3 ) + @ 14, 2 SAY "Delete task 3: " + hb_ValToStr( nH3 ) + hb_idleDel( nH3 ) + ENDIF + IF !Empty( nH2 ) + @ 15, 2 SAY "Delete task 2: " + hb_ValToStr( nH2 ) + hb_idleDel( nH2 ) + ENDIF + IF !Empty( nH1 ) + @ 16, 2 SAY "Delete task 1: " + hb_ValToStr( nH1 ) + hb_idleDel( nH1 ) + ENDIF + IF !Empty( nH4 ) + @ 17, 2 SAY "Delete task 4: " + hb_ValToStr( nH4 ) + hb_idleDel( nH4 ) + ENDIF -PROC TEST() -LOCAL a, b, c -LOCAL cb + @ 18, 2 SAY "Memory after idle states" + Str( Memory( HB_MEM_USED ) ) + hb_gcAll() + @ 19, 2 SAY "Memory after collecting" + Str( Memory( HB_MEM_USED ) ) - a := ARRAY( 3 ) - b := ARRAY( 3 ) - c := ARRAY( 3 ) - a[1] :=a - a[2] :=b - a[3] :=c - b[1] :=a - b[2] :=b - b[3] :=c - c[1] :=a - c[2] :=b - c[3] :=c + RETURN - cb := {|x| x:=cb} - EVAL( cb ) +PROCEDURE TEST() -RETURN + LOCAL a, b, c + LOCAL cb + + a := Array( 3 ) + b := Array( 3 ) + c := Array( 3 ) + a[ 1 ] := a + a[ 2 ] := b + a[ 3 ] := c + b[ 1 ] := a + b[ 2 ] := b + b[ 3 ] := c + c[ 1 ] := a + c[ 2 ] := b + c[ 3 ] := c + + cb := {| x | x := cb } + Eval( cb ) + + RETURN diff --git a/harbour/tests/os.prg b/harbour/tests/os.prg index 3a6e5bc468..2911878e46 100644 --- a/harbour/tests/os.prg +++ b/harbour/tests/os.prg @@ -1,11 +1,11 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing the OS function -function Main() +PROCEDURE Main() - QOUT( OS() ) + QOut( OS() ) -return nil + RETURN diff --git a/harbour/tests/output.prg b/harbour/tests/output.prg index 0c478f567a..5d73b1bed1 100644 --- a/harbour/tests/output.prg +++ b/harbour/tests/output.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour device management. /* Harbour Project source code @@ -10,26 +10,26 @@ #include "set.ch" -function Main() +PROCEDURE Main() - OUTSTD (hb_eol(), "Testing Harbour device management on", DATE()) + OutStd( hb_eol(), "Testing Harbour device management on", Date() ) SET ALTERNATE TO OUTPUT_A ADDITIVE - SET (_SET_EXTRAFILE, "output_e.ext", .F.) + SET( _SET_EXTRAFILE, "output_e.ext", .F. ) SET PRINTER TO OUTPUT_P SET MARGIN TO 5 - QOUT ("SCREEN, EXTRA, NOT ALTERNATE, NOT PRINTER") - @ 5,5 SAY "SCREEN, NOT EXTRA, NOT ALTERNATE NOT PRINTER" + QOut( "SCREEN, EXTRA, NOT ALTERNATE, NOT PRINTER" ) + @ 5, 5 SAY "SCREEN, NOT EXTRA, NOT ALTERNATE NOT PRINTER" SET ALTERNATE ON SET PRINTER ON - QOUT ("SCREEN, EXTRA, ALTERNATE AND PRINTER") - @ 10,10 SAY "SCREEN, NOT EXTRA, NOT ALTERNATE, NOT PRINTER" + QOut( "SCREEN, EXTRA, ALTERNATE AND PRINTER" ) + @ 10, 10 SAY "SCREEN, NOT EXTRA, NOT ALTERNATE, NOT PRINTER" SET DEVICE TO PRINTER - SET (_SET_EXTRAFILE, "") - QOUT ("SCREEN, ALTERNATE AND PRINTER AGAIN, BUT NOT EXTRA") + SET( _SET_EXTRAFILE, "" ) + QOut( "SCREEN, ALTERNATE AND PRINTER AGAIN, BUT NOT EXTRA" ) SET PRINTER OFF - SET (_SET_EXTRAFILE, "output_e.ext", .T.) - QOUT ("SCREEN, EXTRA, AND ALTERNATE, BUT NOT PRINTER") - @ 15,15 SAY "PRINTER, NOT SCREEN, NOT ALTERNATE" + SET( _SET_EXTRAFILE, "output_e.ext", .T. ) + QOut( "SCREEN, EXTRA, AND ALTERNATE, BUT NOT PRINTER" ) + @ 15, 15 SAY "PRINTER, NOT SCREEN, NOT ALTERNATE" EJECT -return nil + RETURN diff --git a/harbour/tests/overload.prg b/harbour/tests/overload.prg index e29ab3fb52..2a48397475 100644 --- a/harbour/tests/overload.prg +++ b/harbour/tests/overload.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // // DynObj @@ -17,12 +17,11 @@ // Placed in the public domain // - #include "hbclass.ch" -function Main() +PROCEDURE Main() - local oString := TString():New( "Hello" ) + LOCAL oString := TString():New( "Hello" ) QOut( "Testing TString with Operator Overloading" ) QOut( oString:cValue ) @@ -43,34 +42,32 @@ function Main() QOut( "Concatenation + :", oString + "Hello" ) QOut( "Concatenation - :", oString - "Hello" ) QOut( "Array index[2] :", oString[2] ) - QOut( "Array index[3] := 'X' :", oString[3]:='X' ) + QOut( "Array index[3] := 'X' :", oString[3] := 'X' ) QOut( oString:cValue ) -return nil + RETURN nil +CREATE CLASS tString -create class tString + VAR cValue - VAR cValue + METHOD New( cText ) INLINE ::cValue := cText, self - METHOD New(cText) INLINE ::cValue := cText, self - - OPERATOR "=" ARG cArg INLINE ::cValue = cArg - OPERATOR "==" ARG cArg INLINE ::cValue == cArg - OPERATOR "!=" ARG cArg INLINE ::cValue != cArg - OPERATOR "<" ARG cArg INLINE ::cValue < cArg - OPERATOR "<=" ARG cArg INLINE ::cValue <= cArg - OPERATOR ">" ARG cArg INLINE ::cValue > cArg - OPERATOR ">=" ARG cArg INLINE ::cValue >= cArg - OPERATOR "+" ARG cArg INLINE ::cValue + cArg - OPERATOR "-" ARG cArg INLINE ::cValue - cArg - OPERATOR "$" ARG cArg INLINE ::cValue $ cArg - OPERATOR "[]" ARG nIndex INLINE iif( pcount()>2, ; - ::cValue := stuff( ::cValue, nIndex, 1, hb_pvalue(3) ), ; - substr( ::cValue, nIndex, 1 ) ) - -endclass + OPERATOR "=" ARG cArg INLINE ::cValue = cArg + OPERATOR "==" ARG cArg INLINE ::cValue == cArg + OPERATOR "!=" ARG cArg INLINE ::cValue != cArg + OPERATOR "<" ARG cArg INLINE ::cValue < cArg + OPERATOR "<=" ARG cArg INLINE ::cValue <= cArg + OPERATOR ">" ARG cArg INLINE ::cValue > cArg + OPERATOR ">=" ARG cArg INLINE ::cValue >= cArg + OPERATOR "+" ARG cArg INLINE ::cValue + cArg + OPERATOR "-" ARG cArg INLINE ::cValue - cArg + OPERATOR "$" ARG cArg INLINE ::cValue $ cArg + OPERATOR "[]" ARG nIndex INLINE iif( PCount() > 2, ; + ::cValue := Stuff( ::cValue, nIndex, 1, hb_PValue( 3 ) ), ; + SubStr( ::cValue, nIndex, 1 ) ) +ENDCLASS /* diff --git a/harbour/tests/parexpr.prg b/harbour/tests/parexpr.prg index e3cffd6e7f..d92d8e691c 100644 --- a/harbour/tests/parexpr.prg +++ b/harbour/tests/parexpr.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // The following code tests harbour's ability to cope with parenthesized // expressions. @@ -13,9 +13,9 @@ #pragma -es0 #endif -Function Main() -Local x -Local y +PROCEDURE Main() + Local x + Local y // Simple one to start with. x := ( 1 ) @@ -24,26 +24,26 @@ Local y // Now with a little more complex: x := ( 1, 2 ) ? x - + // And a little more, this is really the same as the previous one. x := ( 1, 2, 3 ) ? x - + // Expression within expression x := ( ( 1, 2, 3 ) ) ? x - + // And a little more: x := ( ( 1, 2, 3 ), ( 1, 2, 3 ) ) ? x - + // Some inline assignments x := ( y := 10, y ) ? x - + x := ( ( y := ( 1, 2, 3) ), y * ( 10, 20, 30 ) ) ? x - + // Now mix with statements and functions ? ( 1, 2, 3 ) @@ -52,19 +52,19 @@ Local y Else ? "Borken" EndIf - + If ( x := 10, y := ( x == 10 ) ) ? "Working" Else ? "Broken" EndIf - + If ( Something( 1, 2, 3 ), .T. ) ? "Working" Else ? "Broken" EndIf - + ? // Now even some more testing of related code @@ -75,7 +75,7 @@ Local y ? IF( (.T. .OR. .F.), IF( .T., "Working", "Broken" ), IF( .F., "Broken", "Working" ) ) - /* The following code should generate syntax error if uncommented + /* The following code should generate syntax error if uncommented * because IF token followed by any three expressions is interpreted * as IIF inline */ @@ -85,10 +85,10 @@ Local y // ? "Broken" // ENDIF -Return( NIL ) + Return Static Function Something( x, y, z ) - // This does something and it does it well/ - -Return( NIL ) + // This does something and it does it well/ + + Return( NIL ) diff --git a/harbour/tests/passref.prg b/harbour/tests/passref.prg index 9476703134..eff3d7fb6c 100644 --- a/harbour/tests/passref.prg +++ b/harbour/tests/passref.prg @@ -1,27 +1,28 @@ -// -// $Id$ -// +/* + * $Id$ + */ /* test of pass by reference @ */ -function main -local a := 10 -local b := "X" +PROCEDURE Main() -qout('a := 10',a) -qout('b := "X"',b) + LOCAL a := 10 + LOCAL b := "X" -testfun(@a, @b) -qout('return of "a" should = 20',a,iif(a == 20,"worked","failed")) -qout('return of "b" should = A',b,iif(b == "A","worked","failed")) + QOut( 'a := 10', a ) + QOut( 'b := "X"', b ) -return nil + testfun( @a, @b ) + QOut( 'return of "a" should = 20', a, iif( a == 20,"worked","failed" ) ) + QOut( 'return of "b" should = A', b, iif( b == "A","worked","failed" ) ) -function testfun(b,c) -b := b + 10 -c := "A" -qout('a pointer+10 =',b) -qout('b pointer := "A" =',c) + RETURN -return nil +FUNCTION testfun( b, c ) + b := b + 10 + c := "A" + QOut( 'a pointer+10 =', b ) + QOut( 'b pointer := "A" =', c ) + + RETURN nil diff --git a/harbour/tests/procline.prg b/harbour/tests/procline.prg index cd92464a09..51a7d35991 100644 --- a/harbour/tests/procline.prg +++ b/harbour/tests/procline.prg @@ -1,14 +1,13 @@ -// -// $Id$ -// +/* + * $Id$ + */ +PROCEDURE Main() -FUNCTION Main() + ? "hello 1", ProcLine(), "Expected: ", 8 -? "hello 1", ProcLine(), "Expected: ", 8 + ? "hello 2", ProcLine(), "Expected: ", 10 -? "hello 2", ProcLine(), "Expected: ", 10 + ? "hello 3", ProcLine(), "Expected: ", 12 -? "hello 3", ProcLine(), "Expected: ", 12 - -RETURN NIL + RETURN diff --git a/harbour/tests/procname.prg b/harbour/tests/procname.prg index dfcffee695..fec6aeac4d 100644 --- a/harbour/tests/procname.prg +++ b/harbour/tests/procname.prg @@ -1,42 +1,41 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour ProcName() and ProcLine() #define CRLF Chr( 13 ) + Chr( 10 ) -function Main() +PROCEDURE Main() Two() -return nil + RETURN -function Two() +FUNCTION Two() Three() -return nil + RETURN nil -function Three() +FUNCTION Three() Four() -return nil + RETURN nil -function Four() +FUNCTION Four() Five() -return nil + RETURN nil -function Five() +FUNCTION Five() - local n := 0 + LOCAL n := 0 - while ! Empty( ProcName( n ) ) - QQOut( "Called from: ", ProcName( n ), ProcLine( n++ ), CRLF ) - end - -return nil + WHILE ! Empty( ProcName( n ) ) + QQOut( "Called from: ", ProcName( n ), ProcLine( n ++ ), CRLF ) + ENDDO + RETURN nil diff --git a/harbour/tests/recursiv.prg b/harbour/tests/recursiv.prg index 502c0bdc76..9c3388e980 100644 --- a/harbour/tests/recursiv.prg +++ b/harbour/tests/recursiv.prg @@ -1,19 +1,19 @@ -// -// $Id$ -// +/* + * $Id$ + */ // testing recursive calls -function main() +PROCEDURE Main() - QOut( "Testing recursive calls" + Chr( 13 ) + Chr( 10 ) ) + QOut( "Testing recursive calls" + Chr( 13 ) + Chr( 10 ) ) - QOut(f(10)) + QOut( f( 10 ) ) - QOut( 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1 ) + QOut( 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1 ) -return nil + RETURN -function f(a) -return iif(a<2,1,a*f(a-1)) +FUNCTION f( a ) + RETURN iif( a < 2, 1, a * f( a - 1 ) ) diff --git a/harbour/tests/returns.prg b/harbour/tests/returns.prg index 852150468a..82119820a3 100644 --- a/harbour/tests/returns.prg +++ b/harbour/tests/returns.prg @@ -1,10 +1,10 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing multiple returns into a function -function Main() +PROCEDURE Main() QOut( "From Main()" ) @@ -16,20 +16,20 @@ function Main() QOut( "back to Main()" ) -return nil + RETURN -function Two( n ) +FUNCTION Two( n ) - do case - case n == 1 - QOut( "n == 1" ) - return nil + DO CASE + CASE n == 1 + QOut( "n == 1" ) + RETURN nil - case n == 2 - QOut( "n == 2" ) - return nil - endcase + CASE n == 2 + QOut( "n == 2" ) + RETURN nil + ENDCASE - QOut( "This message should not been seen" ) + QOut( "This message should not been seen" ) -return nil + RETURN nil diff --git a/harbour/tests/round.prg b/harbour/tests/round.prg index 5cfe52b9dc..af8dbb3c0d 100644 --- a/harbour/tests/round.prg +++ b/harbour/tests/round.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour rounding. /* Harbour Project source code @@ -8,17 +8,18 @@ Donated to the public domain on 2001-03-08 by David G. Holm */ -function main() -local n, value := -5 +PROCEDURE Main() - for n := 1 to 100 - OUTSTD(hb_eol()) - OUTSTD(value) - OUTSTD(round(value, 3)) - OUTSTD(round(value, 2)) - OUTSTD(round(value, 1)) - OUTSTD(round(value, 0)) + LOCAL n, value := - 5 + + FOR n := 1 TO 100 + OutStd( hb_eol() ) + OutStd( value ) + OutStd( Round( value, 3 ) ) + OutStd( Round( value, 2 ) ) + OutStd( Round( value, 1 ) ) + OutStd( Round( value, 0 ) ) value += 0.001 - next + NEXT -return nil + RETURN diff --git a/harbour/tests/rtfclass.prg b/harbour/tests/rtfclass.prg deleted file mode 100644 index 7f9bb36cee..0000000000 --- a/harbour/tests/rtfclass.prg +++ /dev/null @@ -1,142 +0,0 @@ -// -// $Id$ -// - -/* - * harbour rtfclass demo - * notes : - raw enough but it works - - using hb_f*() - some compilers are not friendly with this :( - - rtf is assumed to have association - * initial release : 23 June 1999 Andi Jahja - * this program compiles fine on Borland C/C++ 5.0 - * tested under Windows 98 only with RTF associated to Winword - * works with printable ascii only - * placed in the public domain -*/ - -#define CRLF CHR(13) + CHR(10) - -function main() - -local ortf := trtf():new("test.rtf") -local htest := fcreate( "rtf_test.txt") -local ctest := "" - -// create a plain text file -ctest += "This is +bHarbour © RTF Class-b" + CRLF -ctest += "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG" + CRLF -ctest += "+bTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-b" + CRLF -ctest += "+iTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-i" + CRLF -ctest += "+buTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bu" + CRLF -ctest += "+buiTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bui" + CRLF -ctest += "THE +bQUICK-b +buBROWN-bu +buiFOX-bui +iJUMPS-i +uOVER-u +ilTHE-il +uLAZY-u +buDOG-bu" + CRLF - -fwrite( htest, ctest ) -fclose( htest ) - -// convert text file to rtf -ortf:write("rtf_test.txt") -ortf:close() - -// execute file association ( windows only ) -if lower( os() ) == "windows" - // assuming start.exe is exist - __run( "start test.rtf" ) -endif -return nil - -function trtf() -static oclass - -if oclass == nil - oclass := HBClass():new( "trtf" ) - oclass:adddata( "nhandle" ) - oclass:addmethod( "new", @new() ) - oclass:addmethod( "write", @write() ) - oclass:addmethod( "close", @close() ) - oclass:create() -endif -return oclass:instance() - -static function new( cfilename ) -local self := qself() -::nhandle := fcreate( cfilename ) -fwrite( ::nhandle,; - "{\rtf1\ansi\deff0{\fonttbl {\f0\fnil\fcharset0 Courier New;}{\f1\fnil\fcharset0 Arial;}}"+; - "\uc1\pard\lang1033\ulnone\f0\fs20"+CRLF) -return self - -static function write( csource ) -local self := qself() -local cchar, cline, xatt, i, _xatt -local n, nchar, xchar, y -// These are character attributes, self-defined -// + means a turn-on -// - means a turn-off -local attrib := {; - { "+b" , "\b " } /* turn bold on*/ ,; - { "+bu" , "\ul\b " } /* turn bold_underline on */ ,; - { "+bi" , "\b\i " } /* turn bold_italic on */ ,; - { "+bui", "\ul\b\i " } /* turn bold_underline_italic on */ ,; - { "+i" , "\i " } /* turn italic on */ ,; - { "+il" , "\ul\i " } /* turn italic_underline on */ ,; - { "+u" , "\ul " } /* turn underline on */ ,; - { "-b" , "\b0 " } /* turn bold off */ ,; - { "-bu" , "\b0\ulnone " } /* turn bold_underline off */ ,; - { "-bi" , "\b0\i0 " } /* turn bold_italic off */ ,; - { "-bui", "\b0\i0\ulnone " } /* turn bold_underline_italic off */,; - { "-i" , "\i0 " } /* turn italic off */ ,; - { "-il" , "\ulnone\i0 " } /* turn italic_underline off */ ,; - { "-u" , "\ulnone " } /* turn underline off */ } - -hb_fuse( csource ) // open source file -while !hb_feof() // read the file line by line - cline := hb_freadln() + "\par" - y := len( cline ) - for nchar := 1 to y - cchar := substr( cline, nchar, 1 ) - - // todo : i need function dec2hex() - // to convert ascii to 2-characters hex - // ie : dec2hex( "H" ) -> 48 - if cchar == "+" .or. cchar == "-" - xatt := cchar + ; - substr( cline, nchar + 1, 1 ) + ; - substr( cline, nchar + 2, 1 ) + ; - substr( cline, nchar + 3, 1 ) - if ( i := ascan( attrib, { |e| e[1] == xatt } ) ) > 0 - fwrite( ::nhandle, attrib[i][2] ) - nchar := nchar + len( xatt ) - 1 - else - // 3 attributes - xatt := left( xatt, 3 ) - if ( i := ascan( attrib, { |e| e[1] == xatt } ) ) > 0 - fwrite( ::nhandle, attrib[i][2] ) - nchar := nchar + len( xatt ) - 1 - else - // 2 attributes - xatt := left( xatt, 2 ) - if ( i := ascan( attrib, { |e| e[1] == xatt } ) ) > 0 - fwrite( ::nhandle, attrib[i][2] ) - nchar := nchar + len( xatt ) - 1 - else - fwrite( ::nhandle, cchar ) - endif - endif - endif - else - fwrite( ::nhandle, cchar ) - endif - next - fwrite( ::nhandle, CRLF ) - hb_fskip() // read next line -enddo -hb_fuse() -return ( self ) - -static function close() -local self := qself() -fwrite( ::nhandle, "\f1\fs16\par"+CRLF+"}" ) -fclose( ::nhandle ) - -return self diff --git a/harbour/tests/say.prg b/harbour/tests/say.prg index 7c4e048dd7..40d975ec0c 100644 --- a/harbour/tests/say.prg +++ b/harbour/tests/say.prg @@ -1,22 +1,24 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Tests @ SAY with and without PICTURE clauses -function Main() +PROCEDURE Main() + CLS SET CENTURY ON - @ 2,39 TO 7,39 DOUBLE - @ 0,0 SAY "Testing @ SAY with and without PICTURE clauses" - @ 0,60 SAY DATE() + @ 2, 39 TO 7, 39 DOUBLE + @ 0, 0 SAY "Testing @ SAY with and without PICTURE clauses" + @ 0, 60 SAY Date() SET CENTURY OFF - @ 2,1 SAY -1.25 - @ 2,41 SAY -1.25 PICTURE "@( 99,999.99" - @ 3,1 SAY 1.25 PICTURE "@( 9,999.99" - @ 3,41 SAY 1.25 PICTURE "@( $9,999.99" - @ 5,1 SAY DATE() - @ 5,41 SAY DATE() PICTURE "@E" - @ 7,1 SAY "Hello" - @ 7,41 SAY "Hello" PICTURE "@!" -return nil + @ 2, 1 SAY - 1.25 + @ 2, 41 SAY - 1.25 PICTURE "@( 99,999.99" + @ 3, 1 SAY 1.25 PICTURE "@( 9,999.99" + @ 3, 41 SAY 1.25 PICTURE "@( $9,999.99" + @ 5, 1 SAY Date() + @ 5, 41 SAY Date() PICTURE "@E" + @ 7, 1 SAY "Hello" + @ 7, 41 SAY "Hello" PICTURE "@!" + + RETURN diff --git a/harbour/tests/sbartest.prg b/harbour/tests/sbartest.prg index 7af729890c..ab0ca1d0c6 100644 --- a/harbour/tests/sbartest.prg +++ b/harbour/tests/sbartest.prg @@ -19,7 +19,7 @@ #define B_THIN ( Chr( 219 ) + Chr( 223 ) + Chr( 219 ) + Chr( 219 ) + ; Chr( 219 ) + Chr( 220 ) + Chr( 219 ) + Chr( 219 ) ) -PROCEDURE main() +PROCEDURE Main() InitScrlBar() diff --git a/harbour/tests/scroll.prg b/harbour/tests/scroll.prg index ad4ff48e44..4ea4212071 100644 --- a/harbour/tests/scroll.prg +++ b/harbour/tests/scroll.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour screen scrolling (requires the GT API) /* Harbour Project source code @@ -9,10 +9,11 @@ */ #include "box.ch" -function main() -local ct +FUNCTION main() - DEVPOS(MAXROW(),0) + LOCAL ct + + DevPos( MaxRow(), 0 ) DispBegin() ? "If you have the GT API linked in, the screen will be blanked, a text block" ? "will be drawn in the upper-left hand corner of the screen, and then the inside" @@ -24,45 +25,47 @@ local ct DispEnd() Pause() -SET COLOR TO "GR+/RB" + SET COLOR TO "GR+/RB" CLS - @ 0,0,14,45 BOX B_SINGLE - @ 0,0 SAY "01234567890123456789012345678901" - @ 1,0 SAY "01234567890123456789012345678901" - @ 2,0 SAY "01234567890123456789012345678901" - @ 3,0 SAY "01234 78901" - @ 4,0 SAY "01234 This is a test. 78901" - @ 5,0 SAY "01234 This is only a test. 78901" - @ 6,0 SAY "01234 Had this been a real 78901" - @ 7,0 SAY "01234 emergency, you would 78901" - @ 8,0 SAY "01234 be dead now. 78901" - @ 9,0 SAY "01234 78901" - @ 10,0 SAY "01234567890123456789012345678901" - @ 11,0 SAY "01234567890123456789012345678901" - @ 12,0 SAY "01234567890123456789012345678901" - @ 13,0 SAY "0 1 2 3 " + @ 0, 0, 14, 45 BOX B_SINGLE + @ 0, 0 SAY "01234567890123456789012345678901" + @ 1, 0 SAY "01234567890123456789012345678901" + @ 2, 0 SAY "01234567890123456789012345678901" + @ 3, 0 SAY "01234 78901" + @ 4, 0 SAY "01234 This is a test. 78901" + @ 5, 0 SAY "01234 This is only a test. 78901" + @ 6, 0 SAY "01234 Had this been a real 78901" + @ 7, 0 SAY "01234 emergency, you would 78901" + @ 8, 0 SAY "01234 be dead now. 78901" + @ 9, 0 SAY "01234 78901" + @ 10, 0 SAY "01234567890123456789012345678901" + @ 11, 0 SAY "01234567890123456789012345678901" + @ 12, 0 SAY "01234567890123456789012345678901" + @ 13, 0 SAY "0 1 2 3 " Pause() -//save/restore test - cT := SAVESCREEN( 0,0, 13, 31 ) - RESTSCREEN( 10,40, 23, 71, cT ) + //save/restore test + cT := SaveScreen( 0, 0, 13, 31 ) + RestScreen( 10, 40, 23, 71, cT ) pause() - - Scroll (1, 1, 11, 30, -2, -5) + + Scroll ( 1, 1, 11, 30, - 2, - 5 ) pause() - Scroll (1, 1, 11, 30, 2, 5) + Scroll ( 1, 1, 11, 30, 2, 5 ) pause() - Scroll (1, 1, 11, 30, -5, 2) + Scroll ( 1, 1, 11, 30, - 5, 2 ) pause() - Scroll (1, 1, 11, 30, 7, -12) + Scroll ( 1, 1, 11, 30, 7, - 12 ) pause() SET COLOR TO "W+/R" - Scroll (1, 1, 11, 30, 0, 0 ) + Scroll ( 1, 1, 11, 30, 0, 0 ) pause() -return nil + RETURN NIL -function pause() - DevPos (MAXROW() - 2, 0) - __ACCEPT ("pause: ") -return nil +FUNCTION pause() + + DevPos ( MaxRow() - 2, 0 ) + __Accept ( "pause: " ) + + RETURN NIL diff --git a/harbour/tests/sdf_test.prg b/harbour/tests/sdf_test.prg index 166878b8f8..dfa42ec0e9 100644 --- a/harbour/tests/sdf_test.prg +++ b/harbour/tests/sdf_test.prg @@ -1,50 +1,53 @@ //NOTEST -// $Id$ -// +/* + * $Id$ + */ -// Test program for COPY TO SDF and APPEND FROM SDF -// Note: Only COPY TO SDF is fully implemented at this time... + // Test program for COPY TO SDF and APPEND FROM SDF + // Note: Only COPY TO SDF is fully implemented at this time... /* Harbour Project source code http://harbour-project.org/ Donated to the public domain on 2001-04-18 by David G. Holm */ -procedure main() - local ncount := 0 - use test new +PROCEDURE Main() + + LOCAL ncount := 0 + + USE test NEW // Copy all records and fields. - copy to test1 SDF + COPY TO test1 SDF // Copy only address fields for records with salary over 50,000. - copy field first,last,street,city,state,zip to test2 SDF for _field->salary>50000 + COPY FIELD first, last, street, city, state, zip TO test2 SDF for _field->salary > 50000 // Only copy record 3. - copy record 3 to test3 SDF + COPY record 3 TO test3 SDF // Copy records 4 through 7. - copy next 4 to test4 SDF + COPY next 4 TO test4 SDF // Try to copy 10 records, starting 5 records from EOF, using WHILE - go bottom + GO BOTTOM skip -4 - copy while ncount++ < 9 to test4a SDF + COPY WHILE ncount++ < 9 TO test4a SDF // Copy the last 10 records. - go bottom + GO BOTTOM skip -9 - copy rest to test5 SDF + COPY REST TO test5 SDF // Copy the last 10 records again. - go bottom + GO BOTTOM skip -9 - copy to test6 SDF while !eof() + COPY TO test6 SDF WHILE !EOF() // Copy only some of the last 10 records. - go bottom + GO BOTTOM skip -9 - copy rest to test7 SDF for _field->married + COPY REST TO test7 SDF for _field->married // Try to append from a file that we know does not exist. - delete file test8.txt - append from test8 SDF -quit \ No newline at end of file + DELETE file test8.txt + APPEND FROM test8 SDF + QUIT diff --git a/harbour/tests/seconds.prg b/harbour/tests/seconds.prg index 28a3f1086c..feb5138940 100644 --- a/harbour/tests/seconds.prg +++ b/harbour/tests/seconds.prg @@ -8,22 +8,23 @@ Donated to the public domain on 2001-03-08 by David G. Holm */ -function Main( cParam ) -local n, limit := 10 +FUNCTION Main( cParam ) - IF ! EMPTY( cParam ) - limit := VAL( cParam ) + LOCAL n, limit := 10 + + IF ! Empty( cParam ) + limit := Val( cParam ) ENDIF - OUTSTD( hb_eol() ) - OUTSTD( SECONDS() ) + OutStd( hb_eol() ) + OutStd( Seconds() ) FOR n := 1 TO limit - IF EMPTY( cParam ) - OUTSTD( hb_eol() ) - OUTSTD( "Pause: " ) - INKEY(0) + IF Empty( cParam ) + OutStd( hb_eol() ) + OutStd( "Pause: " ) + Inkey( 0 ) ENDIF - OUTSTD( hb_eol() ) - OUTSTD( SECONDS() ) + OutStd( hb_eol() ) + OutStd( Seconds() ) NEXT -RETURN NIL + RETURN NIL diff --git a/harbour/tests/server.prg b/harbour/tests/server.prg index c57ddd4a8b..b13e6c25c1 100644 --- a/harbour/tests/server.prg +++ b/harbour/tests/server.prg @@ -118,13 +118,13 @@ PROCEDURE Progress( nProgress, nDrow, nDcol ) DO CASE CASE nProgress == 0 - @ nDrow, nDcol + 1 SAY "-" + @ nDrow, nDcol + 1 SAY "-" CASE nProgress == 1 - @ nDrow, nDcol + 1 SAY "\" + @ nDrow, nDcol + 1 SAY "\" CASE nProgress == 2 - @ nDrow, nDcol + 1 SAY "|" + @ nDrow, nDcol + 1 SAY "|" CASE nProgress == 3 - @ nDrow, nDcol + 1 SAY "/" + @ nDrow, nDcol + 1 SAY "/" ENDCASE nProgress++ diff --git a/harbour/tests/set_num.prg b/harbour/tests/set_num.prg index 5ec93d5241..4758d0829d 100644 --- a/harbour/tests/set_num.prg +++ b/harbour/tests/set_num.prg @@ -6,12 +6,13 @@ #include "set.ch" -function Main() -local n +PROCEDURE Main() - for n := 1 to _SET_COUNT - outstd (hb_eol()) - outstd (set (n)) - next + LOCAL n -return nil + FOR n := 1 TO _SET_COUNT + OutStd( hb_eol() ) + OutStd( Set( n ) ) + NEXT + + RETURN diff --git a/harbour/tests/set_test.prg b/harbour/tests/set_test.prg index 20775556fc..df8c81d713 100644 --- a/harbour/tests/set_test.prg +++ b/harbour/tests/set_test.prg @@ -5,86 +5,91 @@ // Testing SET #include "set.ch" -request dbfntx -function Main() -// for Clipper, this drags in the terminal driver -@ Row(), col() say "" - TestLine( "_SET_EXACT", 1) - TestLine( "_SET_FIXED", 2) - TestLine( "_SET_DECIMALS", 3) - TestLine( "_SET_DATEFORMAT", 4) - TestLine( "_SET_EPOCH", 5) - TestLine( "_SET_PATH", 6) - TestLine( "_SET_DEFAULT", 7) +REQUEST dbfntx - TestLine( "_SET_EXCLUSIVE", 8) - TestLine( "_SET_SOFTSEEK", 9) - TestLine( "_SET_UNIQUE", 10) - TestLine( "_SET_DELETED", 11) +FUNCTION Main() - TestLine( "_SET_CANCEL", 12) - TestLine( "_SET_DEBUG", 13) - TestLine( "_SET_TYPEAHEAD", 14) + // for Clipper, this drags in the terminal driver + @ Row(), Col() SAY "" - TestLine( "_SET_COLOR", 15) - TestLine( "_SET_CURSOR", 16) - TestLine( "_SET_CONSOLE", 17) - TestLine( "_SET_ALTERNATE", 18) - TestLine( "_SET_ALTFILE", 19) - TestLine( "_SET_DEVICE", 20) - TestLine( "_SET_EXTRA", 21) - TestLine( "_SET_EXTRAFILE", 22) - TestLine( "_SET_PRINTER", 23) - TestLine( "_SET_PRINTFILE", 24) - TestLine( "_SET_MARGIN", 25) + TestLine( "_SET_EXACT", 1 ) + TestLine( "_SET_FIXED", 2 ) + TestLine( "_SET_DECIMALS", 3 ) + TestLine( "_SET_DATEFORMAT", 4 ) + TestLine( "_SET_EPOCH", 5 ) + TestLine( "_SET_PATH", 6 ) + TestLine( "_SET_DEFAULT", 7 ) - TestLine( "_SET_BELL", 26) - TestLine( "_SET_CONFIRM", 27) - TestLine( "_SET_ESCAPE", 28) - TestLine( "_SET_INSERT", 29) - TestLine( "_SET_EXIT", 30) - TestLine( "_SET_INTENSITY", 31) - TestLine( "_SET_SCOREBOARD", 32) - TestLine( "_SET_DELIMITERS", 33) - TestLine( "_SET_DELIMCHARS", 34) + TestLine( "_SET_EXCLUSIVE", 8 ) + TestLine( "_SET_SOFTSEEK", 9 ) + TestLine( "_SET_UNIQUE", 10 ) + TestLine( "_SET_DELETED", 11 ) - TestLine( "_SET_WRAP", 35) - TestLine( "_SET_MESSAGE", 36) - TestLine( "_SET_MCENTER", 37) - TestLine( "_SET_SCROLLBREAK", 38) + TestLine( "_SET_CANCEL", 12 ) + TestLine( "_SET_DEBUG", 13 ) + TestLine( "_SET_TYPEAHEAD", 14 ) + + TestLine( "_SET_COLOR", 15 ) + TestLine( "_SET_CURSOR", 16 ) + TestLine( "_SET_CONSOLE", 17 ) + TestLine( "_SET_ALTERNATE", 18 ) + TestLine( "_SET_ALTFILE", 19 ) + TestLine( "_SET_DEVICE", 20 ) + TestLine( "_SET_EXTRA", 21 ) + TestLine( "_SET_EXTRAFILE", 22 ) + TestLine( "_SET_PRINTER", 23 ) + TestLine( "_SET_PRINTFILE", 24 ) + TestLine( "_SET_MARGIN", 25 ) + + TestLine( "_SET_BELL", 26 ) + TestLine( "_SET_CONFIRM", 27 ) + TestLine( "_SET_ESCAPE", 28 ) + TestLine( "_SET_INSERT", 29 ) + TestLine( "_SET_EXIT", 30 ) + TestLine( "_SET_INTENSITY", 31 ) + TestLine( "_SET_SCOREBOARD", 32 ) + TestLine( "_SET_DELIMITERS", 33 ) + TestLine( "_SET_DELIMCHARS", 34 ) + + TestLine( "_SET_WRAP", 35 ) + TestLine( "_SET_MESSAGE", 36 ) + TestLine( "_SET_MCENTER", 37 ) + TestLine( "_SET_SCROLLBREAK", 38 ) #ifdef _SET_EVENTMASK - TestLine( "_SET_EVENTMASK", 39) + TestLine( "_SET_EVENTMASK", 39 ) - TestLine( "_SET_VIDEOMODE", 40) + TestLine( "_SET_VIDEOMODE", 40 ) - TestLine( "_SET_MBLOCKSIZE", 41) - TestLine( "_SET_MFILEEXT", 42) + TestLine( "_SET_MBLOCKSIZE", 41 ) + TestLine( "_SET_MFILEEXT", 42 ) - TestLine( "_SET_STRICTREAD", 43) - TestLine( "_SET_OPTIMIZE", 44) - TestLine( "_SET_AUTOPEN", 45) - TestLine( "_SET_AUTORDER", 46) - TestLine( "_SET_AUTOSHARE", 47) + TestLine( "_SET_STRICTREAD", 43 ) + TestLine( "_SET_OPTIMIZE", 44 ) + TestLine( "_SET_AUTOPEN", 45 ) + TestLine( "_SET_AUTORDER", 46 ) + TestLine( "_SET_AUTOSHARE", 47 ) #endif #ifdef _SET_LANGUAGE - TestLine( "_SET_LANGUAGE", 100) - TestLine( "_SET_IDLEREPEAT", 101) - TestLine( "_SET_FILECASE", 102) - TestLine( "_SET_DIRCASE", 103) - TestLine( "_SET_DIRSEPARATOR",104) - Set(_SET_DIRSEPARATOR, "/") - TestLine( "_SET_DIRSEPARATOR",104) + TestLine( "_SET_LANGUAGE", 100 ) + TestLine( "_SET_IDLEREPEAT", 101 ) + TestLine( "_SET_FILECASE", 102 ) + TestLine( "_SET_DIRCASE", 103 ) + TestLine( "_SET_DIRSEPARATOR", 104 ) + SET( _SET_DIRSEPARATOR, "/" ) + TestLine( "_SET_DIRSEPARATOR", 104 ) #endif -return nil + RETURN NIL -proc testline( c, n ) - outstd( hb_eol() ) - outstd( str( n, 3 ) ) - outstd( " " ) - outstd( Padr( c, 20 ) ) - outstd( Set( n ) ) -return +PROCEDURE testline( c, n ) + + OutStd( hb_eol() ) + OutStd( Str( n, 3 ) ) + OutStd( " " ) + OutStd( PadR( c, 20 ) ) + OutStd( Set( n ) ) + + RETURN diff --git a/harbour/tests/setkeys.prg b/harbour/tests/setkeys.prg index 852c8d4237..4cdf66951e 100644 --- a/harbour/tests/setkeys.prg +++ b/harbour/tests/setkeys.prg @@ -55,77 +55,80 @@ #include "inkey.ch" -Procedure Main() - local GetList := {} - local alpha, bravo, charlie, k, l - local F8Active := .t. +PROCEDURE Main() - cls + LOCAL GetList := {} + LOCAL alpha, bravo, charlie, k, l + LOCAL F8Active := .T. - @ 2, 2 say "Press F10 to popup alert box of current get, not active if empty" - @ 3, 2 say "Press F9 to disable all setkeys, except F9 to restore (uses SetKeySave())" - @ 4, 2 say "Press F8 to test setkey w/ array, SetKeyCheck(), and SetKeyGet()" - @ 5, 2 say "Press F7 to active/deactive F8" + CLS - alpha := "alpha " - bravo := 123 - charlie := date() + @ 2, 2 SAY "Press F10 to popup alert box of current get, not active if empty" + @ 3, 2 SAY "Press F9 to disable all setkeys, except F9 to restore (uses SetKeySave())" + @ 4, 2 SAY "Press F8 to test setkey w/ array, SetKeyCheck(), and SetKeyGet()" + @ 5, 2 SAY "Press F7 to active/deactive F8" - @ 10, 10 get alpha - @ 11, 10 get bravo - @ 12, 10 get charlie + alpha := "alpha " + bravo := 123 + charlie := Date() - #ifndef K_F10 + @ 10, 10 GET alpha + @ 11, 10 GET bravo + @ 12, 10 GET charlie - #define K_F10 -9 - #define K_F9 -8 - #define K_F8 -7 - #define K_ESC 27 +#ifndef K_F10 - #endif +#define K_F10 -9 +#define K_F9 -8 +#define K_F8 -7 +#define K_ESC 27 - setKey( K_F10, {|| Alert( transform( getactive():varGet(), NIL ) ) }, ; - {|| !empty( getactive():VarGet() ) } ) /* :buffer */ - setKey( K_F9 , {|| k := hb_SetKeySave( NIL ), ; - SetKey( K_F9, {|| hb_SetKeySave( k ) } ) } ) - SetKey( K_F8 , {|| SubMain() }, {|| F8Active } ) - SetKey( K_F7 , {|| F8Active := ! F8Active } ) +#endif - read - ? alpha, bravo, charlie + SetKey( K_F10, { || Alert( Transform( GetActive():varGet(), NIL ) ) }, ; + { || !Empty( GetActive():VarGet() ) } ) /* :buffer */ + SetKey( K_F9 , { || k := hb_SetKeySave( NIL ), ; + SetKey( K_F9, { || hb_SetKeySave( k ) } ) } ) + SetKey( K_F8 , { || SubMain() }, { || F8Active } ) + SetKey( K_F7 , { || F8Active := ! F8Active } ) - return + READ + ? alpha, bravo, charlie -static Procedure SubMain() - local n - local bF8Action, bF8Active + RETURN - bF8Action := hb_SetKeyGet( K_F8, @bF8Active ) - SetKey( K_F8, NIL ) +STATIC PROCEDURE SubMain() - hb_SetKeyArray( { 49, 50, 52, 53 }, {|x| qout( chr( x ) ) } ) - do while ( n := inkey( 0 ) ) != K_ESC - if hb_SetKeyCheck( n, procname(),procline(), readvar() ) - qqout( " hit hot" ) - else - qout( chr( n ) ) - qqout( " hit cold" ) - endif - end + LOCAL n + LOCAL bF8Action, bF8Active - hb_SetKeyArray( { 49, 50, 52, 53 }, NIL ) - SetKey( K_F8, bF8Action, bF8Active ) + bF8Action := hb_SetKeyGet( K_F8, @bF8Active ) + SetKey( K_F8, NIL ) - return + hb_SetKeyArray( { 49, 50, 52, 53 }, { |x| QOut( Chr( x ) ) } ) + DO WHILE ( n := Inkey( 0 ) ) != K_ESC + IF hb_SetKeyCheck( n, ProcName(), ProcLine(), ReadVar() ) + QQOut( " hit hot" ) + ELSE + QOut( Chr( n ) ) + QQOut( " hit cold" ) + ENDIF + end -Procedure Help( cProc, nLine, cVar ) - local nX := col(), nY := row() + hb_SetKeyArray( { 49, 50, 52, 53 }, NIL ) + SetKey( K_F8, bF8Action, bF8Active ) - @ 19, 19 say "Pcount: " ; ?? pcount() - @ 20, 10 say "Proc : " ; ?? cProc - @ 21, 10 say "Line : " ; ?? nLine - @ 22, 10 say "Var : " ; ?? cVar + RETURN - SetPos( nX, nY ) +PROCEDURE Help( cProc, nLine, cVar ) - return + LOCAL nX := Col(), nY := Row() + + @ 19, 19 SAY "Pcount: " ; ?? PCount() + @ 20, 10 SAY "Proc : " ; ?? cProc + @ 21, 10 SAY "Line : " ; ?? nLine + @ 22, 10 SAY "Var : " ; ?? cVar + + SetPos( nX, nY ) + + RETURN diff --git a/harbour/tests/sound.prg b/harbour/tests/sound.prg index dc3f89b1f2..6853337f01 100644 --- a/harbour/tests/sound.prg +++ b/harbour/tests/sound.prg @@ -2,13 +2,16 @@ * $Id$ */ -function main() -local start := seconds(), stop - qout( "start ", start ) - tone( 440, 9.1 ) - tone( 880, 9.1 ) - tone( 440, 9.1 ) - stop := seconds() - qout( "stop ", stop ) - qout( "duration", ( stop - start ), "(should be close to 1.5)" ) -return nil +PROCEDURE Main() + + LOCAL start := Seconds(), stop + + QOut( "start ", start ) + Tone( 440, 9.1 ) + Tone( 880, 9.1 ) + Tone( 440, 9.1 ) + stop := Seconds() + QOut( "stop ", stop ) + QOut( "duration", ( stop - start ), "(should be close to 1.5)" ) + + RETURN diff --git a/harbour/tests/speed.prg b/harbour/tests/speed.prg index 1932b6d791..8bfce6e16b 100644 --- a/harbour/tests/speed.prg +++ b/harbour/tests/speed.prg @@ -2,22 +2,25 @@ * $Id$ */ -Function Main() - Local Program := { , }, Condition := 1, body := 2, Counter := 1, TheEnd := 1000000, stop, start +PROCEDURE Main() - Program[ condition] := { || Counter == TheEnd} - Program[ body] := { || Counter++} - ? start := Second() + LOCAL Program := { , }, Condition := 1, body := 2, Counter := 1, TheEnd := 1000000, stop, start - // in Clipper : - // While !Program[ condition]:Eval() ; Program[ body]:Eval() - // why Harbour CodeBlocks don't have Eval() method ?! + Program[ condition] := {|| Counter == TheEnd } + Program[ body] := {|| Counter ++ } + ? start := Second() - // Now It is supported. + // in Clipper : + // While !Program[ condition]:Eval() ; Program[ body]:Eval() + // why Harbour CodeBlocks don't have Eval() method ?! - While !Eval( Program[ condition]) ; Eval( Program[ body]) - End - ? stop := Second() - ? '===============' - ? stop - start - Return NIL + // Now It is supported. + + DO WHILE ! Eval( Program[ condition] ) + Eval( Program[ body] ) + ENDDO + ? stop := Second() + ? '===============' + ? stop - start + + RETURN diff --git a/harbour/tests/statfun.prg b/harbour/tests/statfun.prg index a9bc65271a..67727fe664 100644 --- a/harbour/tests/statfun.prg +++ b/harbour/tests/statfun.prg @@ -1,10 +1,10 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing a static function call -function Main() +PROCEDURE Main() QOut( "From Main()" ) @@ -12,10 +12,10 @@ function Main() QOut( "From Main() again" ) -return nil + RETURN -static function SecondOne() +STATIC FUNCTION SecondOne() QOut( "From Second()" ) -return nil + RETURN nil diff --git a/harbour/tests/statics.prg b/harbour/tests/statics.prg index e28feb5b20..607c420a5c 100644 --- a/harbour/tests/statics.prg +++ b/harbour/tests/statics.prg @@ -1,15 +1,16 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour statics variables management -static z := "First" +STATIC s_z := "First" -function Main() -LOCAL i, cb +PROCEDURE Main() - static a := "Hello", b := { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 } + LOCAL i, cb + + STATIC a := "Hello", b := { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 } QOut( a ) QOut( b[ 2 ] ) @@ -18,43 +19,48 @@ LOCAL i, cb QOut( "Ok!" ) - FOR i:=1 TO 10 - NumStat() - NEXT - - cb :=DetachVar( 10 ) - FOR i:=1 To 10 - QOut( EVAL( cb, b[ i ] ) ) + FOR i := 1 TO 10 + NumStat() NEXT -return nil + cb := DetachVar( 10 ) + FOR i := 1 TO 10 + QOut( Eval( cb, b[ i ] ) ) + NEXT -function Two() + RETURN - static a := "Test" +FUNCTION Two() + + STATIC a := "Test" QOut( a ) -return nil + RETURN NIL FUNCTION THREE( p ) + QOut( p ) -RETURN p -PROCEDURE NumStat(a) -STATIC n:=1 -LOCAL cb -//STATIC m:=n //uncomment it to see an error -//STATIC m:=Time() //uncomment it to see an error + RETURN p - cb :={|x| z +STR(x)} - QOut( ++n ) - QOut( EVAL( cb,n ) ) - -RETURN +PROCEDURE NumStat( a ) + STATIC s_n := 1 + + LOCAL cb + +// STATIC m := s_n // uncomment it to see an error +// STATIC m := Time() // uncomment it to see an error + + cb := {| x | s_z + Str( x ) } + QOut( ++s_n ) + QOut( Eval( cb, s_n ) ) + + RETURN FUNCTION DetachVar( xLocal ) -STATIC xStatic:=100 -RETURN( {|x| ++xStatic, x+xStatic+xLocal} ) \ No newline at end of file + STATIC xStatic := 100 + + RETURN( {| x | ++xStatic, x + xStatic + xLocal } ) diff --git a/harbour/tests/statics1.prg b/harbour/tests/statics1.prg index 836041e513..d26f54e3d5 100644 --- a/harbour/tests/statics1.prg +++ b/harbour/tests/statics1.prg @@ -1,14 +1,14 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Statics overlapped! // // Compile statics1.prg, statics2.prg and link both files -static uOne, uTwo +STATIC uOne, uTwo -function Main() +PROCEDURE Main() QOut( "Statics overlapped!" ) QOut( "===================" ) @@ -28,4 +28,4 @@ function Main() QOut( " uOne, uTwo =>", uOne, ",", uTwo ) QOut( "" ) -return nil + RETURN diff --git a/harbour/tests/statics2.prg b/harbour/tests/statics2.prg index 33db864dcf..485ca5cc3a 100644 --- a/harbour/tests/statics2.prg +++ b/harbour/tests/statics2.prg @@ -1,14 +1,14 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Statics overlapped! // // Compile statics1.prg, statics2.prg and link both files -static uA, uB +STATIC uA, uB -function Test() +PROCEDURE Test() QOut( "INSIDE statics2.prg" ) QOut( " static uA, uB" ) @@ -22,4 +22,4 @@ function Test() QOut( " uA, uB =>", uA, ",", uB ) QOut( "" ) -return nil + RETURN diff --git a/harbour/tests/statinit.prg b/harbour/tests/statinit.prg index 5712cb4665..6db99e0770 100644 --- a/harbour/tests/statinit.prg +++ b/harbour/tests/statinit.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // ; Donated to the public domain by // Viktor Szakats (harbour syenar.net) @@ -10,14 +10,14 @@ MEMVAR cMyPubVar STATIC bBlock1 := {|| Hello() } STATIC bBlock2 := {|| cMyPubVar } -FUNCTION Main() +PROCEDURE Main() PUBLIC cMyPubVar := "Printed from a PUBLIC var from a codeblock assigned to a static variable." Eval( bBlock1 ) ? Eval( bBlock2 ) - RETURN NIL + RETURN FUNCTION Hello() diff --git a/harbour/tests/strdelim.prg b/harbour/tests/strdelim.prg index 09c180116f..b258e4a1cf 100644 --- a/harbour/tests/strdelim.prg +++ b/harbour/tests/strdelim.prg @@ -1,14 +1,14 @@ -// -// $Id$ -// +/* + * $Id$ + */ -procedure main() +PROCEDURE Main() - local aArray := {{NIL}} + LOCAL aArray := { { NIL } } - aArray [ 1 /*first*/ ][ 1 /* second */ ] := [Hello] + aArray[ 1 /*first*/ ][ 1 /* second */ ] := [Hello] - QOut( aArray[1][1] ) + QOut( aArray[ 1 ][ 1 ] ) QOut( 'World "Peace[!]"' ) @@ -16,6 +16,4 @@ procedure main() QOut( [King 'Clipper "!"'] ) -return - - + RETURN diff --git a/harbour/tests/stripem.prg b/harbour/tests/stripem.prg index 3b7d44d370..cee9c3b90a 100644 --- a/harbour/tests/stripem.prg +++ b/harbour/tests/stripem.prg @@ -4,7 +4,7 @@ #include "set.ch" -#xtranslate Default( , ) => IIF( == NIL, , ) +#xtranslate Default( , ) => iif( == NIL, , ) // // Strip @@ -56,9 +56,9 @@ FUNCTION Main( cFrom, cTo ) RETURN nil - // - // Generic DOS file handler - // +// +// Generic DOS file handler +// FUNCTION TTextFile() // Parameter = dirty @@ -94,13 +94,13 @@ FUNCTION TTextFile() // Parameter = dirty RETURN oFile:Instance() - // - // Method TextFile:New -> Create a new text file - // - // file name. No wild characters - // mode for opening. Default "R" - // Optional maximum blocksize - // +// +// 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 ) @@ -129,9 +129,9 @@ FUNCTION New( cFileName, cMode, nBlock ) RETURN self - // - // Dispose -> Close the file handle - // +// +// Dispose -> Close the file handle +// FUNCTION Dispose() @@ -150,9 +150,9 @@ FUNCTION Dispose() RETURN self - // - // Read a single line - // +// +// Read a single line +// FUNCTION READ() @@ -204,13 +204,13 @@ FUNCTION READ() 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) - // +// +// 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 ) @@ -235,9 +235,9 @@ FUNCTION WriteLn( xTxt, lCRLF ) RETURN self - // - // Go to a specified line number - // +// +// Go to a specified line number +// FUNCTION GOTO( nLine ) diff --git a/harbour/tests/switch.prg b/harbour/tests/switch.prg index 1b073f9667..492f1dd421 100644 --- a/harbour/tests/switch.prg +++ b/harbour/tests/switch.prg @@ -2,15 +2,15 @@ * $Id$ */ -#ifdef __XHARBOUR__ +#ifdef __XHARBOUR__ #define OTHERWISE DEFAULT -#endif +#endif -PROCEDURE MAIN -LOCAL a:=1 -PRIVATE b:="b" +PROCEDURE Main() + LOCAL a := 1 + PRIVATE b := "b" -#ifndef __XHARBOUR__ +#ifndef __XHARBOUR__ SWITCH a END #endif @@ -43,11 +43,11 @@ PRIVATE b:="b" ? "other" END -#ifndef __XHARBOUR__ +#ifndef __XHARBOUR__ ? ? "44444444444444444444444444444444444" SWITCH a - OTHERWISE + OTHERWISE ? "OTHERWISE" END #endif @@ -55,12 +55,12 @@ PRIVATE b:="b" ? ? "55555555555555555555555555555555555" a := 'EE' -#ifndef __XHARBOUR__ +#ifndef __XHARBOUR__ SWITCH a CASE 11 ? "11" exit - + CASE 'CCCC'+'DDDD' ? a+a EXIT @@ -71,7 +71,7 @@ PRIVATE b:="b" CASE 1+1+1 ? "3" EXIT - + CASE 1+1*3 CASE 123+12*4-1*4+2 CASE 1-4 @@ -117,4 +117,4 @@ PRIVATE b:="b" ? "=========================================" -RETURN \ No newline at end of file + RETURN diff --git a/harbour/tests/symbolt.prg b/harbour/tests/symbolt.prg index b8cface1f8..4cdba6d6b4 100644 --- a/harbour/tests/symbolt.prg +++ b/harbour/tests/symbolt.prg @@ -5,9 +5,9 @@ // Class(y) Class Symbol documentation is located at: // http://www.clipx.net/ng/classy/ngdebc.php -function Main() +PROCEDURE Main() - local oSym := Symbol():New( "QOUT" ) + LOCAL oSym := SYMBOL():New( "QOUT" ) ? "Now test the :Exec() method" @@ -19,9 +19,9 @@ function Main() ? "symbol name: ", oSym:name ? "Comparing QOut symbol with xOut symbol" - ? oSym:IsEqual( Symbol():New( "xOut" ) ) + ? oSym:IsEqual( SYMBOL():New( "xOut" ) ) ? "done!" ? -return nil + RETURN diff --git a/harbour/tests/t1.prg b/harbour/tests/t1.prg index 6cb4b81e3a..f36e56735d 100644 --- a/harbour/tests/t1.prg +++ b/harbour/tests/t1.prg @@ -1,18 +1,18 @@ -// -// $Id$ -// +/* + * $Id$ + */ // while loop test -function Main() +FUNCTION Main() - local i := 0 - local cb := {|| QOut("test")} + LOCAL i := 0 + LOCAL cb := {|| QOut( "test" ) } - while i < 1000 - QOut(i) - eval(cb) - i++ - end + WHILE i < 1000 + QOut( i ) + Eval( cb ) + i ++ + END -return nil + RETURN nil diff --git a/harbour/tests/tb1.prg b/harbour/tests/tb1.prg index 81993e74ab..7a21f8d059 100644 --- a/harbour/tests/tb1.prg +++ b/harbour/tests/tb1.prg @@ -16,7 +16,7 @@ #include "setcurs.ch" #include "box.ch" -proc main() +procedure Main() static s_nCount := 0 static s_nPos := 1 diff --git a/harbour/tests/test10.prg b/harbour/tests/test10.prg deleted file mode 100644 index bb050ce96e..0000000000 --- a/harbour/tests/test10.prg +++ /dev/null @@ -1,16 +0,0 @@ -//NOTEST -// -// $Id$ -// - -// compile this using Harbour /10 flag - -Function Main() - - QOut( MyReplicatZZ( 'a', 10 ) ) - -return NIL - -Function MyReplicator( cChar, nLen ) - -return Replicate( cChar, nLen ) diff --git a/harbour/tests/testbrdb.prg b/harbour/tests/testbrdb.prg index e7f69e6f8c..5f3cd7e9d1 100644 --- a/harbour/tests/testbrdb.prg +++ b/harbour/tests/testbrdb.prg @@ -4,16 +4,17 @@ // Testing Browse() -function Main() +PROCEDURE Main() + LOCAL cColor - cColor := SETCOLOR("W+/B") + cColor := SetColor( "W+/B" ) CLS USE test Browse() - SETCOLOR(cColor) + SetColor( cColor ) CLS -return nil + RETURN diff --git a/harbour/tests/testbrw.prg b/harbour/tests/testbrw.prg index d8c4f076a9..d869e1289f 100644 --- a/harbour/tests/testbrw.prg +++ b/harbour/tests/testbrw.prg @@ -2,7 +2,7 @@ * $Id$ */ - // Harbour Class TBrowse and TBColumn sample +// Harbour Class TBrowse and TBColumn sample #include "inkey.ch" @@ -58,7 +58,7 @@ FUNCTION Main() nCol := Col() @ 4, 4, 17, 31 BOX "ÚÄ¿³ÙÄÀ³ " #ifdef HB_COMPAT_C53 - oBrowse:SetKey( 0, { |ob, nkey| Defproc( ob,nKey ) } ) + oBrowse:SetKey( 0, {| ob, nkey | Defproc( ob,nKey ) } ) WHILE .T. oBrowse:ForceStable() IF ( oBrowse:applykey( Inkey(0 ) ) == - 1 ) @@ -125,7 +125,7 @@ FUNCTION Main() DevPos( nTmpRow, nTmpCol ) ENDCASE - + end #endif DevPos( nRow, nCol ) @@ -136,7 +136,7 @@ FUNCTION Main() #ifdef HB_COMPAT_C53 -FUNCTION defproc( ob, nkey ) +FUNCTION defproc( ob, nkey ) LOCAL nTmpRow, nTmpCol diff --git a/harbour/tests/testcdx.prg b/harbour/tests/testcdx.prg index 14ed3454e0..937a093935 100644 --- a/harbour/tests/testcdx.prg +++ b/harbour/tests/testcdx.prg @@ -1,51 +1,51 @@ -// -// $Id$ -// +/* + * $Id$ + */ -function Main() +PROCEDURE Main() - local aStruct := { { "CHARACTER", "C", 25, 0 }, ; - { "NUMERIC", "N", 8, 0 }, ; - { "DOUBLE", "N", 8, 2 }, ; - { "DATE", "D", 8, 0 }, ; - { "MEMO", "M", 10, 0 }, ; - { "LOGICAL", "L", 1, 0 } } + LOCAL aStruct := {; + { "CHARACTER", "C", 25, 0 }, ; + { "NUMERIC", "N", 8, 0 }, ; + { "DOUBLE", "N", 8, 2 }, ; + { "DATE", "D", 8, 0 }, ; + { "MEMO", "M", 10, 0 }, ; + { "LOGICAL", "L", 1, 0 } } CLS - dbUseArea( .T., "DBFCDX", "test", "TESTDBF", .T., .F. ) - dbCreate( "testcdx", aStruct, "DBFCDX", .T., "TESTCDX" ) + dbUseArea( .T. , "DBFCDX", "test", "TESTDBF", .T. , .F. ) + dbCreate( "testcdx", aStruct, "DBFCDX", .T. , "TESTCDX" ) - ? "RddName:", RddName() -// ? "Press any key to continue..." -// InKey( 0 ) + ? "RddName:", rddName() + // ? "Press any key to continue..." + // InKey( 0 ) Select( "TESTDBF" ) SET FILTER TO TESTDBF->SALARY > 140000 TESTDBF->( dbGoTop() ) -// while !TESTDBF->( Eof() ) -// TESTCDX->( dbAppend() ) -// TESTCDX->CHARACTER = TESTDBF->FIRST -// TESTCDX->NUMERIC = TESTDBF->SALARY -// TESTCDX->MEMO := TESTDBF->FIRST + Chr( 13 ) + Chr( 10 ) + ; -// TESTDBF->LAST + Chr( 13 ) + Chr( 10 ) + ; -// TESTDBF->STREET -// TESTDBF->( dbSkip() ) -// end + // WHILE !TESTDBF->( Eof() ) + // TESTCDX->( dbAppend() ) + // TESTCDX->CHARACTER = TESTDBF->FIRST + // TESTCDX->NUMERIC = TESTDBF->SALARY + // TESTCDX->MEMO := TESTDBF->FIRST + Chr( 13 ) + Chr( 10 ) + ; + // TESTDBF->LAST + Chr( 13 ) + Chr( 10 ) + ; + // TESTDBF->STREET + // TESTDBF->( dbSkip() ) + // ENDDO ? TESTCDX->( RecCount() ) TESTCDX->( dbGoTop() ) - ? TESTCDX->( Eof() ) - while !TESTCDX->( Eof() ) + ? TESTCDX->( EOF() ) + WHILE !TESTCDX->( EOF() ) ? TESTCDX->( RecNo() ), TESTCDX->NUMERIC ? TESTCDX->MEMO TESTCDX->( dbSkip() ) -// ? "Press any key to continue..." -// InKey( 0 ) - end + // ? "Press any key to continue..." + // InKey( 0 ) + ENDDO FErase( "testcdx.cdx" ) - Select( "TESTCDX" ) - OrdCreate( "testcdx", "Character", "CHARACTER", FIELD->CHARACTER, .F. ) + SELECT( "TESTCDX" ) + ordCreate( "testcdx", "Character", "CHARACTER", FIELD->CHARACTER, .F. ) - -return nil \ No newline at end of file + RETURN diff --git a/harbour/tests/testcls.prg b/harbour/tests/testcls.prg index 22d9392bcd..474b798438 100644 --- a/harbour/tests/testcls.prg +++ b/harbour/tests/testcls.prg @@ -6,18 +6,19 @@ #include "hbclass.ch" -function Main() +PROCEDURE Main() - local o := Test() + LOCAL o := Test() o:Another( "Hello" ) // "Another" message is not defined for Class Test, but - // it will invoke ON ERROR MyErrorManager() method + // it will invoke ON ERROR MyErrorManager() method o:Another := 5 // Notice how __GetMessage() shows a underscored message - // as we are setting a DATA value. -return nil + // as we are setting a DATA value. -CLASS Test + RETURN + +CREATE CLASS Test ON ERROR MyErrorManager( uParam1 ) @@ -25,10 +26,10 @@ ENDCLASS METHOD MyErrorManager( uParam1 ) CLASS Test - if PCount() > 0 + IF PCount() > 0 Alert( uParam1 ) - endif + ENDIF Alert( __GetMessage() ) // Shows the message that was sent to the object -return nil + RETURN nil diff --git a/harbour/tests/testdbf.prg b/harbour/tests/testdbf.prg index eb6a678219..5f495f0e9b 100644 --- a/harbour/tests/testdbf.prg +++ b/harbour/tests/testdbf.prg @@ -2,19 +2,19 @@ * $Id$ */ -function main() +PROCEDURE Main() - local nI, aStruct := { { "CHARACTER", "C", 25, 0 }, ; - { "NUMERIC", "N", 8, 0 }, ; - { "DOUBLE", "N", 8, 2 }, ; - { "DATE", "D", 8, 0 }, ; - { "LOGICAL", "L", 1, 0 }, ; - { "MEMO1", "M", 10, 0 }, ; - { "MEMO2", "M", 10, 0 } } + LOCAL nI, aStruct := { { "CHARACTER", "C", 25, 0 }, ; + { "NUMERIC", "N", 8, 0 }, ; + { "DOUBLE", "N", 8, 2 }, ; + { "DATE", "D", 8, 0 }, ; + { "LOGICAL", "L", 1, 0 }, ; + { "MEMO1", "M", 10, 0 }, ; + { "MEMO2", "M", 10, 0 } } REQUEST DBFCDX - dbCreate( "testdbf", aStruct, "DBFCDX", .t., "MYALIAS" ) + dbCreate( "testdbf", aStruct, "DBFCDX", .T. , "MYALIAS" ) ? "[" + MYALIAS->MEMO1 + "]" ? "[" + MYALIAS->MEMO2 + "]" @@ -36,25 +36,25 @@ function main() ? "" ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) ? "" ? "Append 50 records with memos..." - for nI := 1 to 50 + FOR nI := 1 TO 50 MYALIAS->( dbAppend() ) MYALIAS->MEMO1 := "This is a very long string. " + ; - "This may seem silly however strings like this are still " + ; - "used. Not by good programmers though, but I've seen " + ; - "stuff like this used for Copyright messages and other " + ; - "long text. What is the point to all of this you'd say. " + ; - "Well I am coming to the point right now, the constant " + ; - "string is limited to 256 characters and this string is " + ; - "a lot bigger. Do you get my drift ? If there is somebody " + ; - "who has read this line upto the very end: Esto es un " + ; - "sombrero grande rid¡culo." + Chr( 13 ) + Chr( 10 ) + ; - "/" + Chr( 13 ) + Chr( 10 ) + "[;-)" + Chr( 13 ) + Chr( 10 )+ ; - "\" - next + "This may seem silly however strings like this are still " + ; + "used. Not by good programmers though, but I've seen " + ; + "stuff like this used for Copyright messages and other " + ; + "long text. What is the point to all of this you'd say. " + ; + "Well I am coming to the point right now, the constant " + ; + "string is limited to 256 characters and this string is " + ; + "a lot bigger. Do you get my drift ? If there is somebody " + ; + "who has read this line upto the very end: Esto es un " + ; + "sombrero grande rid¡culo." + Chr( 13 ) + Chr( 10 ) + ; + "/" + Chr( 13 ) + Chr( 10 ) + "[;-)" + Chr( 13 ) + Chr( 10 ) + ; + "\" + NEXT MYALIAS->( dbCommit() ) ? "Records before ZAP:", MYALIAS->( LastRec() ) @@ -71,73 +71,73 @@ function main() ? "[" + Str( MYALIAS->DOUBLE ) + "]" ? "[" + Str( MYALIAS->NUMERIC ) + "]" ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) dbCloseAll() - dbCreate( "testdbf", aStruct,, .t., "MYALIAS" ) + dbCreate( "testdbf", aStruct, , .T. , "MYALIAS" ) - for nI := 1 to 10 + FOR nI := 1 TO 10 MYALIAS->( dbAppend() ) MYALIAS->NUMERIC := nI ? "Adding a record", nI - if nI == 3 .or. nI == 7 + IF nI == 3 .OR. nI == 7 MYALIAS->( dbDelete() ) ? "Deleting record", nI - endif - next + ENDIF + NEXT MYALIAS->( dbCommit() ) ? "" ? "With SET DELETED OFF" ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) MYALIAS->( dbGoTop() ) - do while !MYALIAS->( Eof() ) + DO WHILE !MYALIAS->( EOF() ) ? MYALIAS->NUMERIC MYALIAS->( dbSkip() ) - enddo + ENDDO SET DELETED ON ? "" ? "With SET DELETED ON" ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) MYALIAS->( dbGoTop() ) - do while !MYALIAS->( Eof() ) + DO WHILE !MYALIAS->( EOF() ) ? MYALIAS->NUMERIC MYALIAS->( dbSkip() ) - enddo + ENDDO ? "" ? "With SET DELETED ON" ? "and SET FILTER TO MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) MYALIAS->( dbSetFilter( { || MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8 }, ; - "MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ) ) + "MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ) ) MYALIAS->( dbGoTop() ) - do while !MYALIAS->( Eof() ) + DO WHILE !MYALIAS->( EOF() ) ? MYALIAS->NUMERIC MYALIAS->( dbSkip() ) - enddo + ENDDO SET DELETED OFF ? "" ? "With SET DELETED OFF" ? "and SET FILTER TO MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) MYALIAS->( dbSetFilter( { || MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8 }, ; - "MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ) ) + "MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ) ) MYALIAS->( dbGoTop() ) - do while !MYALIAS->( Eof() ) + DO WHILE !MYALIAS->( EOF() ) ? MYALIAS->NUMERIC MYALIAS->( dbSkip() ) - enddo + ENDDO ? "dbFilter() => " + dbFilter() ? "" @@ -153,34 +153,33 @@ function main() ? "Size of files (data and memo):", Directory( "testdbf.dbf" )[1][2], ; Directory( "testdbf.dbt" )[1][2] ? "Press any key..." - InKey( 0 ) + Inkey( 0 ) ? "Value of fields:" MYALIAS->( dbGoTop() ) - do while !MYALIAS->( Eof() ) + DO WHILE !MYALIAS->( EOF() ) ? MYALIAS->NUMERIC MYALIAS->( dbSkip() ) - enddo + ENDDO ? "" ? "Open test.dbf and LOCATE FOR TESTDBF->SALARY > 145000" ? "Press any key..." - InKey( 0 ) - dbUseArea( ,, "test", "TESTDBF" ) - locate for TESTDBF->SALARY > 145000 - do while TESTDBF->( Found() ) + Inkey( 0 ) + dbUseArea( , , "test", "TESTDBF" ) + LOCATE for TESTDBF->SALARY > 145000 + DO WHILE TESTDBF->( Found() ) ? TESTDBF->FIRST, TESTDBF->LAST, TESTDBF->SALARY - continue - enddo + CONTINUE + ENDDO ? "" ? "LOCATE FOR TESTDBF->MARRIED .AND. TESTDBF->FIRST > 'S'" ? "Press any key..." - InKey( 0 ) - dbUseArea( ,, "test", "TESTDBF" ) - locate for TESTDBF->MARRIED .AND. TESTDBF->FIRST > 'S' - do while TESTDBF->( Found() ) + Inkey( 0 ) + dbUseArea( , , "test", "TESTDBF" ) + LOCATE for TESTDBF->MARRIED .AND. TESTDBF->FIRST > 'S' + DO WHILE TESTDBF->( Found() ) ? TESTDBF->FIRST, TESTDBF->LAST, TESTDBF->MARRIED - continue - enddo - -return nil + CONTINUE + ENDDO + RETURN diff --git a/harbour/tests/testdecl.prg b/harbour/tests/testdecl.prg index 3a6e366023..70e2c99c93 100644 --- a/harbour/tests/testdecl.prg +++ b/harbour/tests/testdecl.prg @@ -1,9 +1,12 @@ +/* + * $Id$ + */ + // Test for DECLARE statement -// $Id$ -// + #include "hbclass.ch" -#TRANSLATE AS NEW => AS CLASS := ():New() +#translate AS NEW => AS CLASS := ():New() DECLARE nMyFun() AS NUMERIC @@ -26,47 +29,47 @@ CLASS MyClass VAR cVar AS STRING END CLASS -INIT Function Main() +INIT PROCEDURE Main() - MEMVAR Var1, Var2, aVar - MEMVAR Var3, aVar5, aVar8, Var7 - LOCAL MyObj AS NEW MyClass + MEMVAR Var1, Var2, aVar + MEMVAR Var3, aVar5, aVar8, Var7 + LOCAL MyObj AS NEW MyClass - DECLARE Var1 - DECLARE Var2 := 2 - DECLARE aVar[2] - DECLARE Var3 := 'Var9', Var4, aVar5[1] - DECLARE Var6, Var7:=7, aVar8[8] - DECLARE Var9 - DECLARE &var3 - DECLARE &Var3. - DECLARE &Var3. ; DECLARE &Var3.&Var3 - DECLARE &Var3.var3 - DECLARE Var3&Var3 - DECLARE Var3&Var3. - DECLARE Var3&Var3&Var3 + DECLARE Var1 + DECLARE Var2 := 2 + DECLARE aVar[2] + DECLARE Var3 := 'Var9', Var4, aVar5[1] + DECLARE Var6, Var7:=7, aVar8[8] + DECLARE Var9 + DECLARE &var3 + DECLARE &Var3. + DECLARE &Var3. ; DECLARE &Var3.&Var3 + DECLARE &Var3.var3 + DECLARE Var3&Var3 + DECLARE Var3&Var3. + DECLARE Var3&Var3&Var3 - M->Var1 := nMyFun() - ? M->Var1 + M->Var1 := nMyFun() + ? M->Var1 - ? M->Var2 + ? M->Var2 - M->aVar[1] := 'Array Element' - ? M->aVar[1] + M->aVar[1] := 'Array Element' + ? M->aVar[1] - MyObj:cVar := 'Hello' - ? MyObj:cVar + MyObj:cVar := 'Hello' + ? MyObj:cVar - M->Var1 := MyClass():New() - ? M->Var1:While + M->Var1 := MyClass():New() + ? M->Var1:While -RETURN NIL + RETURN METHOD New() CLASS MyClass ::While := 2 // TODO: Should produce RT Error. -RETURN Self + RETURN Self -Function nMyFun() -RETURN 1 +FUNCTION nMyFun() + RETURN 1 diff --git a/harbour/tests/testerro.prg b/harbour/tests/testerro.prg index d1550bc57e..f6f2706f84 100644 --- a/harbour/tests/testerro.prg +++ b/harbour/tests/testerro.prg @@ -1,15 +1,15 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing Harbour Error system -function Main() +PROCEDURE Main() - local n + LOCAL n QOut( "We are running and now an error will raise" ) n++ // an error should raise here -return nil + RETURN diff --git a/harbour/tests/testfor.prg b/harbour/tests/testfor.prg index 6cd92be244..d275e767de 100644 --- a/harbour/tests/testfor.prg +++ b/harbour/tests/testfor.prg @@ -1,8 +1,8 @@ -// -// $Id$ -// +/* + * $Id$ + */ -PRCOEDURE MAIN +PRCOEDURE Main() LOCAL i diff --git a/harbour/tests/testget.prg b/harbour/tests/testget.prg index 9f324da42a..6fb882ea36 100644 --- a/harbour/tests/testget.prg +++ b/harbour/tests/testget.prg @@ -2,24 +2,24 @@ * $Id$ */ -Procedure Main() +PROCEDURE Main() LOCAL GetList := {}, cVar := "Hello" MEMVAR aVar, nIndex, cMacro, cEarly, cEarly2, cLate - PRIVATE aVar := { "World", "Again" }, nIndex := 1, cMacro := "cEarly", cEarly := {"Early"}, cLate := "Late!", cEarly2 := {"Early2"} + PRIVATE aVar := { "World", "Again" }, nIndex := 1, cMacro := "cEarly", cEarly := { "Early" }, cLate := "Late!", cEarly2 := { "Early2" } CLS ? "2nd GET should say 'Early'." - @ 10,10 SAY "cVar :" GET cVar PICTURE "@K!" - @ 12,10 SAY "cMacro[1] :" GET &cMacro[1] - @ 14,10 SAY "cMacro.2[1] :" GET &cMacro.2[1] - @ 16,10 SAY "cEarly[1] :" GET cEarly[1] - //@ 14,10 SAY "cMacro :" GET &(cMacro)[1] + @ 10, 10 SAY "cVar :" GET cVar PICTURE "@K!" + @ 12, 10 SAY "cMacro[1] :" GET &cMacro[1] + @ 14, 10 SAY "cMacro.2[1] :" GET &cMacro.2[1] + @ 16, 10 SAY "cEarly[1] :" GET cEarly[1] +// @ 14,10 SAY "cMacro :" GET &(cMacro)[1] nIndex := 2 - @ 18,10 SAY "aVar :" GET aVar[nIndex] - @ 20,10 SAY "Picture of GET-1:" GET GetList[1]:Picture + @ 18, 10 SAY "aVar :" GET aVar[nIndex] + @ 20, 10 SAY "Picture of GET-1:" GET GetList[1]:Picture nIndex := 3 cMacro := "cLate" READ @@ -34,5 +34,4 @@ Procedure Main() READ */ -RETURN - + RETURN diff --git a/harbour/tests/testgt.prg b/harbour/tests/testgt.prg deleted file mode 100644 index 7934d90e71..0000000000 --- a/harbour/tests/testgt.prg +++ /dev/null @@ -1,29 +0,0 @@ -// -// $Id$ -// - -/* -program for testing hbgt.lib -*/ - -function main() - -qout('gt_ascpos("Harbour",1) => ' + ltrim(str(gt_ascpos("Harbour",1))) ) -qout('gt_atdiff("This Is Harbour","This Is Clipper") => ' + ltrim(str(gt_atdiff("This Is Harbour","This Is Clipper"))) ) -qout('gt_chareven("The_Power_Of_Harbour") => ' + gt_chareven("The_Power_Of_Harbour") ) -qout('gt_charodd("The_Power_Of_Harbour") => ' + gt_charodd("The_Power_Of_Harbour") ) -qout('gt_chrcount("s","she sells shells by the sea shore") => ' + ltrim(str(gt_chrcount("s","she sells shells by the sea shore")))) -qout('gt_chrtotal("sl","she sells shells by the sea shore") => ' + ltrim(str(gt_chrtotal("sl","she sells shells by the sea shore")))) -qout('gt_charmix("CLIPPER","harbour") => ' + gt_charmix("CLIPPER","harbour") ) -qout('gt_asciisum("harbour") => ' + ltrim(str(gt_asciisum("harbour"))) ) -qout('gt_chrfirst("Ho", "the power of Harbour") => ' + ltrim(str(gt_chrfirst("Ho", "the power of Harbour"))) ) -qout('gt_strcount("the", "the cat sat on the mat") => ' + ltrim(str(gt_strcount("the", "the cat sat on the mat")))) -qout('gt_strcspn("this is a test", "as ") => ' + ltrim(str(gt_strcspn("this is a test", "as ") )) ) -qout('gt_strcspn("this is a test", "elnjpq") => ' + ltrim(str(gt_strcspn("this is a test", "elnjpq"))) ) -qout('gt_strDiff("the cat", "the rat") => ' + gt_strDiff("the cat", "the rat") ) -qout('gt_strexpand("HARBOUR", 2,"-") => ' + gt_strexpand("HARBOUR", 2,"-")) -qout('gt_strleft("this is a test", "hsit ") => ' + ltrim(str(gt_strleft("this is a test", "hsit ")) )) -qout('gt_strpbrk("this is a test", "sa ") => ' + gt_strpbrk("this is a test", "sa ") ) -qout('gt_strright("this is a test", "teas ") => ' + ltrim(str(gt_strright("this is a test", "teas "))) ) - -return nil diff --git a/harbour/tests/testhrb.prg b/harbour/tests/testhrb.prg index 5dde19db48..b47517b135 100644 --- a/harbour/tests/testhrb.prg +++ b/harbour/tests/testhrb.prg @@ -1,54 +1,55 @@ -// -// $Id$ -// +/* + * $Id$ + */ // see also exthrb.prg - #include "hbhrb.ch" -Procedure Main(x) -Local pHrb, cExe := "Msg2()", n +PROCEDURE Main( x ) - n:=iif(x==NIL,0,val(x)) + LOCAL pHrb, cExe := "Msg2()", n - ? "calling Msg ... From exe here !" - Msg() - ? "=========================" + n := iif( x == NIL, 0, Val( x ) ) -// ? "Loading('exthrb.hrb' )" -// pHrb := hb_HrbLoad("exthrb.hrb" ) + ? "calling Msg ... From exe here !" + Msg() + ? "=========================" -// ? "Loading(HB_HRB_BIND_DEFAULT,'exthrb.hrb' )" -// pHrb := hb_HrbLoad(HB_HRB_BIND_DEFAULT,"exthrb.hrb" ) + // ? "Loading('exthrb.hrb' )" + // pHrb := hb_HrbLoad("exthrb.hrb" ) -// ? "Loading(HB_HRB_BIND_LOCAL,'exthrb.hrb' )" -// pHrb := hb_HrbLoad(HB_HRB_BIND_LOCAL,"exthrb.hrb" ) + // ? "Loading(HB_HRB_BIND_DEFAULT,'exthrb.hrb' )" + // pHrb := hb_HrbLoad(HB_HRB_BIND_DEFAULT,"exthrb.hrb" ) - ? "Loading("+iif(n=0,"HB_HRB_BIND_DEFAULT",iif(n=1,"HB_HRB_BIND_LOCAL","HB_HRB_BIND_OVERLOAD"))+",'exthrb.hrb' )" - pHrb := hb_HrbLoad(n,"exthrb.hrb" ) + // ? "Loading(HB_HRB_BIND_LOCAL,'exthrb.hrb' )" + // pHrb := hb_HrbLoad(HB_HRB_BIND_LOCAL,"exthrb.hrb" ) - ? "=========================" + ? "Loading(" + iif( n = 0, "HB_HRB_BIND_DEFAULT", iif( n = 1,"HB_HRB_BIND_LOCAL","HB_HRB_BIND_OVERLOAD" ) ) + ",'exthrb.hrb' )" + pHrb := hb_hrbLoad( n, "exthrb.hrb" ) - ? "calling Msg ... DEFAULT=From exe, LOCAL=From exe, OVERLOAD=From HRB" - Msg() - ? "=========================" + ? "=========================" - ? "calling Msg ... DEFAULT=From exe, LOCAL=From HRB, OVERLOAD=From HRB" - &cExe // - ? "=========================" + ? "calling Msg ... DEFAULT=From exe, LOCAL=From exe, OVERLOAD=From HRB" + Msg() + ? "=========================" - hb_HrbUnload( pHrb ) // should do nothing in case of OVERLOAD + ? "calling Msg ... DEFAULT=From exe, LOCAL=From HRB, OVERLOAD=From HRB" + &cExe // + ? "=========================" - ? "calling Msg ... DEFAULT=From exe, LOCAL=From exe, OVERLOAD=From HRB" - Msg() // test unload protection when using OVERLOAD ... then .hrb not anymore unloadable - ? "=========================" + hb_hrbUnload( pHrb ) // should do nothing in case of OVERLOAD - ? "END" + ? "calling Msg ... DEFAULT=From exe, LOCAL=From exe, OVERLOAD=From HRB" + Msg() // test unload protection when using OVERLOAD ... then .hrb not anymore unloadable + ? "=========================" -Return + ? "END" + RETURN -Function Msg() -? "Function called from Exe" -Return .T. +FUNCTION Msg() + + ? "Function called from Exe" + + RETURN .T. diff --git a/harbour/tests/testhtml.prg b/harbour/tests/testhtml.prg index 377c07fe8f..93438c3d7b 100644 --- a/harbour/tests/testhtml.prg +++ b/harbour/tests/testhtml.prg @@ -21,8 +21,8 @@ FUNCTION Main() oHTML:SetTitle( "Harbour Power Demonstration" ) oHTML:AddHead( "Harbour" ) - oHTML:AddPara( "Harbour is xBase at its best. Have a taste today!", "LEFT" ) - oHTML:AddPara( "L i n k s", "CENTER" ) + oHTML:AddPara( "Harbour is xBase at its best. Have a taste today!", "LEFT" ) + oHTML:AddPara( "L i n k s", "CENTER" ) oHTML:AddLink( "http://harbour-project.org", "Meet the Harbour power!" ) oHTML:Generate() @@ -39,7 +39,7 @@ FUNCTION Main() /*---------------------------------------------------------------------------*/ -FUNCTION THTML +FUNCTION THTML() STATIC oClass @@ -93,7 +93,7 @@ STATIC FUNCTION AddLink( cLinkTo, cLinkName ) LOCAL Self := QSelf() ::cBody := ::cBody + ; - "" + cLinkName + "" + "" + cLinkName + "" RETURN Self @@ -106,7 +106,7 @@ STATIC FUNCTION AddHead( cDescr ) // ??? ::cBody := ::cBody + ; - "

" + cDescr + "

" + "

" + cDescr + "

" RETURN NIL @@ -114,13 +114,12 @@ STATIC FUNCTION AddPara( cPara, cAlign ) LOCAL Self := QSelf() - //Default( cAlign, "Left" ) // removed Patrick Mast 2000-06-07 - cAlign:=iif(cAlign==NIL,"Left",cAlign) //Added Patrick Mast 2000-06-17 + cAlign := iif( cAlign == NIL, "Left", cAlign ) // Added Patrick Mast 2000-06-17 ::cBody := ::cBody + ; - "

" + hb_eol() + ; + "

" + hb_eol() + ; cPara + hb_eol() + ; - "

" + "

" RETURN Self @@ -129,12 +128,12 @@ STATIC FUNCTION Generate() LOCAL Self := QSelf() ::cContent := ; - "" + hb_eol() + ; - "" + ::cTitle + "" + hb_eol() + ; - "" + hb_eol() + ; + "" + ::cTitle + "" + hb_eol() + ; + "" + + hb_eol() + ; ::cBody + hb_eol() + ; - "" + "" RETURN Self diff --git a/harbour/tests/testidle.prg b/harbour/tests/testidle.prg index 5acc8210b2..1f4c9a80a5 100644 --- a/harbour/tests/testidle.prg +++ b/harbour/tests/testidle.prg @@ -2,9 +2,7 @@ * $Id$ */ -// #include "set.ch" - Preset in pptable.c - -PROCEDURE MAIN() +PROCEDURE Main() CLS diff --git a/harbour/tests/testmem.prg b/harbour/tests/testmem.prg index 2a058bef00..d840256e6b 100644 --- a/harbour/tests/testmem.prg +++ b/harbour/tests/testmem.prg @@ -4,7 +4,7 @@ // Testing memory release -PROCEDURE main() +PROCEDURE Main() LOCAL a, b diff --git a/harbour/tests/testpers.prg b/harbour/tests/testpers.prg index 18cdb4993a..6dbc1d88ea 100644 --- a/harbour/tests/testpers.prg +++ b/harbour/tests/testpers.prg @@ -1,14 +1,15 @@ -// -// $Id$ -// +/* + * $Id$ + */ + // Class HBPersistent test #include "hbclass.ch" -function Main() +PROCEDURE Main() - local oTest := Test():New() - local oTest2 := Test2():New() + LOCAL oTest := Test():New() + LOCAL oTest2 := Test2():New() oTest:One := "hello" oTest:Two := 123 @@ -21,22 +22,22 @@ function Main() oTest:SaveToFile( "test.txt" ) // We save it to a file -return nil + RETURN -CLASS Test FROM HBPersistent +CREATE CLASS Test FROM HBPersistent - DATA One PROPERTY - DATA Two PROPERTY - DATA Three - DATA Four PROPERTY + VAR One PROPERTY + VAR Two PROPERTY + VAR Three + VAR Four PROPERTY METHOD Another() INLINE { 1, { "One", "Two" }, Date() } PROPERTY METHOD More() VIRTUAL ENDCLASS -CLASS Test2 FROM HBPersistent +CREATE CLASS Test2 FROM HBPersistent - DATA Five PROPERTY + VAR Five PROPERTY ENDCLASS diff --git a/harbour/tests/testtok.prg b/harbour/tests/testtok.prg index a0b581d592..f434bd1404 100644 --- a/harbour/tests/testtok.prg +++ b/harbour/tests/testtok.prg @@ -4,7 +4,7 @@ #include "set.ch" -PROCEDURE main() +PROCEDURE Main() LOCAL a LOCAL i diff --git a/harbour/tests/testwarn.prg b/harbour/tests/testwarn.prg index 0509df854f..28c7acc709 100644 --- a/harbour/tests/testwarn.prg +++ b/harbour/tests/testwarn.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // This file is OK to have warnings. #ifdef __HARBOUR__ @@ -55,7 +55,7 @@ MEMVAR Var1 AS STRING STATIC lGlobal AS LOGICAL -PROCEDURE MAIN( optional ) +PROCEDURE Main( optional ) STATIC lStatic := 0, oMyObj As Class WrongClass diff --git a/harbour/tests/tstalias.prg b/harbour/tests/tstalias.prg index d4b1a08ebb..2ddce4c6d5 100644 --- a/harbour/tests/tstalias.prg +++ b/harbour/tests/tstalias.prg @@ -2,12 +2,12 @@ * $Id$ */ -FUNCTION Main() +PROCEDURE Main() USE test REPLACE Age WITH 1 - ? FIELD -> Age + ? FIELD->Age //REPLACE 1->Age WITH 2 // Todo: complete support in harbour.y - AliasAddInt() //? FIELD->Age @@ -15,14 +15,14 @@ FUNCTION Main() //REPLACE 1.5->Age WITH 3 // Will produce "Invalid alias expression" //? FIELD->Age - REPLACE TEST -> Age WITH 4 - ? FIELD -> Age + REPLACE TEST->Age WITH 4 + ? FIELD->Age - TEST -> Age := 5 - ? FIELD -> Age + TEST->Age := 5 + ? FIELD->Age - TEST -> ( FieldPut( FieldPos( 'AGE' ), 6 ) ) - ? FIELD -> Age + TEST->( FieldPut( FieldPos( 'AGE' ), 6 ) ) + ? FIELD->Age dbCloseArea() @@ -31,10 +31,10 @@ FUNCTION Main() USE test // ? ("0")->FIRST - ? ( "B" ) -> FIRST - ? ( "2" ) -> FIRST - ? 2 -> FIRST - ? B -> FIRST + ? ( "B" )->FIRST + ? ( "2" )->FIRST + ? 2->FIRST + ? B->FIRST Inkey( 0 ) @@ -98,4 +98,4 @@ FUNCTION Main() ? "Z" , dbSelectArea( "Z" ), Select() ? "AA", dbSelectArea( "AA" ), Select() - RETURN NIL + RETURN diff --git a/harbour/tests/tstasort.prg b/harbour/tests/tstasort.prg index 9cd98a7b55..791ce671c2 100644 --- a/harbour/tests/tstasort.prg +++ b/harbour/tests/tstasort.prg @@ -2,7 +2,7 @@ * $Id$ */ -FUNCTION main() +PROCEDURE Main() LOCAL oError := ErrorNew() @@ -25,7 +25,7 @@ FUNCTION main() ? "Asort.c......:", aDump( ASort( t := AClone( c ) ) ) ? "Asort.c.block:", aDump( ASort( t := AClone( c ), , , {| x, y | xToStr( x ) < xToStr( y ) } ) ) - RETURN nil + RETURN FUNCTION aDump( a ) diff --git a/harbour/tests/tstblock.prg b/harbour/tests/tstblock.prg index 22a8bc2274..73c416b658 100644 --- a/harbour/tests/tstblock.prg +++ b/harbour/tests/tstblock.prg @@ -9,14 +9,14 @@ PROCEDURE Main() MEMVAR Var1, Var2, Var3, Macro PRIVATE Var1, Var2, Var3, Macro - M -> Var1 := "Var1" - M -> Var2 := "Var2" - M -> Var3 := "Var3" + M->Var1 := "Var1" + M->Var2 := "Var2" + M->Var3 := "Var3" CLS FOR i := 1 TO 3 - M -> Macro := "Var" + Str( i, 1 ) + M->Macro := "Var" + Str( i, 1 ) bBlock[ i ] := { || &Macro } NEXT @@ -27,7 +27,7 @@ PROCEDURE Main() NEXT FOR i := 1 TO 3 - M -> Macro := "Var" + Str( i, 1 ) + M->Macro := "Var" + Str( i, 1 ) bBlock[ i ] := { || &Macro + "!" } NEXT @@ -39,7 +39,7 @@ PROCEDURE Main() NEXT FOR i := 1 TO 3 - M -> Macro := "Var" + Str( i, 1 ) + M->Macro := "Var" + Str( i, 1 ) bBlock[ i ] := { || &( Macro ) } NEXT diff --git a/harbour/tests/tstdbi.prg b/harbour/tests/tstdbi.prg index efe67a7ebc..604ac32906 100644 --- a/harbour/tests/tstdbi.prg +++ b/harbour/tests/tstdbi.prg @@ -6,7 +6,7 @@ #xtranslate hb_eol() => ( Chr( 13 ) + Chr( 10 ) ) #endif -PROCEDURE main() +PROCEDURE Main() LOCAL i LOCAL cStr := "" diff --git a/harbour/tests/tstmacro.prg b/harbour/tests/tstmacro.prg index 560cd0659e..c5360aa979 100644 --- a/harbour/tests/tstmacro.prg +++ b/harbour/tests/tstmacro.prg @@ -14,41 +14,41 @@ FUNCTION Main( ) PRIVATE cVar_1, cMainPrivate := 'cVar_1', GlobalPrivate := 'BornInRunTimeVar' &cStr_1 = 'Simple ' - ? M -> cVar_1 + ? M->cVar_1 &( 'cVar' + '_1' ) := 'Macro' - ?? M -> cVar_1 + ?? M->cVar_1 - M -> &cStr_1 = 'Aliased' - ? M -> cVar_1 + M->&cStr_1 = 'Aliased' + ? M->cVar_1 - MEMVAR -> &( 'cVar' + '_1' ) := ' Macro' - ?? M -> cVar_1 + MEMVAR->&( 'cVar' + '_1' ) := ' Macro' + ?? M->cVar_1 cStr := 'cVar_' &cStr.1 = 'Concatenated Macro (Numeric)' - ? M -> cVar_1 + ? M->cVar_1 cStr := 'cVar' &cStr._1 = 'Concatenated Macro (String)' - ? M -> cVar_1 + ? M->cVar_1 &( aVar[1] ) := 'Array Macro' - ? M -> cVar_1 + ? M->cVar_1 oVar := TValue():New() oVar:cVal := 'cVar_1' &( oVar:cVal ) := 'Class Macro' - ? M -> cVar_1 + ? M->cVar_1 SubFun() - ? '"cVar_1" = [' + M -> cVar_1 + '] AFTER SubFun() PRIVATE' + ? '"cVar_1" = [' + M->cVar_1 + '] AFTER SubFun() PRIVATE' - ? M -> NewPublicVar + ? M->NewPublicVar TEST_TYPE() - + RETURN NIL FUNCTION TValue @@ -75,25 +75,25 @@ STATIC FUNCTION New() FUNCTION SubFun() - ? '"cVar_1" = [' + M -> cVar_1 + '] BEFORE SubFun() PRIVATE' + ? '"cVar_1" = [' + M->cVar_1 + '] BEFORE SubFun() PRIVATE' // Testing conflict with KEY WORDS PRIVATE PRIVATE := 'I am a Var named PRIVATE ', &cMainPrivate, SomeVar, OtherVar := 1, &GlobalPrivate := 'I was born in Run Time' PUBLIC PUBLIC := 'NewPublicVar' PUBLIC &PUBLIC - ? M -> NewPublicVar + ? M->NewPublicVar - M -> NewPublicVar := 'Still Alive because I am PUBLIC' + M->NewPublicVar := 'Still Alive because I am PUBLIC' - ? M -> PRIVATE + PRIVATE - ? PRIVATE + M -> PRIVATE + ? M->PRIVATE + PRIVATE + ? PRIVATE + M->PRIVATE ? BornInRunTimeVar &cMainPrivate := 'In SubFun()' - ? '"cVar_1" = [' + M -> cVar_1 + '] in SubFun() PRIVATE' + ? '"cVar_1" = [' + M->cVar_1 + '] in SubFun() PRIVATE' RETURN NIL diff --git a/harbour/tests/varparam.prg b/harbour/tests/varparam.prg index 01f9b62e69..48f08ee480 100644 --- a/harbour/tests/varparam.prg +++ b/harbour/tests/varparam.prg @@ -1,12 +1,15 @@ -// -// $Id$ -// +/* + * $Id$ + */ + /* TEST FOR USING VARIABLE NUMBER OF PARAMETERS */ MEMVAR iLoop -PROCEDURE MAIN(p1, p2) -LOCAL l1:=11,l2:=22,l3:=33,l4:=44,l5:=55,l6:=66 -PRIVATE iLoop + +PROCEDURE Main( p1, p2 ) + + LOCAL l1 := 11, l2 := 22, l3 := 33, l4 := 44, l5 := 55, l6 := 66 + PRIVATE iLoop ? 'passed 0: '; TEST_0_0( ) ? 'passed 1: '; TEST_0_0( 1 ) @@ -125,201 +128,210 @@ PRIVATE iLoop PROCEDURE TEST_0_0v( ... ) - ?? PROCNAME(0), ' received: ', PCOUNT() - FOR m->iLoop:=1 TO PCOUNT() - ? m->iLoop, "=", HB_PVALUE( m->iLoop ) + ?? ProcName( 0 ), ' received: ', PCount() + FOR m->iLoop := 1 TO PCount() + ? m->iLoop, "=", hb_PValue( m->iLoop ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN PROCEDURE TEST_0_0( ) - ?? PROCNAME(0), ' received: ', PCOUNT() - FOR m->iLoop:=1 TO PCOUNT() - ? m->iLoop, "=", HB_PVALUE( m->iLoop ) + ?? ProcName( 0 ), ' received: ', PCount() + FOR m->iLoop := 1 TO PCount() + ? m->iLoop, "=", hb_PValue( m->iLoop ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN PROCEDURE TEST_1_0v( ... ) -LOCAL i:='i' - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'i=',i - FOR i:=1 TO PCOUNT() - ? i, "=", HB_PVALUE( i ) + LOCAL i := 'i' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'i=', i + FOR i := 1 TO PCount() + ? i, "=", hb_PValue( i ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN PROCEDURE TEST_1_0( ) -LOCAL i:='i' - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'i=',i - FOR i:=1 TO PCOUNT() - ? i, "=", HB_PVALUE( i ) - NEXT - - inkey(0) + LOCAL i := 'i' -RETURN - -PROCEDURE TEST_1_3v( a,b,c, ... ) -LOCAL i:='i' - - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'i=',i - ? 'a=',a - ? 'b=',b - ? 'c=',c - FOR i:=1 TO PCOUNT() - ? i, "=", HB_PVALUE( i ) + ?? ProcName( 0 ), ' received: ', PCount() + ? 'i=', i + FOR i := 1 TO PCount() + ? i, "=", hb_PValue( i ) NEXT - FOR EACH i IN HB_APARAMS() + Inkey( 0 ) + + RETURN + +PROCEDURE TEST_1_3v( a, b, c, ... ) + + LOCAL i := 'i' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'i=', i + ? 'a=', a + ? 'b=', b + ? 'c=', c + FOR i := 1 TO PCount() + ? i, "=", hb_PValue( i ) + NEXT + + FOR EACH i IN hb_AParams() ? i:__enumindex, "-", i - NEXT - - inkey(0) - -RETURN - - -PROCEDURE TEST_1_3( a,b,c ) -LOCAL i:='i' - - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'i=',i - ? 'a=',a - ? 'b=',b - ? 'c=',c - FOR i:=1 TO PCOUNT() - ? i, "=", HB_PVALUE( i ) NEXT - FOR EACH i IN HB_APARAMS() + Inkey( 0 ) + + RETURN + +PROCEDURE TEST_1_3( a, b, c ) + + LOCAL i := 'i' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'i=', i + ? 'a=', a + ? 'b=', b + ? 'c=', c + FOR i := 1 TO PCount() + ? i, "=", hb_PValue( i ) + NEXT + + FOR EACH i IN hb_AParams() ? i:__enumindex, "-", i - NEXT - - inkey(0) + NEXT -RETURN + Inkey( 0 ) + RETURN PROCEDURE TEST_1_1( a ) -LOCAL i:='i' - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'i=',i - ? 'a=',a - FOR i:=1 TO PCOUNT() - ? i, "=", HB_PVALUE( i ) + LOCAL i := 'i' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'i=', i + ? 'a=', a + FOR i := 1 TO PCount() + ? i, "=", hb_PValue( i ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN PROCEDURE TEST_1_1v( a, ... ) -LOCAL i:='i' - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'i=',i - ? 'a=',a - FOR i:=1 TO PCOUNT() - ? i, "=", HB_PVALUE( i ) + LOCAL i := 'i' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'i=', i + ? 'a=', a + FOR i := 1 TO PCount() + ? i, "=", hb_PValue( i ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) -PROCEDURE TEST_3_3v( a,b,c, ... ) -LOCAL x:='x', y:='y', z:='z' + RETURN - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'x=',x - ? 'y=',y - ? 'z=',z - ? 'a=',a - ? 'b=',b - ? 'c=',c - FOR m->iLoop:=1 TO PCOUNT() - ? m->iLoop, "=", HB_PVALUE( m->iLoop ) - NEXT - - test_ref( @a, @b, @c, @x, @y, @z ) - - inkey(0) +PROCEDURE TEST_3_3v( a, b, c, ... ) -RETURN + LOCAL x := 'x', y := 'y', z := 'z' -PROCEDURE TEST_3_3( a,b,c ) -LOCAL x:='x', y:='y', z:='z' - - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'x=',x - ? 'y=',y - ? 'z=',z - ? 'a=',a - ? 'b=',b - ? 'c=',c - FOR m->iLoop:=1 TO PCOUNT() - ? m->iLoop, "=", HB_PVALUE( m->iLoop ) + ?? ProcName( 0 ), ' received: ', PCount() + ? 'x=', x + ? 'y=', y + ? 'z=', z + ? 'a=', a + ? 'b=', b + ? 'c=', c + FOR m->iLoop := 1 TO PCount() + ? m->iLoop, "=", hb_PValue( m->iLoop ) NEXT test_ref( @a, @b, @c, @x, @y, @z ) - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN + +PROCEDURE TEST_3_3( a, b, c ) + + LOCAL x := 'x', y := 'y', z := 'z' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'x=', x + ? 'y=', y + ? 'z=', z + ? 'a=', a + ? 'b=', b + ? 'c=', c + FOR m->iLoop := 1 TO PCount() + ? m->iLoop, "=", hb_PValue( m->iLoop ) + NEXT + + test_ref( @a, @b, @c, @x, @y, @z ) + + Inkey( 0 ) + + RETURN PROCEDURE TEST_3_0( ) -LOCAL x:='x', y:='y', z:='z' - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'x=',x - ? 'y=',y - ? 'z=',z - FOR m->iLoop:=1 TO PCOUNT() - ? m->iLoop, "=", HB_PVALUE( m->iLoop ) + LOCAL x := 'x', y := 'y', z := 'z' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'x=', x + ? 'y=', y + ? 'z=', z + FOR m->iLoop := 1 TO PCount() + ? m->iLoop, "=", hb_PValue( m->iLoop ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN PROCEDURE TEST_3_0v( ... ) -LOCAL x:='x', y:='y', z:='z' - ?? PROCNAME(0), ' received: ', PCOUNT() - ? 'x=',x - ? 'y=',y - ? 'z=',z - FOR m->iLoop:=1 TO PCOUNT() - ? m->iLoop, "=", HB_PVALUE( m->iLoop ) + LOCAL x := 'x', y := 'y', z := 'z' + + ?? ProcName( 0 ), ' received: ', PCount() + ? 'x=', x + ? 'y=', y + ? 'z=', z + FOR m->iLoop := 1 TO PCount() + ? m->iLoop, "=", hb_PValue( m->iLoop ) NEXT - - inkey(0) -RETURN + Inkey( 0 ) + + RETURN PROCEDURE TEST_REF( a, ... ) -LOCAL b + + LOCAL b ? '@@@' - ? PROCNAME(0), ' received: ', PCOUNT() + ? ProcName( 0 ), ' received: ', PCount() ? 'a= ', a ? 'b= ', b - FOR EACH b IN HB_APARAMS(0) + FOR EACH b IN hb_AParams( 0 ) ? b:__enumindex, "-", b - NEXT + NEXT -RETURN \ No newline at end of file + RETURN diff --git a/harbour/tests/wvt_fs.prg b/harbour/tests/wvt_fs.prg index 6e96dc2af3..5a040f050e 100644 --- a/harbour/tests/wvt_fs.prg +++ b/harbour/tests/wvt_fs.prg @@ -5,7 +5,7 @@ #include "hbgtinfo.ch" #include "inkey.ch" -PROCEDURE MAIN() +PROCEDURE Main() LOCAL cGt cGt := HB_GtVersion( 0 )