From 10aaae71c24a23db92162ee8b72ced61bfef7318 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 11 Sep 2011 11:02:02 +0000 Subject: [PATCH] 2011-09-11 13:00 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbformat/hbfmtcls.prg ! fixed casing of some function names. * utils/hbmk2/hbmk2.prg ; all changes below apply to .xhp (xMate) to .hbp conversion: ! properly convert input filenames with spaces in them ! remove lib prefix from .a input filenames % do not add empty -L options * do not add include paths with %HB_INSTALL%\ in them + split non-portable, Borland-specific include path lists concatenated with ';' into distinct -I options % do not add empty include paths * tests/testop.prg * tests/testntx.prg * tests/vmasort.prg * tests/testlbl.prg * tests/testidle.prg * tests/videotst.prg * tests/testmem.prg * tests/testinit.prg * tests/testhtml.prg * tests/tstcolor.prg * tests/vidtest.prg * tests/tstuse.prg * tests/vec1.prg * tests/while.prg * tests/tstdspac.prg * tests/version.prg * tests/testpre.prg * tests/tstprag.prg * formatted. mostly with hbformat. --- harbour/ChangeLog | 34 +++ harbour/contrib/hbformat/hbfmtcls.prg | 2 +- harbour/tests/testhtml.prg | 6 +- harbour/tests/testidle.prg | 10 +- harbour/tests/testinit.prg | 8 +- harbour/tests/testlbl.prg | 12 +- harbour/tests/testmem.prg | 16 +- harbour/tests/testntx.prg | 101 ++++----- harbour/tests/testop.prg | 46 ++-- harbour/tests/testpre.prg | 62 +++--- harbour/tests/tstcolor.prg | 29 ++- harbour/tests/tstdspac.prg | 46 ++-- harbour/tests/tstprag.prg | 28 ++- harbour/tests/tstuse.prg | 76 ++++--- harbour/tests/vec1.prg | 10 +- harbour/tests/version.prg | 7 +- harbour/tests/videotst.prg | 117 +++++----- harbour/tests/vidtest.prg | 304 ++++++++++++++------------ harbour/tests/vmasort.prg | 132 +++++------ harbour/tests/while.prg | 16 +- harbour/utils/hbmk2/hbmk2.prg | 39 +++- 21 files changed, 593 insertions(+), 508 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b0b6ac0687..a6c913d931 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,40 @@ The license applies to all entries newer than 2009-04-28. */ +2011-09-11 13:00 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbformat/hbfmtcls.prg + ! fixed casing of some function names. + + * utils/hbmk2/hbmk2.prg + ; all changes below apply to .xhp (xMate) to .hbp conversion: + ! properly convert input filenames with spaces in them + ! remove lib prefix from .a input filenames + % do not add empty -L options + * do not add include paths with %HB_INSTALL%\ in them + + split non-portable, Borland-specific include path lists + concatenated with ';' into distinct -I options + % do not add empty include paths + + * tests/testop.prg + * tests/testntx.prg + * tests/vmasort.prg + * tests/testlbl.prg + * tests/testidle.prg + * tests/videotst.prg + * tests/testmem.prg + * tests/testinit.prg + * tests/testhtml.prg + * tests/tstcolor.prg + * tests/vidtest.prg + * tests/tstuse.prg + * tests/vec1.prg + * tests/while.prg + * tests/tstdspac.prg + * tests/version.prg + * tests/testpre.prg + * tests/tstprag.prg + * formatted. mostly with hbformat. + 2011-09-08 22:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/src/rtl/gtxwc/gtxwc.h * harbour/src/rtl/gtxwc/gtxwc.c diff --git a/harbour/contrib/hbformat/hbfmtcls.prg b/harbour/contrib/hbformat/hbfmtcls.prg index 29ff5f1d15..e87bfd8ea6 100644 --- a/harbour/contrib/hbformat/hbfmtcls.prg +++ b/harbour/contrib/hbformat/hbfmtcls.prg @@ -181,7 +181,7 @@ METHOD New( aParams, cIniName ) CLASS HBFORMATCODE "Array,Asc,AScan,ASize,ASort,At,Bin2I,Bin2L,Bin2W,Bof,Browse,CDow,Chr,CMonth,Col,CToD,CurDir," +; "Date,Day,dbAppend,dbClearFil,dbClearInd,dbCloseAll,dbCloseArea,dbCommit,dbCreate,dbDelete,dbEdit,dbEval,Dbf,dbFilter,dbGoBottom,dbGoto,dbRecall,dbReindex,dbRelation,dbRLock,dbRSelect,dbRunLock," +; "dbSeek,dbSelectArea,dbSetDriver,dbSetFilter,dbSetIndex,dbSetOrder,dbSetRelat,dbSkip,dbStruct,dbUnlock,dbUseArea,Deleted,Descend,DevOut,DevPos," +; - "Directory,DiskSpace,DispBegin,DispBox,DispCount,DispEnd,DispOut,DosError,Dow,Dtoc,Dtos,Empty,Eof,ErrorBlock,ErrorLevel,Eval,Exp,FClose,FCount,FCreate,FErase,FError,FieldBlock,FieldGet,FieldName," +; + "Directory,DiskSpace,DispBegin,DispBox,DispCount,DispEnd,DispOut,DosError,Dow,DToC,DToS,Empty,Eof,ErrorBlock,ErrorLevel,Eval,Exp,FClose,FCount,FCreate,FErase,FError,FieldBlock,FieldGet,FieldName," +; "FieldPos,FieldPut,FieldWBlock,File,FkLabel,FkMax,FLock,FOpen,Found,FRead,FReadStr,FRename,FSeek,FWrite,GetEnv,HardCR,Header,iif,IndexExt,IndexKey,IndexOrd,Inkey,Int,IsAlpha,ISARRAY,ISCHARACTER," +; "ISDATE,IsDigit,ISLOGICAL,IsLower,ISNUMBER,IsPrinter,IsUpper,I2Bin,L2Bin,LastKey,LastRec,Left,Len,Lower,LTrim,LUpdate,MakeDir,Max,MaxCol,MaxRow,MCol,MemoEdit,MemoLine,MemoRead," +; "Memory,MemoTran,MemoWrite,MemVarBlock,Min,MLCount,MLCToPos,MLPos,Mod,Month,MPosToLC,NetErr,NetName,NextKey,NoSnow,OS,OrdBagExt,OrdBagName,OrdCreate,OrdDestroy,OrdFor,OrdKey,OrdListAdd," +; diff --git a/harbour/tests/testhtml.prg b/harbour/tests/testhtml.prg index e19f9d7b96..973d57803e 100644 --- a/harbour/tests/testhtml.prg +++ b/harbour/tests/testhtml.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ /* * diff --git a/harbour/tests/testidle.prg b/harbour/tests/testidle.prg index 121cd833ba..5acc8210b2 100644 --- a/harbour/tests/testidle.prg +++ b/harbour/tests/testidle.prg @@ -8,19 +8,19 @@ PROCEDURE MAIN() CLS - ? "DEFAULT IDLEREPEAT =", SET( _SET_IDLEREPEAT ) + ? "DEFAULT IDLEREPEAT =", Set( _SET_IDLEREPEAT ) ? ? "Idle Block should be displayed multiple times until key or 10 seconds elapsed!" ? "Press any key to begin..." ? - Inkey(0) + Inkey( 0 ) - HB_IDLEADD( {|| QOut( "Idle Block" ) } ) + hb_idleAdd( {|| QOut( "Idle Block" ) } ) Inkey( 2 ) SET( _SET_IDLEREPEAT, .F. ) - HB_IDLEADD( {|| QOut( "Idle Block2" ) } ) + hb_idleAdd( {|| QOut( "Idle Block2" ) } ) CLS ? "Idle Block & Block-2 should display ONCE! while waitning for key or 10 seconds elapsed!" @@ -33,4 +33,4 @@ PROCEDURE MAIN() Inkey( 2 ) ? -RETURN + RETURN diff --git a/harbour/tests/testinit.prg b/harbour/tests/testinit.prg index 0908a3f08e..bee841cca6 100644 --- a/harbour/tests/testinit.prg +++ b/harbour/tests/testinit.prg @@ -4,12 +4,12 @@ INIT PROCEDURE Init() - ? "In Init" + ? "In Init" -RETURN + RETURN -PROCEDURE MAIN() +PROCEDURE Main() ? "Should NEVER see this message!!!" -RETURN + RETURN diff --git a/harbour/tests/testlbl.prg b/harbour/tests/testlbl.prg index 84ced90d0f..2ac713eb49 100644 --- a/harbour/tests/testlbl.prg +++ b/harbour/tests/testlbl.prg @@ -2,12 +2,12 @@ * $Id$ */ -FUNCTION MAIN() - - USE test New +PROCEDURE Main() - LABEL FORM test + USE test NEW - USE + LABEL FORM test -RETURN NIL + USE + + RETURN diff --git a/harbour/tests/testmem.prg b/harbour/tests/testmem.prg index 6d2200ebde..2a058bef00 100644 --- a/harbour/tests/testmem.prg +++ b/harbour/tests/testmem.prg @@ -1,14 +1,14 @@ -// -// $Id$ -// +/* + * $Id$ + */ // Testing memory release -function main() - local a, b +PROCEDURE main() - a := "Hello" - b := 2 + LOCAL a, b -return nil + a := "Hello" + b := 2 + RETURN diff --git a/harbour/tests/testntx.prg b/harbour/tests/testntx.prg index c96340d11c..f95d21e32b 100644 --- a/harbour/tests/testntx.prg +++ b/harbour/tests/testntx.prg @@ -2,72 +2,73 @@ * $Id$ */ -function main -Local i:=0, block -Field Last, First +PROCEDURE Main() - Use test - Index On Left( Last,8 )+Left( First,8 ) To test1 - Index On Left( Last,8 ) To test2 - Index On Last To test3 - Set Index To test1, test2, test3 - - set order to 1 - ? indexkey() - inkey(0) - Go Top - Do While !Eof() + LOCAL i := 0, block + FIELD Last, First + + USE test + INDEX ON Left( Last, 8 ) + Left( First, 8 ) TO test1 + INDEX ON Left( Last, 8 ) TO test2 + INDEX ON Last TO test3 + SET INDEX TO test1, test2, test3 + + SET ORDER TO 1 + ? IndexKey() + Inkey( 0 ) + GO TOP + DO WHILE !Eof() ? ++i, Last, First - skip - Enddo + SKIP + ENDDO ? "------------" - inkey(0) - skip -1 + Inkey( 0 ) + SKIP -1 - Do While !Bof() - ? i--, Last, First - skip -1 - Enddo + DO WHILE !Bof() + ? i-- , Last, First + SKIP -1 + ENDDO i := 0 - set order to 2 - ? indexkey() - inkey(0) - Go Top - Do While !Eof() + SET ORDER TO 2 + ? IndexKey() + Inkey( 0 ) + GO TOP + DO WHILE !Eof() ? ++i, Last, First - skip - Enddo + SKIP + ENDDO ? "------------" - inkey(0) - skip -1 + Inkey( 0 ) + SKIP -1 - Do While !Bof() - ? i--, Last, First - skip -1 - Enddo + DO WHILE !Bof() + ? i-- , Last, First + SKIP -1 + ENDDO i := 0 - set order to 3 - ? indexkey() - inkey(0) - Go Top - Do While !Eof() + SET ORDER TO 3 + ? IndexKey() + Inkey( 0 ) + GO TOP + DO WHILE !Eof() ? ++i, Last, First - skip - Enddo + SKIP + ENDDO ? "------------" - inkey(0) - skip -1 + Inkey( 0 ) + SKIP -1 - Do While !Bof() - ? i--, Last, First - skip -1 - Enddo + DO WHILE !Bof() + ? i-- , Last, First + SKIP -1 + ENDDO - Use + USE -return Nil + RETURN diff --git a/harbour/tests/testop.prg b/harbour/tests/testop.prg index 16def8e23e..730024a207 100644 --- a/harbour/tests/testop.prg +++ b/harbour/tests/testop.prg @@ -59,26 +59,26 @@ //----------------------------------------------------------------------------// -function Main() +PROCEDURE Main() - local oCar := TCar():New( "red", 2 ) - local oPetrol + LOCAL oCar := TCar():New( "red", 2 ) + LOCAL oPetrol - oCar = oCar + oPetrol + oCar := oCar + oPetrol -return nil + RETURN //----------------------------------------------------------------------------// -CLASS TCar +CREATE CLASS TCar - DATA cColor - DATA nDoors - DATA oGas + VAR cColor + VAR nDoors + VAR oGas METHOD New( cColor, nDoors ) CONSTRUCTOR - METHOD Sum( oObject ) OPERATOR '+' + METHOD SUM( oObject ) OPERATOR '+' ENDCLASS @@ -86,25 +86,25 @@ ENDCLASS METHOD New( cColor, nDoors ) CLASS TCar - if cColor == nil - cColor = "White" - endif - if nDoors == nil - nDoors = 4 - endif + IF cColor == NIL + cColor := "White" + ENDIF + IF nDoors == NIL + nDoors := 4 + ENDIF - ::cColor = cColor - ::nDoors = nDoors + ::cColor := cColor + ::nDoors := nDoors -return Self + RETURN Self //----------------------------------------------------------------------------// -METHOD Sum( oObject ) CLASS TCar +METHOD SUM( oObject ) CLASS TCar Alert( "+ has a special meaning and " + ; - "functionality for TCar Class objects!!!" ) + "functionality for TCar Class objects!!!" ) -return nil + RETURN NIL -//----------------------------------------------------------------------------// \ No newline at end of file +//----------------------------------------------------------------------------// diff --git a/harbour/tests/testpre.prg b/harbour/tests/testpre.prg index 3e171d7c1d..db7e7bfcec 100644 --- a/harbour/tests/testpre.prg +++ b/harbour/tests/testpre.prg @@ -9,44 +9,44 @@ FUNCTION Main() CLS - qOut( "Testing Harbour run-time preprocessing" ) - qOut( "======================================" ) - qOut( "" ) + QOut( "Testing Harbour run-time preprocessing" ) + QOut( "======================================" ) + QOut( "" ) cString := "@ 10, 10 SAY 'Hello!'" - qOut( cString ) - qOut( __Preprocess( cString ) ) - qOut( "" ) + QOut( cString ) + QOut( __Preprocess( cString ) ) + QOut( "" ) cString := "? 'Hello mom'" - qOut( cString ) - qOut( __Preprocess( cString ) ) - qOut( "" ) + QOut( cString ) + QOut( __Preprocess( cString ) ) + QOut( "" ) cString := 'SET RELATION TO Something INTO MySelf' - qOut( cString ) - qOut( __Preprocess( cString ) ) - qOut( "" ) + QOut( cString ) + QOut( __Preprocess( cString ) ) + QOut( "" ) cString := 'SET RELATION ADDITIVE TO Something INTO YourSelf' - qOut( cString ) - qOut( __Preprocess( cString ) ) - qOut( "" ) + QOut( cString ) + QOut( __Preprocess( cString ) ) + QOut( "" ) cString := "#xcommand DEFAULT := => IF == NIL ; := ; END" - qOut( cString ) + QOut( cString ) IF __ppAddRule( cString ) - qOut( "Rule added successfully !" ) + QOut( "Rule added successfully !" ) ELSE - qOut( "Rule addition failed ..." ) + QOut( "Rule addition failed ..." ) ENDIF cString := 'DEFAULT x := 100' - qOut( cString ) - qOut( __Preprocess( cString ) ) - qOut( "" ) + QOut( cString ) + QOut( __Preprocess( cString ) ) + QOut( "" ) - qOut( "Press ..." ) + QOut( "Press ..." ) __Accept( "" ) CLS @@ -62,22 +62,22 @@ FUNCTION Main() 'CLOSE ALL' } FOR j := 1 TO 2 - qOut( iif( j = 1, "Before", "After" ) + " __Preprocess()" ) - qOut( "===================" ) - qOut( "" ) - FOR i := 1 TO len( aScript ) + QOut( iif( j = 1, "Before", "After" ) + " __Preprocess()" ) + QOut( "===================" ) + QOut( "" ) + FOR i := 1 TO Len( aScript ) - ? iif( j = 1, aScript[i], __Preprocess( aScript[i] ) ) + ? iif( j = 1, aScript[ i ], __Preprocess( aScript[ i ] ) ) NEXT - qOut( "" ) - qOut( "Press key..." ) + QOut( "" ) + QOut( "Press key..." ) __Accept( "" ) CLS NEXT RETURN NIL -Exit PROCEDURE ExitTest +EXIT PROCEDURE ExitTest() __PP_Free() -Return + RETURN diff --git a/harbour/tests/tstcolor.prg b/harbour/tests/tstcolor.prg index 41e861b43c..88ef295610 100644 --- a/harbour/tests/tstcolor.prg +++ b/harbour/tests/tstcolor.prg @@ -1,9 +1,7 @@ -// -// $Id$ -// +/* + * $Id$ + */ -// -// tstColor // // This program demonstrates that setColor() works with // Set( _SET_COLOR ) and also that the internal representation @@ -21,31 +19,32 @@ #include "color.ch" #include "set.ch" -proc main - Local cColor := "r+/bg*,rg*/ng+,w/n,b+/w,rg/b,w+/n*" +PROCEDURE Main() - ? "original set ", set(_SET_COLOR ) - ? "should match ", setColor( cColor ) + LOCAL cColor := "r+/bg*,rg*/ng+,w/n,b+/w,rg/b,w+/n*" + + ? "original set ", Set( _SET_COLOR ) + ? "should match ", SetColor( cColor ) ? "input 1 ", cColor - ? "return ", setColor("1/7,9/15") + ? "return ", SetColor( "1/7,9/15" ) ? "input 2 ", "1/7,9/15" - ? "return ", setColor() - ? "final set ", set(_SET_COLOR ) + ? "return ", SetColor() + ? "final set ", Set( _SET_COLOR ) - SetColor("BG/N, N/BG") + SetColor( "BG/N, N/BG" ) ? "Hello1" ColorSelect( CLR_ENHANCED ) ? "Hello2" ColorSelect( CLR_STANDARD ) ? "Hello3" ColorSelect( CLR_ENHANCED ) - SetColor("GR/N, N/GR") + SetColor( "GR/N, N/GR" ) ? "Hello4" ColorSelect( CLR_ENHANCED ) ? "Hello5" ColorSelect( CLR_STANDARD ) ? "Hello6" - SetColor("B/N, N/B") + SetColor( "B/N, N/B" ) ? "Hello7" RETURN diff --git a/harbour/tests/tstdspac.prg b/harbour/tests/tstdspac.prg index c6c35ed5e6..06bd0eed97 100644 --- a/harbour/tests/tstdspac.prg +++ b/harbour/tests/tstdspac.prg @@ -1,37 +1,37 @@ /* + * $Id$ + */ - $Id$ +/* + This program demonstrates that the 4 diskspace related functions work + correctly for disks of any size. - tstdspac + Certain os's may allow limits to the amount of disk space available to + a user. If that is the case, you should see a difference between + the return value of DiskSpace() and DiskFree(). - This program demonstrates that the 4 diskspace related functions work - correctly for disks of any size. + Currently, Disk quota's are only implimented for NT. - Certain os's may allow limits to the amount of disk space available to - a user. If that is the case, you should see a difference between - the return value of DiskSpace() and DiskFree(). + NOTE: Unlike Clipper, these functions return a floating point number! - Currently, Disk quota's are only implimented for NT. + Written by Paul Tucker {ptucker@sympatico.ca> + www - http://harbour-project.org - NOTE: Unlike Clipper, these functions return a floating point number! - - Written by Paul Tucker {ptucker@sympatico.ca> - www - http://harbour-project.org - - This test program placed in the public domain + This test program placed in the public domain */ #include "fileio.ch" -proc main( cDisk ) - if empty( cDisk ) +PROCEDURE Main( cDisk ) + + IF Empty( cDisk ) cDisk := "0" - Endif - cDisk := Val( cDisk ) + ENDIF + cDisk := Val( cDisk ) -? "Bytes available on disk: " + Transform( diskspace(cDisk, HB_DISK_FREE ),"999,999,999,999") -? "Bytes available for use: " + Transform( diskspace(cDisk, HB_DISK_AVAIL ),"999,999,999,999") -? " Bytes used: " + Transform( diskspace(cDisk, HB_DISK_USED ),"999,999,999,999") -? " Total bytes on disk "+PadL(cDisk,2)+": " + Transform( diskspace(cDisk, HB_DISK_TOTAL ),"999,999,999,999") + ? "Bytes available on disk: " + Transform( DiskSpace( cDisk, HB_DISK_FREE ), "999,999,999,999" ) + ? "Bytes available for use: " + Transform( DiskSpace( cDisk, HB_DISK_AVAIL ), "999,999,999,999" ) + ? " Bytes used: " + Transform( DiskSpace( cDisk, HB_DISK_USED ), "999,999,999,999" ) + ? " Total bytes on disk " + PadL( cDisk, 2 ) + ": " + Transform( DiskSpace( cDisk, HB_DISK_TOTAL ), "999,999,999,999" ) - return + RETURN diff --git a/harbour/tests/tstprag.prg b/harbour/tests/tstprag.prg index 728877d23c..ccac0badd5 100644 --- a/harbour/tests/tstprag.prg +++ b/harbour/tests/tstprag.prg @@ -6,31 +6,39 @@ #pragma TracePragmas=On #pragma ExitSeverity=1 -/* Unknow pragmas will be ignored silently */ +/* Unknown pragmas will be ignored silently */ #pragma BadPragma=off #pragma /Y+ -function Main() +FUNCTION Main() #pragma Shortcut=On + #pragma Shortcut= Off + #pragma Shortcut = On + #pragma Shortcut(OFF) + #pragma Shortcut( On) + #pragma Shortcut( OFF ) + #pragma Shortcut( On ) + #pragma Shortcut( OFF ) + #pragma Shortcut( ON -/* or #pragma /Z+ */ + /* or #pragma /Z+ */ - if .t. .and. .f. - ? "Always" - endif + IF .T. .AND. .F. + ? "Always" + ENDIF - if .f. .and. .t. - ? "Never" - endif + IF .F. .AND. .T. + ? "Never" + ENDIF #pragma /Z- /* or #pragma Shortcut=Off */ @@ -46,4 +54,4 @@ function Main() /* Pragmas with bad values will cause an error */ #pragma WarningLevel=8 -return nil + RETURN NIL diff --git a/harbour/tests/tstuse.prg b/harbour/tests/tstuse.prg index ea8274ac62..67b957fbe3 100644 --- a/harbour/tests/tstuse.prg +++ b/harbour/tests/tstuse.prg @@ -2,47 +2,53 @@ * $Id$ */ -#define EOL chr(13)+chr(10) -#command ? [] => outstd(EOL)[;outstd()] -proc main() - ? OS(), VERSION() - if !file("_tst.dbf") - dbCreate("_tst",{{"F1","C",1,0}}) - endif - if !file("_tst2.dbf") - dbCreate("_tst2",{{"F1","C",1,0}}) - endif +#define EOL Chr( 13 ) + Chr( 10 ) +#command ? [] => OutStd( EOL )[;OutStd( )] + +PROCEDURE Main() + + ? OS(), Version() + IF ! hb_FileExists( "_tst.dbf" ) + dbCreate( "_tst", { { "F1","C",1,0 } } ) + ENDIF + IF ! hb_FileExists( "_tst2.dbf" ) + dbCreate( "_tst2", { { "F1","C",1,0 } } ) + ENDIF USE _tst NEW ALIAS "ONE" EXCLUSIVE - ? select(), alias(), netErr(), used() + ? Select(), Alias(), NetErr(), Used() ? - mkTest( .T., "NORDD",, "TWO", .T., .F. ) - mkTest( .T., "DBF",, "TWO", .T., .F. ) - mkTest( .T., "DBF", "", "TWO", .T., .F. ) - mkTest( .T., "DBF", "nofile", "TWO", .T., .F. ) - mkTest( .T., "DBF", "_tst2", "ONE", .T., .F. ) - mkTest( .T., "DBF", "_tst", "ONE", .T., .F. ) - mkTest( .T., "DBF", "_tst", "TWO", .T., .F. ) + mkTest( .T. , "NORDD", , "TWO", .T. , .F. ) + mkTest( .T. , "DBF", , "TWO", .T. , .F. ) + mkTest( .T. , "DBF", "", "TWO", .T. , .F. ) + mkTest( .T. , "DBF", "nofile", "TWO", .T. , .F. ) + mkTest( .T. , "DBF", "_tst2", "ONE", .T. , .F. ) + mkTest( .T. , "DBF", "_tst", "ONE", .T. , .F. ) + mkTest( .T. , "DBF", "_tst", "TWO", .T. , .F. ) ? - dbUseArea( .T., "DBF", "_tst", "ONE", .T., .F. ) - ? select(), alias(), netErr(), used() - dbUseArea( .T., "DBF", "_tst", "TWO", .T., .F. ) - ? select(), alias(), netErr(), used() + dbUseArea( .T. , "DBF", "_tst", "ONE", .T. , .F. ) + ? Select(), Alias(), NetErr(), Used() + dbUseArea( .T. , "DBF", "_tst", "TWO", .T. , .F. ) + ? Select(), Alias(), NetErr(), Used() ? dbSelectArea( 1 ) - mkTest( .F., "NORDD",, "TWO", .T., .F. ) + mkTest( .F. , "NORDD", , "TWO", .T. , .F. ) ? -return -proc mkTest( lNewArea, cRdd, cFile, cAlias, lShared, lReadOnly ) -local cbErr:=errorBlock({|oErr|break(oErr)}), oErr -netErr(.f.) -begin sequence - dbUseArea( lNewArea, cRdd, cFile, cAlias, lShared, lReadOnly ) -recover using oErr - ? "Error:", oErr:subCode, oErr:description, oErr:operation, oErr:osCode -end -? select(), alias(), netErr(), used() -errorBlock(cbErr) -return + RETURN + +PROCEDURE mkTest( lNewArea, cRdd, cFile, cAlias, lShared, lReadOnly ) + + LOCAL cbErr := ErrorBlock( { |oErr|break( oErr ) } ), oErr + + NetErr( .F. ) + BEGIN SEQUENCE + dbUseArea( lNewArea, cRdd, cFile, cAlias, lShared, lReadOnly ) + RECOVER USING oErr + ? "Error:", oErr:subCode, oErr:description, oErr:operation, oErr:osCode + END + ? Select(), Alias(), NetErr(), Used() + ErrorBlock( cbErr ) + + RETURN diff --git a/harbour/tests/vec1.prg b/harbour/tests/vec1.prg index ea2746165c..eeb168ba5f 100644 --- a/harbour/tests/vec1.prg +++ b/harbour/tests/vec1.prg @@ -1,10 +1,10 @@ //NOTEST -// -// $Id$ -// +/* + * $Id$ + */ -// ; Donated to the public domain by -// Viktor Szakats (harbour.01 syenar.hu) +/* Donated to the public domain by + Viktor Szakats (harbour.01 syenar.hu) */ FUNCTION Main() diff --git a/harbour/tests/version.prg b/harbour/tests/version.prg index 558140d89d..5cac91eb1b 100644 --- a/harbour/tests/version.prg +++ b/harbour/tests/version.prg @@ -3,6 +3,7 @@ */ /* Testing the VERSION function */ + /* Harbour Project source code http://harbour-project.org/ Donated to the public domain by David G. Holm . @@ -10,8 +11,8 @@ PROCEDURE Main() - outstd( chr( 34 ) + version() + chr( 34 ) + hb_eol() ) - outstd( chr( 34 ) + hb_compiler() + chr( 34 ) + hb_eol() ) - outstd( chr( 34 ) + os() + chr( 34 ) + hb_eol() ) + OutStd( Chr( 34 ) + Version() + Chr( 34 ) + hb_eol() ) + OutStd( Chr( 34 ) + hb_compiler() + Chr( 34 ) + hb_eol() ) + OutStd( Chr( 34 ) + OS() + Chr( 34 ) + hb_eol() ) RETURN diff --git a/harbour/tests/videotst.prg b/harbour/tests/videotst.prg index a90438ee79..0b71bdcb7c 100644 --- a/harbour/tests/videotst.prg +++ b/harbour/tests/videotst.prg @@ -2,12 +2,9 @@ * $Id$ */ -* videotst.prg -* -* Copyright 2000 Alejandro de Garate -* -* Test SETMODE() for Harbour Project -* +// Copyright 2000 Alejandro de Garate +// +// Test SETMODE() for Harbour Project #define HB_NOT_SUPPORTED "Video mode not supported on this system.." #define HB_VROW 1 @@ -16,70 +13,72 @@ FUNCTION MAIN() - LOCAL nMode:= 1, nRow, lSuccess - LOCAL aVModes:= {; - { 12, 40, " 12 x 40 " },; - { 25, 40, " 25 x 40 " },; - { 28, 40, " 28 x 40 " },; - { 50, 40, " 50 x 40 " },; - { 12, 80, " 12 x 80 " },; - { 25, 80, " 25 x 80 " },; - { 28, 80, " 28 x 80 " },; - { 43, 80, " 43 x 80 " },; - { 50, 80, " 50 x 80 " },; - { 60, 80, " 60 x 80 " } } + LOCAL nMode := 1, nRow, lSuccess + LOCAL aVModes := { ; + { 12, 40, " 12 x 40 " }, ; + { 25, 40, " 25 x 40 " }, ; + { 28, 40, " 28 x 40 " }, ; + { 50, 40, " 50 x 40 " }, ; + { 12, 80, " 12 x 80 " }, ; + { 25, 80, " 25 x 80 " }, ; + { 28, 80, " 28 x 80 " }, ; + { 43, 80, " 43 x 80 " }, ; + { 50, 80, " 50 x 80 " }, ; + { 60, 80, " 60 x 80 " } } - DO WHILE (nMode != 0) + DO WHILE nMode != 0 - CLEAR SCREEN - @ 0, 0 SAY "Select the video mode you want to test.." + CLEAR SCREEN + @ 0, 0 SAY "Select the video mode you want to test.." - FOR nRow:= 1 To 5 - @ 2 + nRow, 10 PROMPT aVModes [nRow] [HB_PROMPT] - NEXT + FOR nRow := 1 TO 5 + @ 2 + nRow, 10 PROMPT aVModes[ nRow ][ HB_PROMPT ] + NEXT - FOR nRow:= 6 To 10 - @ 2 + nRow - 5, 25 PROMPT aVModes [nRow] [HB_PROMPT] - NEXT - MENU TO nMode + FOR nRow := 6 TO 10 + @ 2 + nRow - 5, 25 PROMPT aVModes[ nRow ][ HB_PROMPT ] + NEXT + MENU TO nMode - If (nMode > 0) - lSuccess := SETMODE( aVModes [nMode] [HB_VROW], aVModes [nMode] [HB_VCOL]) + IF nMode > 0 + lSuccess := SetMode( aVModes[ nMode ][ HB_VROW ], aVModes[ nMode ][ HB_VCOL ] ) - IF lSuccess == .T. - TESTBOX( aVModes [nMode] [HB_PROMPT] ) - ELSE - @ MAXROW(), 0 SAY HB_NOT_SUPPORTED - INKEY(0) - ENDIF - ENDIF + IF lSuccess == .T. + TESTBOX( aVModes[ nMode ][ HB_PROMPT ] ) + ELSE + @ MaxRow(), 0 SAY HB_NOT_SUPPORTED + Inkey( 0 ) + ENDIF + ENDIF - ENDDO + ENDDO - QUIT + QUIT - RETURN 0 + RETURN 0 +//************************* - ************************** - PROCEDURE TESTBOX( cMode ) - **************************************************************************** - * Simple testing screen.. - **************************************************************************** - LOCAL nRow - CLEAR SCREEN - @ 0, 0 TO MAXROW(), MAXCOL() DOUBLE - @ 0, 3 SAY cMode - @ MAXROW(), 3 SAY " Press a key " +PROCEDURE TESTBOX( cMode ) - @ 8, 0 SAY REPLICATE( " ", 20) - @ 9, 0 SAY REPLICATE( "0123456789", 20) + //*************************************************************************** + // Simple testing screen.. + //*************************************************************************** + LOCAL nRow + CLEAR SCREEN + @ 0, 0 TO MaxRow(), MaxCol() DOUBLE + @ 0, 3 SAY cMode + @ MaxRow(), 3 SAY " Press a key " - FOR nRow:= 0 TO MAXROW() - @ nRow, 18 SAY STR( nRow, 2) - NEXT + @ 8, 0 SAY Replicate( " ", 20 ) + @ 9, 0 SAY Replicate( "0123456789", 20 ) - @ 4, 2 SAY "MaxRow() = " + STR( MAXROW(), 3) - @ 5, 2 SAY "MaxCol() = " + STR( MAXCOL(), 3) - INKEY(0) - RETURN + FOR nRow := 0 TO MaxRow() + @ nRow, 18 SAY Str( nRow, 2 ) + NEXT + + @ 4, 2 SAY "MaxRow() = " + Str( MaxRow(), 3 ) + @ 5, 2 SAY "MaxCol() = " + Str( MaxCol(), 3 ) + Inkey( 0 ) + + RETURN diff --git a/harbour/tests/vidtest.prg b/harbour/tests/vidtest.prg index 4cd1d9d18a..c421c43f82 100644 --- a/harbour/tests/vidtest.prg +++ b/harbour/tests/vidtest.prg @@ -1,6 +1,7 @@ /* * $Id$ */ + /* * Harbour project video test code * @@ -8,212 +9,225 @@ * * Redirect the output of this program to a file. * - * ie: VidTest >results + * ie: vidtest > results * */ #include "box.ch" #ifndef __CLIP__ - #ifdef FlagShip - #xtranslate hb_secondsCPU([]) => secondsCPU([]) - #else - #ifndef __HARBOUR__ - #xtranslate hb_secondsCPU([]) => seconds([]) - #endif - #define EOL chr(13) + chr(10) - #endif + #ifdef FlagShip + #xtranslate hb_secondsCPU( [] ) => secondsCPU( [] ) + #else + #ifndef __HARBOUR__ + #xtranslate hb_secondsCPU( [] ) => Seconds( [] ) + #endif + #define EOL Chr( 13 ) + Chr( 10 ) + #endif #endif + #ifndef EOL - #define EOL chr(10) +#define EOL Chr( 10 ) #endif + #command ? => outstd(EOL);outerr(EOL) #command ? => outstd(, EOL);outerr(, EOL) #ifdef FlagShip - static nDispCount := 0 - #xtranslate dispbegin() => iif((++nDispCount)==1, dispbegin(NIL),) - #xtranslate dispend() => iif(nDispCount>0 .and. (--nDispCount)==0, dispend(NIL),) +STATIC nDispCount := 0 + +#xtranslate dispbegin() => iif( ( ++nDispCount ) == 1, DispBegin( NIL ), ) +#xtranslate dispend() => iif( nDispCount > 0 .AND. ( --nDispCount ) == 0, DispEnd( NIL ), ) + #endif -function main() - local aResult := {} +FUNCTION Main() - Initialise() // Initialise Screen Display + LOCAL aResult := {} - // Perform Tests - aadd(aResult, StaticText() ) - aadd(aResult, WindowBounce() ) - aadd(aResult, ColourBoxes() ) + Initialise() // Initialise Screen Display - // Display Results - Summary(aResult) -return NIL + // Perform Tests + AAdd( aResult, StaticText() ) + AAdd( aResult, WindowBounce() ) + AAdd( aResult, ColourBoxes() ) + // Display Results + Summary( aResult ) + + RETURN NIL // initialise the screen -static function Initialise() - //SetMode(25,80) - set colour to "W+/BG" - dispbox(0,0,MaxRow(), MaxCol(), replicate(chr(176),9), "BG/B") -return NIL +STATIC FUNCTION Initialise() + +// SetMode( 25, 80 ) + SET colour TO "W+/BG" + DispBox( 0, 0, MaxRow(), MaxCol(), Replicate( Chr(176 ),9 ), "BG/B" ) + + RETURN NIL // repeatedly display a string in the same position // this test determines how well the Screen i/o subsystem is // caching screen writes. -static function StaticText() - local cResult - local r := MaxRow() / 2 - local str := Version() - local c - local i := 0 - local nEnd := 0 - local nStart := hb_secondsCPU() - str := "Hello World - From " + Left(str,At(" ",str)-1) - c := (MaxCol()-len(str)) / 2 +STATIC FUNCTION StaticText() - for i := 1 to 5000 - @ r, c say str - next i + LOCAL cResult + LOCAL r := MaxRow() / 2 + LOCAL str := Version() + LOCAL c + LOCAL i + LOCAL nEnd + LOCAL nStart := hb_secondsCPU() - nEnd := hb_secondsCPU() + str := "Hello World - From " + Left( str, At( " ", str ) - 1 ) + c := ( MaxCol() - Len( str ) ) / 2 - cResult := "StaticText: Iterations=5000, Time="+alltrim(str(nEnd-nStart))+ ; - "secs, Average FPS = "+alltrim(str(round(5000 / (nEnd-nStart),0)))+" FPS" -return cResult + FOR i := 1 TO 5000 + @ r, c SAY str + NEXT + nEnd := hb_secondsCPU() + + cResult := "StaticText: Iterations=5000, Time=" + hb_ntos( nEnd - nStart ) + ; + "secs, Average FPS = " + hb_ntos( Round( 5000 / ( nEnd - nStart ), 0 ) ) + " FPS" + + RETURN cResult // Bounce a window around the screen a few thousand times // timing the duration, and determining the average FPS -static function WindowBounce() - local cResult := "" - local nBoxes := Min(MaxRow(), MaxCol()-7)-6 /* keep the box in bounds */ - local x := array(NBOXES) - local y := array(NBOXES) - local dx := array(NBOXES) - local dy := array(NBOXES) - local clr := array(NBOXES) - local scr := array(NBOXES) - local nFrames := 0 - local nStart := 0 - local nEnd := 0 - local i := 0 - local aCol := {"N", "B", "G", "BG", "R", "RB", "GR", "W", ; - "N*","B*","G*","BG*","R*","RB*","GR*","W*" } - // initialise boxes - for i := 1 to nBoxes - x[i] := i - y[i] := i-1 - dx[i] := -1 - dy[i] := 1 - clr[i] := "W+/"+aCol[(i-1)%16+1] - next i +STATIC FUNCTION WindowBounce() - nStart := hb_secondsCPU() - dispbegin() + LOCAL cResult + LOCAL nBoxes := Min( MaxRow(), MaxCol() - 7 ) - 6 /* keep the box in bounds */ + LOCAL x := Array( NBOXES ) + LOCAL y := Array( NBOXES ) + LOCAL dx := Array( NBOXES ) + LOCAL dy := Array( NBOXES ) + LOCAL clr := Array( NBOXES ) + LOCAL scr := Array( NBOXES ) + LOCAL nFrames := 0 + LOCAL nStart + LOCAL nEnd + LOCAL i + LOCAL aCol := { "N", "B", "G", "BG", "R", "RB", "GR", "W", ; + "N*", "B*", "G*", "BG*", "R*", "RB*", "GR*", "W*" } - do while nFrames < 5000 + // initialise boxes + FOR i := 1 TO nBoxes + x[ i ] := i + y[ i ] := i - 1 + dx[ i ] := -1 + dy[ i ] := 1 + clr[ i ] := "W+/" + aCol[ ( i - 1 ) % 16 + 1 ] + NEXT - for i := 1 to nBoxes - scr[i] := SaveScreen(x[i], y[i], x[i]+6, y[i]+12) - @ x[i], y[i], x[i]+6, y[i]+12 box B_SINGLE+" " color clr[i] - next i + nStart := hb_secondsCPU() + DispBegin() - dispend() - dispbegin() + DO WHILE nFrames < 5000 - for i := nBoxes to 1 step -1 - // remove boxes from screen - RestScreen(x[i], y[i], x[i]+6, y[i]+12, scr[i]) + FOR i := 1 TO nBoxes + scr[ i ] := SaveScreen( x[ i ], y[ i ], x[ i ] + 6, y[ i ] + 12 ) + @ x[ i ], y[ i ], x[ i ] + 6, y[ i ] + 12 BOX B_SINGLE + " " COLOR clr[ i ] + NEXT - // move - x[i] += dx[i] - y[i] += dy[i] - if x[i] <= 0 .or. x[i]+6 >= MaxRow() - dx[i] := -dx[i] - endif - if y[i] <= 0 .or. y[i]+12 >= MaxCol() - dy[i] := -dy[i] - endif - next i + DispEnd() + DispBegin() - ++nFrames - enddo + FOR i := nBoxes TO 1 STEP -1 + // remove boxes from screen + RestScreen( x[ i ], y[ i ], x[ i ] + 6, y[ i ] + 12, scr[ i ] ) - dispend() - nEnd := hb_secondsCPU() + // move + x[ i ] += dx[ i ] + y[ i ] += dy[ i ] + IF x[ i ] <= 0 .OR. x[ i ] + 6 >= MaxRow() + dx[ i ] := - dx[ i ] + ENDIF + IF y[ i ] <= 0 .OR. y[ i ] + 12 >= MaxCol() + dy[ i ] := - dy[ i ] + ENDIF + next i - cResult := "WindowBounce:Iterations="+alltrim(str(nFrames))+", Time="+alltrim(str(nEnd-nStart))+ ; - "secs, Average FPS = "+alltrim(str(round(nFrames / (nEnd-nStart),0)))+" FPS" + ++nFrames + ENDDO -return cResult + DispEnd() + nEnd := hb_secondsCPU() + cResult := "WindowBounce:Iterations=" + hb_ntos( nFrames ) + ", Time=" + hb_ntos( nEnd - nStart ) + ; + "secs, Average FPS = " + hb_ntos( Round( nFrames / ( nEnd - nStart ), 0 ) ) + " FPS" + + RETURN cResult // Display colour boxes, repeatedly, this will determine // how efficiently the screen i/o subsystem is caching the // dispbegin()'s and dispend()'s -static function ColourBoxes() - local cResult := "" - local nFrames := 0 - local nStart := 0 - local nEnd := 0 - local i := 0 - local nDir := 1 - local nDepth := 0 - local aCol := {"N", "B", "G", "BG", "R", "RB", "GR", "W", ; - "N*","B*","G*","BG*","R*","RB*","GR*","W*" } - nStart := hb_secondsCPU() - // display boxes to screen +STATIC FUNCTION ColourBoxes() - do while nFrames < 5000 - if nDir == 1 - dispbegin() - else - dispend() - endif + LOCAL cResult + LOCAL nFrames := 0 + LOCAL nStart + LOCAL nEnd + LOCAL i + LOCAL nDir := 1 + LOCAL nDepth := 0 + LOCAL aCol := { "N", "B", "G", "BG", "R", "RB", "GR", "W", ; + "N*", "B*", "G*", "BG*", "R*", "RB*", "GR*", "W*" } - nDepth += nDir + nStart := hb_secondsCPU() + // display boxes to screen - if nDepth > 4 .or. nDepth < 1 - nDir := -nDir - endif - i := nFrames %16 +1 - dispbox(5,10, MaxRow()-5, MaxCol()-10, ; - replicate(chr(i+64),9),; - "W+/"+aCol[i] ) - ++nFrames - enddo + DO WHILE nFrames < 5000 + IF nDir == 1 + DispBegin() + ELSE + DispEnd() + ENDIF - // remove any nested dispbegins() - do while nDepth > 0 - dispend() - nDepth-- - enddo + nDepth += nDir - nEnd := hb_secondsCPU() + IF nDepth > 4 .OR. nDepth < 1 + nDir := - nDir + ENDIF + i := nFrames % 16 + 1 + DispBox( 5, 10, MaxRow() - 5, MaxCol() - 10, ; + Replicate( Chr( i + 64 ), 9 ), ; + "W+/" + aCol[ i ] ) + ++nFrames + ENDDO - cResult := "ColourBoxes: Iterations="+alltrim(str(nFrames))+", Time="+alltrim(str(nEnd-nStart))+ ; - "secs, Average FPS = "+alltrim(str(round(nFrames / (nEnd-nStart),0)))+" FPS" + // remove any nested dispbegins() + DO WHILE nDepth > 0 + DispEnd() + nDepth-- + ENDDO -return cResult + nEnd := hb_secondsCPU() + cResult := "ColourBoxes: Iterations=" + hb_ntos( nFrames ) + ", Time=" + hb_ntos( nEnd - nStart ) + ; + "secs, Average FPS = " + hb_ntos( Round( nFrames / ( nEnd - nStart ), 0 ) ) + " FPS" + + RETURN cResult // display results -static function Summary(aResult) - local i := 0 - clear screen - ? "Resolution: " + Ltrim(str( MaxRow()+1 )) + " x " + Ltrim(str( MaxCol()+1 )) + " " + Version() - for i := 1 to len(aResult) - ? aResult[i] - next i - ? - ? "press any key to continue" - inkey(0) +STATIC FUNCTION Summary( aResult ) -return aResult + LOCAL i + + CLEAR SCREEN + ? "Resolution: " + hb_ntos( MaxRow() + 1 ) + " x " + hb_ntos( MaxCol() + 1 ) + " " + Version() + FOR i := 1 TO Len( aResult ) + ? aResult[ i ] + NEXT + ? + ? "press any key to continue" + Inkey( 0 ) + + RETURN aResult diff --git a/harbour/tests/vmasort.prg b/harbour/tests/vmasort.prg index 54f800f6eb..2e47ca449e 100644 --- a/harbour/tests/vmasort.prg +++ b/harbour/tests/vmasort.prg @@ -1,85 +1,85 @@ -// -// $Id$ -// +/* + * $Id$ + */ -function Main( nPass ) +PROCEDURE Main( nPass ) - LOCAL aTest - LOCAL aOrig + LOCAL aTest + LOCAL aOrig - if nPass == NIL - nPass := 1 - else - nPass := Val( nPass ) - endif + IF nPass == NIL + nPass := 1 + ELSE + nPass := Val( nPass ) + ENDIF - ? "Testing aSort with " + Str( nPass ) + " loops." - ? - aTest := aMkArray( nPass ) - aOrig := aClone( aTest ) + ? "Testing aSort with " + Str( nPass ) + " loops." + ? + aTest := aMkArray( nPass ) + aOrig := AClone( aTest ) - set( _SET_DATEFORMAT, "mm/dd/yyyy" ) + SET DATE ANSI - ? "Original.....:", aDump( aOrig ) - ? "Asort.c......:", aDump( aSort( aTest ) ) -// ? "Asort.c.block:", aDump( aSort( aTest, , , {| x, y | x < y } ) ) + ? "Original.....:", aDump( aOrig ) + ? "Asort.c......:", aDump( ASort( aTest ) ) +// ? "Asort.c.block:", aDump( aSort( aTest, , , {| x, y | x < y } ) ) -return nil + RETURN -static function aMkArray( nPass ) +STATIC FUNCTION aMkArray( nPass ) - LOCAL aData := {} - LOCAL n - LOCAL nMult := 200 - LOCAL nMid := ( nMult / 2 ) + 1 - LOCAL nMax := nPass * nMult + LOCAL aData := {} + LOCAL n + LOCAL nMult := 200 + LOCAL nMid := ( nMult / 2 ) + 1 + LOCAL nMax := nPass * nMult - for n := 1 to nMax - aAdd( aData, NIL ) - aAdd( aData, nMid - n ) - aAdd( aData, Date() - n ) - aAdd( aData, iif( n % 2 == 0, .f., .t. ) ) - aAdd( aData, Replicate( Chr( 64 + ( n % 256 ) ) , nPass ) ) - aAdd( aData, {|| n } ) - aAdd( aData, Array( n ) ) - aAdd( aData, ErrorNew() ) - next + FOR n := 1 TO nMax + AAdd( aData, NIL ) + AAdd( aData, nMid - n ) + AAdd( aData, Date() - n ) + AAdd( aData, iif( n % 2 == 0, .F., .T. ) ) + AAdd( aData, Replicate( Chr( 64 + ( n % 256 ) ), nPass ) ) + AAdd( aData, {|| n } ) + AAdd( aData, Array( n ) ) + AAdd( aData, ErrorNew() ) + NEXT -return aData + RETURN aData -function aDump( a ) +FUNCTION aDump( a ) - local cStr := "" - local n := len( a ) - local i + LOCAL cStr := "" + LOCAL n := Len( a ) + LOCAL i - for i := 1 to n - cStr += alltrim( xToStr( a[i] ) ) + " " - next + FOR i := 1 TO n + cStr += AllTrim( xToStr( a[ i ] ) ) + " " + NEXT -return cStr + RETURN cStr -function xToStr( xValue ) +FUNCTION xToStr( xValue ) - LOCAL cType := ValType( xValue ) + LOCAL cType := ValType( xValue ) - do case - case cType == "C" .or. cType == "M" - return xValue - case cType == "N" - return AllTrim( Str( xValue ) ) - case cType == "D" - return DToC( xValue ) - case cType == "L" - return iif( xValue, ".T.", ".F." ) - case cType == "U" - return "NIL" - case cType == "A" - return "{.}" - case cType == "B" - return "{|| }" - case cType == "O" - return "[O]" - endcase + DO CASE + CASE cType == "C" .OR. cType == "M" + RETURN xValue + CASE cType == "N" + RETURN AllTrim( Str( xValue ) ) + CASE cType == "D" + RETURN DToC( xValue ) + CASE cType == "L" + RETURN iif( xValue, ".T.", ".F." ) + CASE cType == "U" + RETURN "NIL" + CASE cType == "A" + RETURN "{.}" + CASE cType == "B" + RETURN "{|| }" + CASE cType == "O" + RETURN "[O]" + ENDCASE -return xValue + RETURN xValue diff --git a/harbour/tests/while.prg b/harbour/tests/while.prg index 55e226008e..14b2689e63 100644 --- a/harbour/tests/while.prg +++ b/harbour/tests/while.prg @@ -1,15 +1,15 @@ -// -// $Id$ -// +/* + * $Id$ + */ // while loop test -function Main() +PROCEDURE Main() - local x := 0 + LOCAL x := 0 - while x++ < 1000 + DO WHILE x++ < 1000 QOut( x ) - end + ENDDO -return nil + RETURN diff --git a/harbour/utils/hbmk2/hbmk2.prg b/harbour/utils/hbmk2/hbmk2.prg index b975814a5f..a9d47ccd08 100644 --- a/harbour/utils/hbmk2/hbmk2.prg +++ b/harbour/utils/hbmk2/hbmk2.prg @@ -11929,7 +11929,7 @@ STATIC PROCEDURE convert_xhp_to_hbp( hbmk, cSrcName, cDstName ) LOCAL cSrc := MemoRead( cSrcName ) LOCAL cDst LOCAL aDst := {} - LOCAL tmp + LOCAL tmp, tmp1 LOCAL cLine LOCAL cSetting LOCAL cValue @@ -11966,7 +11966,11 @@ STATIC PROCEDURE convert_xhp_to_hbp( hbmk, cSrcName, cDstName ) CASE ".c" CASE ".prg" IF !( "%HB_INSTALL%\" $ cFile ) - AAdd( aDst, StrTran( cFile, "%HOME%\" ) ) + tmp := StrTran( cFile, "%HOME%\" ) + IF " " $ tmp + tmp := Chr( 34 ) + tmp + Chr( 34 ) + ENDIF + AAdd( aDst, tmp ) ENDIF EXIT CASE ".lib" @@ -11974,17 +11978,29 @@ STATIC PROCEDURE convert_xhp_to_hbp( hbmk, cSrcName, cDstName ) IF !( "%C_LIB_INSTALL%\" $ cFile ) .AND. ; !( "%HB_LIB_INSTALL%\" $ cFile ) cFile := StrTran( cFile, "%HOME%\" ) - IF !( hb_FNameDir( cFile ) $ hLIBPATH ) + IF !( hb_FNameDir( cFile ) $ hLIBPATH ) .AND. ! Empty( hb_FNameDir( cFile ) ) hLIBPATH[ hb_FNameDir( cFile ) ] := NIL ENDIF - AAdd( aDst, "-l" + hb_FNameName( cFile ) ) + tmp := hb_FNameName( cFile ) + IF hb_FNameExt( cFile ) == ".a" .AND. Left( tmp, 3 ) == "lib" + tmp := SubStr( tmp, 4 ) + ENDIF + tmp := "-l" + tmp + IF " " $ tmp + tmp := Chr( 34 ) + tmp + Chr( 34 ) + ENDIF + AAdd( aDst, tmp ) ENDIF EXIT CASE ".obj" CASE ".o" IF !( "%C_LIB_INSTALL%\" $ cFile ) .AND. ; !( "%HB_LIB_INSTALL%\" $ cFile ) - AAdd( aDst, StrTran( cFile, "%HOME%\" ) ) + tmp := StrTran( cFile, "%HOME%\" ) + IF " " $ tmp + tmp := Chr( 34 ) + tmp + Chr( 34 ) + ENDIF + AAdd( aDst, tmp ) ENDIF EXIT ENDSWITCH @@ -12009,10 +12025,17 @@ STATIC PROCEDURE convert_xhp_to_hbp( hbmk, cSrcName, cDstName ) EXIT CASE "Include" FOR EACH tmp IN aValue - IF Left( tmp, 2 ) == "-I" - tmp := SubStr( tmp, 3 ) + IF !( "%HB_INSTALL%\" $ tmp ) + IF Left( tmp, 2 ) == "-I" + tmp := SubStr( tmp, 3 ) + ENDIF + tmp := StrTran( StrTran( tmp, '"' ), "%HOME%\" ) + FOR EACH tmp1 IN hb_ATokens( tmp, ";" ) + IF ! Empty( tmp1 ) + AAdd( aDst, "-incpath=" + tmp1 ) + ENDIF + NEXT ENDIF - AAdd( aDst, "-incpath=" + StrTran( StrTran( tmp, '"' ), "%HOME%\" ) ) NEXT EXIT CASE "Define"