diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 975fcc3c7c..34f9f9c4d9 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,34 @@ The license applies to all entries newer than 2009-04-28. */ +2012-10-11 11:48 UTC+0200 Viktor Szakats (harbour syenar.net) + * extras/hbxlsxml/xlsxml.prg + * extras/httpsrv/modules/info.prg + * extras/httpsrv/modules/showcounter.prg + * extras/httpsrv/modules/testajax.prg + * tests/mathtest.prg + * tests/memfile.prg + * tests/memory.prg + * tests/memtst.prg + * tests/memvar.prg + * tests/newrdd.prg + * contrib/hbmisc/hbeditc.c + * formatting + + * src/rdd/usrrdd/rdds/hscdx.prg + * src/rdd/usrrdd/rdds/rlcdx.prg + * hbformat, manual fixups + + * contrib/hbformat/hbfmtcls.prg + * added TOFIX for not recognizing INIT/EXIT PROCEDURE + statements + + * tests/memtst.prg + ! typo in comment + + * tests/mathtest.prg + ! added CLS to run well under hbrun + 2012-10-11 02:41 UTC+0200 Viktor Szakats (harbour syenar.net) * ChangeLog ! typo diff --git a/harbour/contrib/hbformat/hbfmtcls.prg b/harbour/contrib/hbformat/hbfmtcls.prg index c4b8a98f15..7f560b992e 100644 --- a/harbour/contrib/hbformat/hbfmtcls.prg +++ b/harbour/contrib/hbformat/hbfmtcls.prg @@ -65,7 +65,7 @@ // 1. 'var ++' // 2. '- 1' for numeric literals. // 3. wrongly breaks line: 'FUNCTION Hello( /* comment */ )' -// ... +// 4. INIT PROCEDURE/EXIT PROCEDURE are not recognized as PROCEDURE statement CREATE CLASS HBFORMATCODE diff --git a/harbour/contrib/hbmisc/hbeditc.c b/harbour/contrib/hbmisc/hbeditc.c index c89a511f31..e17e11f392 100644 --- a/harbour/contrib/hbmisc/hbeditc.c +++ b/harbour/contrib/hbmisc/hbeditc.c @@ -447,7 +447,7 @@ static HB_ISIZ InsText( PHB_EDITOR pEd, char * adres, HB_ISIZ line ) { /* there is enough free room in text buffer */ - if( (adres[ dl - 1 ] != '\n' ) && ( adres[ dl - 2 ] != '\r' ) ) + if( ( adres[ dl - 1 ] != '\n' ) && ( adres[ dl - 2 ] != '\r' ) ) { /* There is no CRLF at the end of inserted text - * we have to add CRLF to separate it from existing text diff --git a/harbour/extras/hbxlsxml/xlsxml.prg b/harbour/extras/hbxlsxml/xlsxml.prg index 7c1aa21628..b36a391162 100644 --- a/harbour/extras/hbxlsxml/xlsxml.prg +++ b/harbour/extras/hbxlsxml/xlsxml.prg @@ -398,7 +398,7 @@ FUNCTION OEMTOHTML( xtxt ) } FOR i := 1 TO Len( xtxt ) - IF( xpos := AScan( afrm, {| x | SubStr( xtxt, i, 1 ) == x[ 1 ] } ) ) > 0 + IF ( xpos := AScan( afrm, {| x | SubStr( xtxt, i, 1 ) == x[ 1 ] } ) ) > 0 xret += afrm[ xpos, 2 ] ELSE xret += SubStr( xtxt, i, 1 ) diff --git a/harbour/extras/httpsrv/modules/info.prg b/harbour/extras/httpsrv/modules/info.prg index 7540db3bbf..7492ed2436 100644 --- a/harbour/extras/httpsrv/modules/info.prg +++ b/harbour/extras/httpsrv/modules/info.prg @@ -61,6 +61,7 @@ MEMVAR _SERVER, _REQUEST, _GET, _POST, _COOKIE, _SESSION, _HTTP_REQUEST, _HTTP_RESPONSE FUNCTION HRBMAIN() + LOCAL cHtml cHtml := ShowServerInfo() @@ -68,11 +69,13 @@ FUNCTION HRBMAIN() RETURN cHtml STATIC FUNCTION ShowServerInfo() + LOCAL cHtml := "" - //LOCAL oCookie + +// LOCAL oCookie cHtml += "Server Info" - //cHtml += "

If it is first time you see this page reload it to see cookies

" +// cHtml += "

If it is first time you see this page reload it to see cookies

" cHtml += '

Return to Main Page

