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

2012-10-11 11:48 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* 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
This commit is contained in:
Viktor Szakats
2012-10-11 09:50:31 +00:00
parent 8b3c89a6fe
commit a334469c05
15 changed files with 289 additions and 213 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
harbour/ChangeLog
View File

@@ -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

2
harbour/contrib/hbformat/hbfmtcls.prg
View File

@@ -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

2
harbour/contrib/hbmisc/hbeditc.c
View File

@@ -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

2
harbour/extras/hbxlsxml/xlsxml.prg
View File

@@ -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 )

33
harbour/extras/httpsrv/modules/info.prg
View File

@@ -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 += "<BIG>Server Info</BIG>"
//cHtml += "<br><br>If it is first time you see this page reload it to see cookies<br><br>"
// cHtml += "<br><br>If it is first time you see this page reload it to see cookies<br><br>"
cHtml += '<br><br>Return to <a href="/">Main Page</a><br><br>'
cHtml += DisplayVars( _Server , "SERVER Vars" )
@@ -87,17 +90,17 @@ STATIC FUNCTION ShowServerInfo()
cHtml += "<br>"
cHtml += DisplayVars( _Cookie , "COOKIE Vars" )
cHtml += "<br>"
//cHtml += DisplayVars( _Files , "FILE Vars" )
//cHtml += "<br>"
// cHtml += DisplayVars( _Files , "FILE Vars" )
// cHtml += "<br>"
cHtml += DisplayVars( _Request , "REQUEST Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _Session , "SESSION Vars" )
cHtml += "<br>"
// 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 += "<table width='90%' align='center' border='1'>"
cHtml += "<th colspan=2>" + hb_cStr( cTitle ) + "</th>"
cHtml += "<th colspan=2>" + hb_CStr( cTitle ) + "</th>"
cHtml += "<tr>"
cHtml += "<th width='20%'>KEY</th>"
cHtml += "<th width='80%'>VALUE</th>"
cHtml += "</tr>"
cHtml += DisplayHash( hHash )
cHtml += "</table>"
RETURN cHtml
STATIC FUNCTION DisplayHash( hHash )
LOCAL cHtml := ""
LOCAL cKey, cSubKey, xValue
FOR EACH cKey IN hHash:Keys
cHtml += "<tr>"
IF HB_ISHASH( hHash[ cKey ] )
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>" + hb_CStr( cKey ) + "</td>"
cHtml += "<td>-------</td>"
FOR EACH cSubKey IN hHash[ cKey ]:Keys
xValue := hHash[ cKey ][ cSubKey ]
cHtml += "<tr>"
cHtml += "<td>" + hb_cStr( cSubKey ) + "</td>"
cHtml += "<td>" + IIF( Empty( xValue ), "<i>no value</i>", hb_cStr( xValue ) ) + "</td>"
cHtml += "<td>" + hb_CStr( cSubKey ) + "</td>"
cHtml += "<td>" + iif( Empty( xValue ), "<i>no value</i>", hb_CStr( xValue ) ) + "</td>"
cHtml += "</tr>"
NEXT
ELSE
xValue := hHash[ cKey ]
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>" + IIF( Empty( xValue ), "<i>no value</i>", hb_cStr( xValue ) ) + "</td>"
cHtml += "<td>" + hb_CStr( cKey ) + "</td>"
cHtml += "<td>" + iif( Empty( xValue ), "<i>no value</i>", hb_CStr( xValue ) ) + "</td>"
ENDIF
cHtml += "</tr>"
NEXT

93
harbour/extras/httpsrv/modules/showcounter.prg
View File

@@ -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

3
harbour/extras/httpsrv/modules/testajax.prg
View File

@@ -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

108
harbour/src/rdd/usrrdd/rdds/hscdx.prg
View File

@@ -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: <RDDNAME>_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

32
harbour/src/rdd/usrrdd/rdds/rlcdx.prg
View File

@@ -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: <RDDNAME>_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

2
harbour/tests/mathtest.prg
View File

@@ -9,6 +9,8 @@ PROCEDURE Main()
LOCAL nOldMathErrMode
LOCAL bOldMathErr
CLS
? "Testing math function: EXP(), LOG() and SQRT():"
?
? " I) Test with correct arguments:"

2
harbour/tests/memfile.prg
View File

@@ -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

28
harbour/tests/memory.prg
View File

@@ -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

153
harbour/tests/memtst.prg
View File

@@ -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

10
harbour/tests/memvar.prg
View File

@@ -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

4
harbour/tests/newrdd.prg
View File

@@ -2,12 +2,12 @@
* $Id$
*/
REQUEST _DBF
PROCEDURE Main()
LOCAL nI, aArray
REQUEST _DBF
rddSetDefault( "DBF" )
SET EXCLUSIVE OFF