' cHtml += DisplayVars( _Server , "SERVER Vars" ) @@ -87,17 +90,17 @@ STATIC FUNCTION ShowServerInfo() cHtml += "
" cHtml += DisplayVars( _Cookie , "COOKIE Vars" ) cHtml += "
" - //cHtml += DisplayVars( _Files , "FILE Vars" ) - //cHtml += "
" +// cHtml += DisplayVars( _Files , "FILE Vars" ) +// cHtml += "
" cHtml += DisplayVars( _Request , "REQUEST Vars" ) cHtml += "
" cHtml += DisplayVars( _Session , "SESSION Vars" ) cHtml += "
" // Set a simple cookie - //oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 ) - //oCookie:SetCookie( "samplecookie", "test" ) - //oCookie:SetCookie( "samplecookie2", "test2" ) +// oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 ) +// oCookie:SetCookie( "samplecookie", "test" ) +// oCookie:SetCookie( "samplecookie2", "test2" ) _SESSION[ "Session_Var1" ] := "Test1" _SESSION[ "Session_Var2" ] := "Test2" @@ -105,37 +108,41 @@ STATIC FUNCTION ShowServerInfo() RETURN cHtml STATIC FUNCTION DisplayVars( hHash, cTitle ) + LOCAL cHtml := "" + cHtml += "" - cHtml += "" + cHtml += "" cHtml += "" cHtml += "" cHtml += "" cHtml += "" cHtml += DisplayHash( hHash ) cHtml += "
" + hb_cStr( cTitle ) + "" + hb_CStr( cTitle ) + "
KEYVALUE
" + RETURN cHtml STATIC FUNCTION DisplayHash( hHash ) + LOCAL cHtml := "" LOCAL cKey, cSubKey, xValue FOR EACH cKey IN hHash:Keys cHtml += "" IF HB_ISHASH( hHash[ cKey ] ) - cHtml += "" + hb_cStr( cKey ) + "" + cHtml += "" + hb_CStr( cKey ) + "" cHtml += "-------" FOR EACH cSubKey IN hHash[ cKey ]:Keys xValue := hHash[ cKey ][ cSubKey ] cHtml += "" - cHtml += "" + hb_cStr( cSubKey ) + "" - cHtml += "" + IIF( Empty( xValue ), "no value", hb_cStr( xValue ) ) + "" + cHtml += "" + hb_CStr( cSubKey ) + "" + cHtml += "" + iif( Empty( xValue ), "no value", hb_CStr( xValue ) ) + "" cHtml += "" NEXT ELSE xValue := hHash[ cKey ] - cHtml += "" + hb_cStr( cKey ) + "" - cHtml += "" + IIF( Empty( xValue ), "no value", hb_cStr( xValue ) ) + "" + cHtml += "" + hb_CStr( cKey ) + "" + cHtml += "" + iif( Empty( xValue ), "no value", hb_CStr( xValue ) ) + "" ENDIF cHtml += "" NEXT diff --git a/harbour/extras/httpsrv/modules/showcounter.prg b/harbour/extras/httpsrv/modules/showcounter.prg index a27dc391d8..cf662c683a 100644 --- a/harbour/extras/httpsrv/modules/showcounter.prg +++ b/harbour/extras/httpsrv/modules/showcounter.prg @@ -63,15 +63,16 @@ MEMVAR _REQUEST // defined in uHTTPD #define DISPLAY_NUM 10 FUNCTION HRBMAIN() + LOCAL cHtml - IF HB_HHasKey( _REQUEST, "w" ) + IF hb_HHasKey( _REQUEST, "w" ) cHtml := CreateCounter( hb_ntos( Val( _REQUEST[ "w" ] ) ) ) IF !Empty( cHtml ) uhttpd_SetHeader( "Content-Type", "image/gif" ) uhttpd_SetHeader( "Pragma", "no-cache" ) - uhttpd_SetHeader( "Content-Disposition", "inline; filename=counter" + hb_ntos( hb_randomint( 100 ) ) + ".gif" ) + uhttpd_SetHeader( "Content-Disposition", "inline; filename=counter" + hb_ntos( hb_RandomInt( 100 ) ) + ".gif" ) uhttpd_Write( cHtml ) ELSE uhttpd_SetHeader( "Content-Type", "text/html" ) @@ -91,50 +92,51 @@ FUNCTION HRBMAIN() STATIC FUNCTION CreateCounter( cValue, cBaseImage ) LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp - //LOCAL black, white, blue, red, green, cyan, gray - //LOCAL white + +// LOCAL black, white, blue, red, green, cyan, gray +// LOCAL white LOCAL aNumberImages := {} LOCAL n, nValue - //LOCAL cFile +// LOCAL cFile // A value if not passed hb_default( @cValue , Str( hb_RandomInt( 1, 10 ^ DISPLAY_NUM ), DISPLAY_NUM ) ) hb_default( @cBaseImage, "57chevy.gif" ) - IF !hb_FileExists( IMAGES_IN + cBaseImage ) + IF ! hb_FileExists( IMAGES_IN + cBaseImage ) //hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" ) //THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" ) RETURN NIL - //ELSE - // hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' FOUND" ) + //ELSE + // hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' FOUND" ) ENDIF nValue := Val( cValue ) // Fix num lenght - IF nValue > 10^DISPLAY_NUM - nValue := 10^DISPLAY_NUM + IF nValue > 10 ^ DISPLAY_NUM + nValue := 10 ^ DISPLAY_NUM ENDIF cValue := StrZero( nValue, DISPLAY_NUM ) - //? "Value = ", cValue +// ? "Value = ", cValue // To set fonts run this command: // for windows: SET GDFONTPATH=%WINDIR%\fonts // per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType // SET GDFONTPATH=%WINDIR%\fonts - //IF GetEnv( "GDFONTPATH" ) == "" - // ? "Please set GDFONTPATH" - // ? "On Windows: SET GDFONTPATH=%WINDIR%\fonts" - // ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType" - // ? - //ENDIF +// IF GetEnv( "GDFONTPATH" ) == "" +// ? "Please set GDFONTPATH" +// ? "On Windows: SET GDFONTPATH=%WINDIR%\fonts" +// ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType" +// ? +// ENDIF // Check output directory /* - IF !hb_DirExists( IMAGES_OUT ) + IF ! hb_DirExists( IMAGES_OUT ) DirMake( IMAGES_OUT ) ENDIF */ @@ -161,58 +163,59 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage ) ENDCASE nNumWidth := nWidth / nDigits - //? "nNumWidth, nWidth, nHeight, nDigits = ", nNumWidth, nWidth, nHeight, nDigits +// ? "nNumWidth, nWidth, nHeight, nDigits = ", nNumWidth, nWidth, nHeight, nDigits /* extracts single digits */ FOR n := 1 TO nDigits - oTemp := oIDigits:Copy( (n - 1) * nNumWidth, 0, nNumWidth, nHeight ) - //oTemp:SaveGif( IMAGES_OUT + StrZero( n-1, 2 ) + ".gif" ) - // Here I have to clone the image, otherwise on var destruction I loose - // the image in memory - aAdd( aNumberImages, oTemp:Clone() ) + oTemp := oIDigits:Copy( ( n - 1 ) * nNumWidth, 0, nNumWidth, nHeight ) + //oTemp:SaveGif( IMAGES_OUT + StrZero( n - 1, 2 ) + ".gif" ) + // Here I have to clone the image, otherwise on var destruction I loose + // the image in memory + AAdd( aNumberImages, oTemp:Clone() ) NEXT /* Create counter image in memory */ oI := GDImage():New( nNumWidth * DISPLAY_NUM, nHeight ) // the counter - //? "Image dimensions: ", oI:Width(), oI:Height() +// ? "Image dimensions: ", oI:Width(), oI:Height() /* Allocate background */ - //white := oI:SetColor( 255, 255, 255 ) +// white := oI:SetColor( 255, 255, 255 ) /* Allocate drawing color */ - //black := oI:SetColor( 0, 0, 0 ) - //blue := oI:SetColor( 0, 0, 255 ) - //red := oI:SetColor( 255, 0, 0 ) - //green := oI:SetColor( 0, 255, 0 ) - //cyan := oI:SetColor( 0, 255, 255 ) +// black := oI:SetColor( 0, 0, 0 ) +// blue := oI:SetColor( 0, 0, 255 ) +// red := oI:SetColor( 255, 0, 0 ) +// green := oI:SetColor( 0, 255, 0 ) +// cyan := oI:SetColor( 0, 255, 255 ) /* Draw rectangle */ - //oI:Rectangle( 0, 0, 200, 30, , blue ) +// oI:Rectangle( 0, 0, 200, 30, , blue ) /* Draw Digits */ FOR n := 1 TO Len( cValue ) - // Retrieve the number from array in memory - oTemp := aNumberImages[ Val( SubStr( cValue, n, 1 ) ) + 1 ]:Clone() - // Save it to show the number for a position - //oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" ) - // Set the digit as tile that I have to use to fill position in counter - oI:SetTile( oTemp ) - // Fill the position with the image digit - oI:Rectangle( (n - 1) * nNumWidth, 0, (n - 1) * nNumWidth + nNumWidth, nHeight, .T., gdTiled ) + // Retrieve the number from array in memory + oTemp := aNumberImages[ Val( SubStr( cValue, n, 1 ) ) + 1 ]:Clone() + // Save it to show the number for a position + //oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" ) + // Set the digit as tile that I have to use to fill position in counter + oI:SetTile( oTemp ) + // Fill the position with the image digit + oI:Rectangle( ( n - 1 ) * nNumWidth, 0, ( n - 1 ) * nNumWidth + nNumWidth, nHeight, .T. , gdTiled ) NEXT /* Write Final Counter Image */ - //cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif" - //oI:SaveGif( IMAGES_OUT + cFile ) +// cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif" +// oI:SaveGif( IMAGES_OUT + cFile ) /* Destroy images in memory */ // Class does it automatically - //? - //? "Look at " + IMAGES_OUT + " folder for output images" - //? +// ? +// ? "Look at " + IMAGES_OUT + " folder for output images" +// ? // RETURN cFile + RETURN oI:ToStringGif() #endif diff --git a/harbour/extras/httpsrv/modules/testajax.prg b/harbour/extras/httpsrv/modules/testajax.prg index 4ca6b6653f..ca9b3b2451 100644 --- a/harbour/extras/httpsrv/modules/testajax.prg +++ b/harbour/extras/httpsrv/modules/testajax.prg @@ -53,10 +53,11 @@ MEMVAR _REQUEST FUNCTION HRBMAIN() + LOCAL cW LOCAL cHtml := "" - IF HB_HHasKey( _REQUEST, "w" ) + IF hb_HHasKey( _REQUEST, "w" ) IF ! Empty( cW := _REQUEST[ "w" ] ) cHtml += "This is a reply from testajax : " + cW ENDIF diff --git a/harbour/src/rdd/usrrdd/rdds/hscdx.prg b/harbour/src/rdd/usrrdd/rdds/hscdx.prg index f336c4379b..a76db3c662 100644 --- a/harbour/src/rdd/usrrdd/rdds/hscdx.prg +++ b/harbour/src/rdd/usrrdd/rdds/hscdx.prg @@ -72,49 +72,55 @@ ANNOUNCE HSCDX * these methods does not have to execute SUPER methods - these is * always done by low level USRRDD code */ + STATIC FUNCTION _HSX_NEW( pWA ) - LOCAL aWData := { .F., {}, {} } + + LOCAL aWData := { .F. , {}, {} } /* * Set in our private AREA item the array where we will kepp HSX indexes * and HOT buffer flag */ + USRRDD_AREADATA( pWA, aWData ) RETURN HB_SUCCESS STATIC FUNCTION _HSX_CLOSE( nWA ) + LOCAL aWData := USRRDD_AREADATA( nWA ), nHSX /* close all HSX indexes */ FOR EACH nHSX IN aWData[ 2 ] - HS_CLOSE( nHSX ) + hs_Close( nHSX ) NEXT /* clean the HSX index array */ - ASIZE( aWData[ 2 ], 0 ) - ASIZE( aWData[ 3 ], 0 ) + ASize( aWData[ 2 ], 0 ) + ASize( aWData[ 3 ], 0 ) /* call SUPER CLOSE method to close parent RDD */ + RETURN UR_SUPER_CLOSE( nWA ) STATIC FUNCTION _HSX_GOCOLD( nWA ) + LOCAL nResult, aWData, nHSX, nRecNo, nKeyNo nResult := UR_SUPER_GOCOLD( nWA ) IF nResult == HB_SUCCESS aWData := USRRDD_AREADATA( nWA ) IF aWData[ 1 ] - IF !EMPTY( aWData[ 2 ] ) - nRecNo := RECNO() + IF !Empty( aWData[ 2 ] ) + nRecNo := RecNo() /* update HSX indexes */ FOR EACH nHSX IN aWData[ 2 ] - nKeyNo := HS_KEYCOUNT( nHSX ) + nKeyNo := hs_KeyCount( nHSX ) DO WHILE nKeyNo >= 0 .AND. nKeyNo < nRecNo - nKeyNo := HS_ADD( nHSX, "" ) + nKeyNo := hs_Add( nHSX, "" ) ENDDO IF nKeyNo >= nRecNo - HS_REPLACE( nHSX, , nRecNo ) + hs_Replace( nHSX, , nRecNo ) ENDIF NEXT ENDIF @@ -125,6 +131,7 @@ STATIC FUNCTION _HSX_GOCOLD( nWA ) RETURN nResult STATIC FUNCTION _HSX_GOHOT( nWA ) + LOCAL nResult, aWData nResult := UR_SUPER_GOHOT( nWA ) @@ -136,6 +143,7 @@ STATIC FUNCTION _HSX_GOHOT( nWA ) RETURN nResult STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll ) + LOCAL nResult, aWData nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) @@ -150,69 +158,74 @@ STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll ) * Three public functions for CREATE, OPEN and CLOSE HSX indexes bound * with current work are and automatically updated. */ + FUNCTION HSX_CREATE( cFile, cExpr, nKeySize, nBufSize, lCase, nFiltSet ) + LOCAL aWData, nHsx := -1, nOpenMode - IF !USED() - ELSEIF !RDDNAME() == "HSCDX" + IF !Used() + ELSEIF !rddName() == "HSCDX" ELSE - aWData := USRRDD_AREADATA( SELECT() ) - nOpenMode := iif( DBINFO( DBI_SHARED ), 1, 0 ) + ; - iif( DBINFO( DBI_ISREADONLY ), 2, 0 ) - nHsx := HS_INDEX( cFile, cExpr, nKeySize, nOpenMode, ; - nBufSize, lCase, nFiltSet ) + aWData := USRRDD_AREADATA( Select() ) + nOpenMode := iif( dbInfo( DBI_SHARED ), 1, 0 ) + ; + iif( dbInfo( DBI_ISREADONLY ), 2, 0 ) + nHsx := hs_Index( cFile, cExpr, nKeySize, nOpenMode, ; + nBufSize, lCase, nFiltSet ) IF nHsx >= 0 - AADD( aWData[ 2 ], nHsx ) - AADD( aWData[ 3 ], cFile ) + AAdd( aWData[ 2 ], nHsx ) + AAdd( aWData[ 3 ], cFile ) ENDIF ENDIF RETURN nHsx FUNCTION HSX_OPEN( cFile, nBufSize ) + LOCAL aWData, nHsx, nOpenMode - IF !USED() - ELSEIF !RDDNAME() == "HSCDX" + IF !Used() + ELSEIF !rddName() == "HSCDX" ELSE - aWData := USRRDD_AREADATA( SELECT() ) - nOpenMode := iif( DBINFO( DBI_SHARED ), 1, 0 ) + ; - iif( DBINFO( DBI_ISREADONLY ), 2, 0 ) - nHsx := HS_OPEN( cFile, nBufSize, nOpenMode ) + aWData := USRRDD_AREADATA( Select() ) + nOpenMode := iif( dbInfo( DBI_SHARED ), 1, 0 ) + ; + iif( dbInfo( DBI_ISREADONLY ), 2, 0 ) + nHsx := hs_Open( cFile, nBufSize, nOpenMode ) IF nHsx >= 0 - AADD( aWData[ 2 ], nHsx ) - AADD( aWData[ 3 ], cFile ) + AAdd( aWData[ 2 ], nHsx ) + AAdd( aWData[ 3 ], cFile ) ENDIF ENDIF RETURN NIL FUNCTION HSX_CLOSE( xHSX ) + LOCAL aWData, nSlot - IF USED() .AND. RDDNAME() == "HSCDX" - aWData := USRRDD_AREADATA( SELECT() ) + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) IF HB_ISNUMERIC( xHSX ) - nSlot := ASCAN( aWData[ 2 ], xHSX ) + nSlot := AScan( aWData[ 2 ], xHSX ) ELSEIF HB_ISSTRING( xHSX ) - nSlot := ASCAN( aWData[ 3 ], {| _1 | _1 == xHSX } ) + nSlot := AScan( aWData[ 3 ], {| _1 | _1 == xHSX } ) ELSE nSlot := 0 ENDIF IF nSlot != 0 - hb_ADEL( aWData[ 2 ], nSlot, .T. ) - hb_ADEL( aWData[ 3 ], nSlot, .T. ) + hb_ADel( aWData[ 2 ], nSlot, .T. ) + hb_ADel( aWData[ 3 ], nSlot, .T. ) ENDIF ENDIF RETURN NIL FUNCTION HSX_HANDLE( cFile ) + LOCAL aWData, nSlot - IF USED() .AND. RDDNAME() == "HSCDX" - aWData := USRRDD_AREADATA( SELECT() ) - nSlot := ASCAN( aWData[ 3 ], {| _1 | _1 == cFile } ) + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + nSlot := AScan( aWData[ 3 ], {| _1 | _1 == cFile } ) IF nSlot != 0 RETURN aWData[ 2, nSlot ] ENDIF @@ -221,24 +234,30 @@ FUNCTION HSX_HANDLE( cFile ) RETURN -1 FUNCTION HSX_FILE( nHsx ) + LOCAL aWData, nSlot - IF USED() .AND. RDDNAME() == "HSCDX" - aWData := USRRDD_AREADATA( SELECT() ) - nSlot := ASCAN( aWData[ 3 ], nHsx ) + + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + nSlot := AScan( aWData[ 3 ], nHsx ) IF nSlot != 0 RETURN aWData[ 3, nSlot ] ENDIF ENDIF + RETURN "" FUNCTION HSX_GET( nSlot ) + LOCAL aWData - IF USED() .AND. RDDNAME() == "HSCDX" - aWData := USRRDD_AREADATA( SELECT() ) - IF nSlot > 0 .AND. nSlot <= LEN( aWData[ 2 ] ) + + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + IF nSlot > 0 .AND. nSlot <= Len( aWData[ 2 ] ) RETURN aWData[ 2, nSlot ] ENDIF ENDIF + RETURN -1 /* Force linking DBFCDX from which our RDD inherits */ @@ -248,7 +267,9 @@ REQUEST DBFCDX * This function have to exist in all RDD and then name have to be in * format: _GETFUNCTABLE */ + FUNCTION HSCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + LOCAL cSuperRDD := "DBFCDX" /* We are inheriting from DBFCDX */ LOCAL aMyFunc[ UR_METHODCOUNT ] @@ -259,11 +280,14 @@ FUNCTION HSCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuper aMyFunc[ UR_APPEND ] := ( @_HSX_APPEND() ) RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc, pSuperRddID ) + cSuperRDD, aMyFunc, pSuperRddID ) /* * Register our HSCDX at program startup */ + INIT PROCEDURE HSCDX_INIT() + rddRegister( "HSCDX", RDT_FULL ) + RETURN diff --git a/harbour/src/rdd/usrrdd/rdds/rlcdx.prg b/harbour/src/rdd/usrrdd/rdds/rlcdx.prg index 157485579d..8aa859d49f 100644 --- a/harbour/src/rdd/usrrdd/rdds/rlcdx.prg +++ b/harbour/src/rdd/usrrdd/rdds/rlcdx.prg @@ -70,7 +70,9 @@ ANNOUNCE RLCDX * these methods does not have to execute SUPER methods - these is * always done by low level USRRDD code */ + STATIC FUNCTION RLCDX_NEW( pWA ) + LOCAL aWData := { 0, {} } /* @@ -83,6 +85,7 @@ STATIC FUNCTION RLCDX_NEW( pWA ) RETURN HB_SUCCESS STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) + LOCAL aWData, nResult, xRecId, i aWData := USRRDD_AREADATA( nWA ) @@ -91,7 +94,7 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) IF aLockInfo[ UR_LI_METHOD ] == DBLM_EXCLUSIVE aLockInfo[ UR_LI_METHOD ] := DBLM_MULTIPLE - aLockInfo[ UR_LI_RECORD ] := RECNO() + aLockInfo[ UR_LI_RECORD ] := RecNo() ENDIF @@ -103,14 +106,14 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) ENDIF xRecID := aLockInfo[ UR_LI_RECORD ] - IF EMPTY( xRecID ) - xRecID := RECNO() + IF Empty( xRecID ) + xRecID := RecNo() ENDIF IF aWData[ 1 ] > 0 aLockInfo[ UR_LI_RESULT ] := .T. RETURN HB_SUCCESS - ELSEIF ( i := ASCAN( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) != 0 + ELSEIF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) != 0 ++aWData[ 2, i, 2 ] aLockInfo[ UR_LI_RESULT ] := .T. RETURN HB_SUCCESS @@ -119,7 +122,7 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) nResult := UR_SUPER_LOCK( nWA, aLockInfo ) IF nResult == HB_SUCCESS IF aLockInfo[ UR_LI_RESULT ] - AADD( aWData[ 2 ], { xRecID, 1 } ) + AAdd( aWData[ 2 ], { xRecID, 1 } ) ENDIF ENDIF @@ -136,7 +139,7 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) IF nResult == HB_SUCCESS /* FLOCK always first remove all RLOCKs, even if it fails */ - ASIZE( aWData[ 2 ], 0 ) + ASize( aWData[ 2 ], 0 ) IF aLockInfo[ UR_LI_RESULT ] aWData[ 1 ] := 1 @@ -152,14 +155,15 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) RETURN HB_FAILURE STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID ) + LOCAL aWData := USRRDD_AREADATA( nWA ), i IF HB_ISNUMERIC( xRecID ) .AND. xRecID > 0 - IF ( i := ASCAN( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) != 0 + IF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) != 0 IF --aWData[ 2, i, 2 ] > 0 RETURN HB_SUCCESS ENDIF - hb_ADEL( aWData[ 2 ], i, .T. ) + hb_ADel( aWData[ 2 ], i, .T. ) ELSE RETURN HB_SUCCESS ENDIF @@ -169,12 +173,13 @@ STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID ) RETURN HB_SUCCESS ENDIF aWData[ 1 ] := 0 - ASIZE( aWData[ 2 ], 0 ) + ASize( aWData[ 2 ], 0 ) ENDIF RETURN UR_SUPER_UNLOCK( nWA, xRecID ) STATIC FUNCTION RLCDX_APPEND( nWA, lUnlockAll ) + LOCAL aWData, nResult, xRecId, i /* Never unlock other records, they have to be explicitly unlocked */ @@ -185,10 +190,10 @@ STATIC FUNCTION RLCDX_APPEND( nWA, lUnlockAll ) aWData := USRRDD_AREADATA( nWA ) IF aWData[ 1 ] == 0 - xRecId := RECNO() + xRecId := RecNo() /* Some RDDs may allow to set phantom locks with RLOCK so we should check if it's not the case and increase the counter when it is */ - IF ( i := ASCAN( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) != 0 + IF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) != 0 ++aWData[ 2, i, 2 ] ELSE AADD( aWData[ 2 ], { xRecID, 1 } ) @@ -205,6 +210,7 @@ REQUEST DBFCDX * This function have to exist in all RDD and then name have to be in * format: _GETFUNCTABLE */ + FUNCTION RLCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) LOCAL cSuperRDD := "DBFCDX" /* We are inheriting from DBFCDX */ @@ -216,8 +222,10 @@ FUNCTION RLCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuper aMethods[ UR_APPEND ] := ( @RLCDX_APPEND() ) RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMethods, pSuperRddID ) + cSuperRDD, aMethods, pSuperRddID ) INIT PROCEDURE RLCDX_INIT() + rddRegister( "RLCDX", RDT_FULL ) + RETURN diff --git a/harbour/tests/mathtest.prg b/harbour/tests/mathtest.prg index ee90e98546..75ad834448 100644 --- a/harbour/tests/mathtest.prg +++ b/harbour/tests/mathtest.prg @@ -9,6 +9,8 @@ PROCEDURE Main() LOCAL nOldMathErrMode LOCAL bOldMathErr + CLS + ? "Testing math function: EXP(), LOG() and SQRT():" ? ? " I) Test with correct arguments:" diff --git a/harbour/tests/memfile.prg b/harbour/tests/memfile.prg index 8f8d47e41d..a37a9880c4 100644 --- a/harbour/tests/memfile.prg +++ b/harbour/tests/memfile.prg @@ -21,7 +21,7 @@ MEMVAR mxStayHere PROCEDURE Main() PRIVATE mcLongerNameThen10Chars := "Long String Name!" - PRIVATE mcString := "This is a" + Chr(0) + "string to save." + PRIVATE mcString := "This is a" + Chr( 0 ) + "string to save." PRIVATE mnDouble := 100.0000 PRIVATE mnDoubleH := 5000000000 PRIVATE mnInt := 35 diff --git a/harbour/tests/memory.prg b/harbour/tests/memory.prg index 120e751cf3..85b76c7d14 100644 --- a/harbour/tests/memory.prg +++ b/harbour/tests/memory.prg @@ -9,19 +9,19 @@ PROCEDURE Main() - ? "HB_MEM_CHAR " , MEMORY( HB_MEM_CHAR ) - ? "HB_MEM_BLOCK " , MEMORY( HB_MEM_BLOCK ) - ? "HB_MEM_RUN " , MEMORY( HB_MEM_RUN ) - ? "HB_MEM_VM " , MEMORY( HB_MEM_VM ) - ? "HB_MEM_EMS " , MEMORY( HB_MEM_EMS ) - ? "HB_MEM_FM " , MEMORY( HB_MEM_FM ) - ? "HB_MEM_FMSEGS " , MEMORY( HB_MEM_FMSEGS ) - ? "HB_MEM_SWAP " , MEMORY( HB_MEM_SWAP ) - ? "HB_MEM_CONV " , MEMORY( HB_MEM_CONV ) - ? "HB_MEM_EMSUSED " , MEMORY( HB_MEM_EMSUSED ) - ? "HB_MEM_USED " , MEMORY( HB_MEM_USED ) - ? "HB_MEM_USEDMAX " , MEMORY( HB_MEM_USEDMAX ) - ? "HB_MEM_STACKITEMS" , MEMORY( HB_MEM_STACKITEMS ) - ? "HB_MEM_STACK " , MEMORY( HB_MEM_STACK ) + ? "HB_MEM_CHAR " , Memory( HB_MEM_CHAR ) + ? "HB_MEM_BLOCK " , Memory( HB_MEM_BLOCK ) + ? "HB_MEM_RUN " , Memory( HB_MEM_RUN ) + ? "HB_MEM_VM " , Memory( HB_MEM_VM ) + ? "HB_MEM_EMS " , Memory( HB_MEM_EMS ) + ? "HB_MEM_FM " , Memory( HB_MEM_FM ) + ? "HB_MEM_FMSEGS " , Memory( HB_MEM_FMSEGS ) + ? "HB_MEM_SWAP " , Memory( HB_MEM_SWAP ) + ? "HB_MEM_CONV " , Memory( HB_MEM_CONV ) + ? "HB_MEM_EMSUSED " , Memory( HB_MEM_EMSUSED ) + ? "HB_MEM_USED " , Memory( HB_MEM_USED ) + ? "HB_MEM_USEDMAX " , Memory( HB_MEM_USEDMAX ) + ? "HB_MEM_STACKITEMS" , Memory( HB_MEM_STACKITEMS ) + ? "HB_MEM_STACK " , Memory( HB_MEM_STACK ) RETURN diff --git a/harbour/tests/memtst.prg b/harbour/tests/memtst.prg index 8461c181e0..f3f5630e58 100644 --- a/harbour/tests/memtst.prg +++ b/harbour/tests/memtst.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * a small memory mangaer test code + * a small memory manager test code */ #include "simpleio.ch" @@ -12,96 +12,99 @@ #define N_LOOPS 100000 #ifdef __HARBOUR__ - #include "hbmemory.ch" +#include "hbmemory.ch" #endif PROCEDURE Main() -local nCPUSec, nRealSec, i, a + + LOCAL nCPUSec, nRealSec, i, a #ifdef __HARBOUR__ -if MEMORY( HB_MEM_USEDMAX ) != 0 - ? - ? "Warning !!! Memory statistic enabled." -endif + + IF Memory( HB_MEM_USEDMAX ) != 0 + ? + ? "Warning !!! Memory statistics enabled." + ENDIF #endif -? -? date(), time(), VERSION()+build_mode()+", "+OS() + ? + ? Date(), Time(), Version() + build_mode() + ", " + OS() -? -? "testing single large memory blocks allocation and freeing..." -nRealSec := seconds() -nCPUSec := hb_secondsCPU() -for i := 1 to N_LOOPS - a := space( 50000 ) -next -a := NIL -nCPUSec := hb_secondsCPU() - nCPUSec -nRealSec := seconds() - nRealSec -? " CPU time:", nCPUSec, "sec." -? "real time:", nRealSec, "sec." + ? + ? "testing single large memory blocks allocation and freeing..." + nRealSec := Seconds() + nCPUSec := hb_SecondsCPU() + FOR i := 1 TO N_LOOPS + a := Space( 50000 ) + NEXT + a := NIL + nCPUSec := hb_SecondsCPU() - nCPUSec + nRealSec := Seconds() - nRealSec + ? " CPU time:", nCPUSec, "sec." + ? "real time:", nRealSec, "sec." -? -? "testing many large memory blocks allocation and freeing..." -nRealSec := seconds() -nCPUSec := hb_secondsCPU() -a := array(100) -for i := 1 to N_LOOPS - a[ i % 100 + 1 ] := space( 50000 ) - if i % 200 == 0 - afill(a,"") - endif -next -a := NIL -nCPUSec := hb_secondsCPU() - nCPUSec -nRealSec := seconds() - nRealSec -? " CPU time:", nCPUSec, "sec." -? "real time:", nRealSec, "sec." + ? + ? "testing many large memory blocks allocation and freeing..." + nRealSec := Seconds() + nCPUSec := hb_SecondsCPU() + a := Array( 100 ) + FOR i := 1 TO N_LOOPS + a[ i % 100 + 1 ] := Space( 50000 ) + IF i % 200 == 0 + AFill( a, "" ) + ENDIF + NEXT + a := NIL + nCPUSec := hb_SecondsCPU() - nCPUSec + nRealSec := Seconds() - nRealSec + ? " CPU time:", nCPUSec, "sec." + ? "real time:", nRealSec, "sec." -? -? "testing large memory block reallocation with intermediate allocations..." -? "Warning!!! some compilers may badly fail here" -wait + ? + ? "testing large memory block reallocation with intermediate allocations..." + ? "Warning!!! some compilers may badly fail here" + WAIT -nRealSec := seconds() -nCPUSec := hb_secondsCPU() -a := {} -for i := 1 to N_LOOPS - aadd( a, {} ) - if i%1000 == 0 - ?? i - endif -next -nCPUSec := hb_secondsCPU() - nCPUSec -nRealSec := seconds() - nRealSec -? " CPU time:", nCPUSec, "sec." -? "real time:", nRealSec, "sec." -wait + nRealSec := Seconds() + nCPUSec := hb_SecondsCPU() + a := {} + FOR i := 1 TO N_LOOPS + AAdd( a, {} ) + IF i % 1000 == 0 + ?? i + ENDIF + NEXT + nCPUSec := hb_SecondsCPU() - nCPUSec + nRealSec := Seconds() - nRealSec + ? " CPU time:", nCPUSec, "sec." + ? "real time:", nRealSec, "sec." + WAIT -return + RETURN - -function build_mode() +FUNCTION build_mode() #ifdef __CLIP__ - return " (MT)" + RETURN " (MT)" #else - #ifdef __XHARBOUR__ - return iif( HB_MULTITHREAD(), " (MT)", "" ) + ; - iif( MEMORY( HB_MEM_USEDMAX ) != 0, " (FMSTAT)", "" ) - #else - #ifdef __HARBOUR__ - return iif( HB_MTVM(), " (MT)", "" ) + ; - iif( MEMORY( HB_MEM_USEDMAX ) != 0, " (FMSTAT)", "" ) - #else - #ifdef __XPP__ - return " (MT)" - #else - return "" - #endif - #endif - #endif +#ifdef __XHARBOUR__ + RETURN iif( HB_MULTITHREAD(), " (MT)", "" ) + ; + iif( Memory( HB_MEM_USEDMAX ) != 0, " (FMSTAT)", "" ) +#else +#ifdef __HARBOUR__ + RETURN iif( hb_mtvm(), " (MT)", "" ) + ; + iif( Memory( HB_MEM_USEDMAX ) != 0, " (FMSTAT)", "" ) +#else +#ifdef __XPP__ + RETURN " (MT)" +#else + RETURN "" +#endif +#endif +#endif #endif #if __HARBOUR__ < 0x010100 -FUNCTION HB_MTVM() + +FUNCTION hb_mtvm() RETURN .F. + #endif diff --git a/harbour/tests/memvar.prg b/harbour/tests/memvar.prg index efdbeee297..ff676d9a99 100644 --- a/harbour/tests/memvar.prg +++ b/harbour/tests/memvar.prg @@ -329,7 +329,7 @@ PROCEDURE UsePriv() PROCEDURE UseParam() - PARAMETER param2 + PARAMETERS param2 ? "In UseParam before assignment" ? "Private1 : ", private1 @@ -346,7 +346,7 @@ PROCEDURE UseParam() // -PROCEDURE TEST9() +PROCEDURE Test9() PUBLIC MEMVAR PUBLIC memfunc @@ -367,9 +367,9 @@ STATIC FUNCTION memfunc( memfunc ) RETURN memfunc * memfunc - INIT PROCEDURE initmem() - PARA MEMVAR - PARA initmem +INIT PROCEDURE initmem() + PARAMETERS MEMVAR + PARAMETERS initmem ? "Tests for PARAMETERS, PRIVATE nad PUBLIC variables" ? ? "in INIT function - Passed parameter : ", memvar diff --git a/harbour/tests/newrdd.prg b/harbour/tests/newrdd.prg index e259d24871..ebd593c9bc 100644 --- a/harbour/tests/newrdd.prg +++ b/harbour/tests/newrdd.prg @@ -2,12 +2,12 @@ * $Id$ */ +REQUEST _DBF + PROCEDURE Main() LOCAL nI, aArray - REQUEST _DBF - rddSetDefault( "DBF" ) SET EXCLUSIVE OFF