2012-11-26 22:47 UTC+0100 Viktor Szakats (harbour syenar.net)

* src/rtl/Makefile
  + src/rtl/hbtest.prg
  * include/harbour.hbx
    + added simple regression test framework in core, so
      such tests can be easily added to contribs and 3rd
      party projects. It's based on the engine used in
      hbtest.
      Usage:
          #include "hbtest.ch"
          HBTEST <expression> IS <expected value>
      F.e.:
          HBTEXT 2 + 2 IS 4

  * contrib/hbgt/tests/test.prg
    + use the new experimental regression test framework
      in core.

  * utils/hbmk2/hbmk2.prg
    + added note to help text about scripts being executed
      under a default codepage of UTF-8

  * contrib/gtwvg/class.prg
  * contrib/gtwvg/dataref.prg
  * contrib/gtwvg/drawarea.prg
  * contrib/gtwvg/menubar.prg
  * contrib/gtwvg/wnd.prg
  * contrib/hbamf/readme.txt
  * contrib/hbgd/gd.prg
  * contrib/hbhttpd/core.prg
  * contrib/hbtip/mail.prg
  * contrib/xhb/cstruct.prg
  * contrib/xhb/dumpvar.prg
  * contrib/xhb/xdbmodst.prg
  * extras/hbdoc/genhtml.prg
  * extras/httpsrv/session.prg
  * src/debug/debugger.prg
  * src/rtl/tgetlist.prg
  * src/rtl/tobject.prg
  * src/rtl/valtoexp.prg
  * tests/clasname.prg
  * utils/hbmk2/hbmk2.prg
    * :CLASSNAME -> :CLASSNAME()

  * contrib/hbct/addascii.c
  * contrib/hbct/charmirr.c
  * contrib/hbct/charrepl.c
  * contrib/hbct/charsort.c
  * contrib/hbct/charswap.c
  * contrib/hbct/justify.c
  * contrib/hbct/pos2.c
  * contrib/hbct/relation.c
  * contrib/hbct/wordrepl.c
  * contrib/hbgt/chrcount.c
  * extras/gfspell/spellc.c
    * minor cleanups

  * utils/hbtest/hbtest.prg
  * utils/hbtest/rt_main.ch
    * cleanups
This commit is contained in:
Viktor Szakats
2012-11-26 22:02:46 +00:00
parent c4957bf854
commit 0d37a4455b
38 changed files with 447 additions and 146 deletions

View File

@@ -10,6 +10,67 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2012-11-26 22:47 UTC+0100 Viktor Szakats (harbour syenar.net)
* src/rtl/Makefile
+ src/rtl/hbtest.prg
* include/harbour.hbx
+ added simple regression test framework in core, so
such tests can be easily added to contribs and 3rd
party projects. It's based on the engine used in
hbtest.
Usage:
#include "hbtest.ch"
HBTEST <expression> IS <expected value>
F.e.:
HBTEXT 2 + 2 IS 4
* contrib/hbgt/tests/test.prg
+ use the new experimental regression test framework
in core.
* utils/hbmk2/hbmk2.prg
+ added note to help text about scripts being executed
under a default codepage of UTF-8
* contrib/gtwvg/class.prg
* contrib/gtwvg/dataref.prg
* contrib/gtwvg/drawarea.prg
* contrib/gtwvg/menubar.prg
* contrib/gtwvg/wnd.prg
* contrib/hbamf/readme.txt
* contrib/hbgd/gd.prg
* contrib/hbhttpd/core.prg
* contrib/hbtip/mail.prg
* contrib/xhb/cstruct.prg
* contrib/xhb/dumpvar.prg
* contrib/xhb/xdbmodst.prg
* extras/hbdoc/genhtml.prg
* extras/httpsrv/session.prg
* src/debug/debugger.prg
* src/rtl/tgetlist.prg
* src/rtl/tobject.prg
* src/rtl/valtoexp.prg
* tests/clasname.prg
* utils/hbmk2/hbmk2.prg
* :CLASSNAME -> :CLASSNAME()
* contrib/hbct/addascii.c
* contrib/hbct/charmirr.c
* contrib/hbct/charrepl.c
* contrib/hbct/charsort.c
* contrib/hbct/charswap.c
* contrib/hbct/justify.c
* contrib/hbct/pos2.c
* contrib/hbct/relation.c
* contrib/hbct/wordrepl.c
* contrib/hbgt/chrcount.c
* extras/gfspell/spellc.c
* minor cleanups
* utils/hbtest/hbtest.prg
* utils/hbtest/rt_main.ch
* cleanups
2012-11-26 18:51 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbhttpd/widgets.prg
* contrib/hbtip/client.prg

View File

@@ -438,7 +438,7 @@ METHOD WvtDialog:Inkey()
::aObjects[ ::nObjOver ]:nType == DLG_OBJ_SCROLLBAR
oObj := ::aObjects[ ::nObjOver ]
IF oObj:oParent:ClassName == "WVTBROWSE"
IF oObj:oParent:className() == "WVTBROWSE"
nID := oObj:oParent:nID
IF ( n := AScan( ::aObjects, {| o | o:nID == nID } ) ) > 0
::nCurObj := n
@@ -503,7 +503,7 @@ METHOD WvtDialog:Inkey()
IF ::nUseObj > 0
IF !( ::lEventHandled := ::aObjects[ ::nUseObj ]:LeftDown() )
::lEventHandled := ::Eval( ::aObjects[ ::nUseObj ]:bOnLeftDown )
IF ::aObjects[ ::nUseObj ]:className == "WVTBROWSE"
IF ::aObjects[ ::nUseObj ]:className() == "WVTBROWSE"
::lEventHandled := .F.
ENDIF
ENDIF

View File

@@ -100,7 +100,7 @@ METHOD WvgDataRef:new()
METHOD WvgDataRef:getData()
DO CASE
CASE ::className == "COMBOBOX"
CASE ::className() == "COMBOBOX"
IF HB_ISOBJECT( ::XbpListBox ) .AND. HB_ISBLOCK( ::XbpListBox:dataLink )
::sl_editBuffer := ::XbpListBox:getData()
ELSEIF HB_ISOBJECT( ::XbpSLE ) .AND. HB_ISBLOCK( ::XbpSLE:dataLink )
@@ -109,14 +109,14 @@ METHOD WvgDataRef:getData()
::sl_editBuffer := ::XbpListBox:getData()
ENDIF
CASE ::className == "EDIT"
CASE ::className() == "EDIT"
::sl_editBuffer := Wvg_GetMessageText( ::hWnd, WM_GETTEXT, ::bufferLength + 1 )
CASE ::className == "LISTBOX"
CASE ::className() == "LISTBOX"
::sl_editBuffer := Wvg_LBGetCurSel( ::hWnd ) + 1
#if 0 /* This is contrary the documentation of Xbase++ */
IF ::oParent:className == "COMBOBOX"
IF ::oParent:className() == "COMBOBOX"
::sl_editBuffer := {}
FOR i := 1 TO ::numItems()
AAdd( ::sl_editBuffer, ::getItem( i ) )
@@ -147,30 +147,30 @@ METHOD WvgDataRef:setData( xValue, mp2 )
DO CASE
CASE ::className == "BUTTON" /* CheckBox, Radio, 3State */
CASE ::className() == "BUTTON" /* CheckBox, Radio, 3State */
::sendMessage( BM_SETCHECK, iif( ::sl_editBuffer, BST_CHECKED, BST_UNCHECKED ), 0 )
CASE ::className == "LISTBOX" /* Single Selection */
CASE ::className() == "LISTBOX" /* Single Selection */
IF HB_ISNUMERIC( ::sl_editBuffer )
RETURN Wvg_LBSetCurSel( ::hWnd, ::sl_editBuffer - 1 ) >= 0
ENDIF
CASE ::className == "SysTreeView32"
CASE ::className() == "SysTreeView32"
IF ::sl_editBuffer != NIL .AND. ::sl_editBuffer:hItem != NIL
Wvg_TreeView_SelectItem( ::hWnd, ::sl_editBuffer:hItem )
ENDIF
CASE ::className == "EDIT"
CASE ::className() == "EDIT"
IF HB_ISSTRING( ::sl_editBuffer )
Wvg_SendMessageText( ::hWnd, WM_SETTEXT, 0, ::sl_editBuffer )
ENDIF
CASE ::className == "SCROLLBAR"
CASE ::className() == "SCROLLBAR"
IF ::sl_editBuffer != NIL
wapi_SetScrollPos( ::pWnd, SB_CTL, ::sl_editBuffer, .T. )
ENDIF
CASE ::className == "COMBOBOX"
CASE ::className() == "COMBOBOX"
IF HB_ISARRAY( ::sl_editBuffer )
// NOT sure which way it should behave.
// XBase++ documentation IN this regard is crappy.

View File

@@ -101,7 +101,7 @@ METHOD WvgDrawingArea:create( oParent, oOwner, aPos, aSize, aPresParams, lVisibl
::oParent:addChild( Self )
Wvg_RegisterClass_ByName( ::className )
Wvg_RegisterClass_ByName( ::className() )
::createControl()

View File

@@ -334,11 +334,11 @@ METHOD WvgMenuBar:putItem( aItem, nPos, lInsert )
ENDIF
IF ++::nPass == 1
IF ::oParent:className $ "WVGCRT,WVGDIALOG"
IF ::oParent:className() $ "WVGCRT,WVGDIALOG"
Wvg_SetMenu( ::oParent:getHWND(), ::hMenu )
ENDIF
ELSE
IF ::oParent:className $ "WVGCRT,WVGDIALOG"
IF ::oParent:className() $ "WVGCRT,WVGDIALOG"
Wvg_DrawMenuBar( ::oParent:getHWND() )
ENDIF
ENDIF

View File

@@ -473,7 +473,7 @@ METHOD WvgWindow:setColorBG( nRGB )
::clr_BG := nRGB
::hBrushBG := hBrush
IF ::className == "WVGDIALOG" .OR. __objGetClsName( Self ) == "WVGCHECKBOX"
IF ::className() == "WVGDIALOG" .OR. __objGetClsName( Self ) == "WVGCHECKBOX"
Wvg_SetCurrentBrush( ::hWnd, ::hBrushBG )
ENDIF
ENDIF
@@ -576,7 +576,7 @@ METHOD WvgWindow:isDerivedFrom( cClassORoObject )
ENDIF
ELSEIF HB_ISOBJECT( cClassORoObject )
IF Upper( SubStr( cClassORoObject:className, 4 ) ) == Upper( SubStr( cCls, 4 ) )
IF Upper( SubStr( cClassORoObject:className(), 4 ) ) == Upper( SubStr( cCls, 4 ) )
lTrue := .T.
ENDIF
ENDIF
@@ -1235,7 +1235,7 @@ METHOD WvgWindow:createControl()
hWnd := Wvg_CreateWindowEx( ;
::exStyle, ;
::className, ;
::className(), ;
"", ; /* window name */
::style, ;
aPosSz[ 1 ], aPosSz[ 2 ], ;

View File

@@ -54,7 +54,7 @@ Short description of Harbour functions
LOCAL lClose
IF HB_ISOBJECT( xVal )
IF xVal:className == "WORKAREAEXPORT"
IF xVal:className() == "WORKAREAEXPORT"
lClose := xVal:lCloseWA
SELECT ( xVal:nWorkArea )

View File

@@ -56,10 +56,8 @@
HB_FUNC( ADDASCII )
{
int iNoRet;
/* suppressing return value ? */
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
if( HB_ISCHAR( 1 ) )
{

View File

@@ -56,10 +56,8 @@
HB_FUNC( CHARMIRR )
{
int iNoRet;
/* suppressing return value ? */
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
/* param check */
if( HB_ISCHAR( 1 ) )

View File

@@ -56,11 +56,10 @@
HB_FUNC( CHARREPL )
{
int iNoRet;
HB_SIZE sSearchLen, sReplaceLen;
/* suppressing return value ? */
iNoRet = ct_getref() && HB_ISBYREF( 2 );
int iNoRet = ct_getref() && HB_ISBYREF( 2 );
HB_SIZE sSearchLen, sReplaceLen;
/* param check */
if( ( sSearchLen = hb_parclen( 1 ) ) > 0 && HB_ISCHAR( 2 ) &&

View File

@@ -97,10 +97,8 @@ _hb_do_sortdescend( const void * p1, const void * p2 )
HB_FUNC( CHARSORT )
{
int iNoRet;
/* suppressing return value ? */
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
/* param check I */
if( HB_ISCHAR( 1 ) )

View File

@@ -64,10 +64,8 @@
/* helper function for the charswap and wordswap functions */
static void do_charswap( int iSwitch )
{
int iNoRet;
/* suppress return value ? */
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
/* param check */
if( HB_ISCHAR( 1 ) )

View File

@@ -61,9 +61,7 @@
/* helper function for the justxxx() functions */
static void do_justify( int iSwitch )
{
int iNoRet;
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
if( HB_ISCHAR( 1 ) )
{

View File

@@ -56,9 +56,7 @@
HB_FUNC( POSCHAR )
{
int iNoRet;
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
if( hb_parclen( 1 ) > 0 )
{
@@ -267,9 +265,7 @@ HB_FUNC( POSINS )
HB_FUNC( POSREPL )
{
int iNoRet;
iNoRet = ct_getref() && HB_ISBYREF( 1 );
int iNoRet = ct_getref() && HB_ISBYREF( 1 );
if( HB_ISCHAR( 1 ) )
{

View File

@@ -131,9 +131,7 @@ HB_FUNC( CHARRELA )
HB_FUNC( CHARRELREP )
{
int iNoRet;
iNoRet = ct_getref() && HB_ISBYREF( 4 );
int iNoRet = ct_getref() && HB_ISBYREF( 4 );
if( HB_ISCHAR( 1 ) && HB_ISCHAR( 2 ) && HB_ISCHAR( 3 ) &&
HB_ISCHAR( 4 ) && HB_ISCHAR( 5 ) )

View File

@@ -56,15 +56,12 @@
HB_FUNC( WORDREPL )
{
int iNoRet;
int iMultiPass;
/* suppressing return value ? */
int iNoRet = ct_getref() && HB_ISBYREF( 2 );
int iMultiPass = ct_getatmupa();
HB_SIZE sSearchLen, sReplaceLen;
/* suppressing return value ? */
iNoRet = ct_getref() && HB_ISBYREF( 2 );
iMultiPass = ct_getatmupa();
/* param check */
if( ( sSearchLen = hb_parclen( 1 ) ) / 2 > 0 && HB_ISCHAR( 2 ) &&
( sReplaceLen = hb_parclen( 3 ) ) / 2 > 0 )

View File

@@ -181,7 +181,7 @@ FUNCTION gdImageToString( oImage )
LOCAL cString
IF HB_ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) .AND. oImage:cType != NIL
IF HB_ISOBJECT( oImage ) .AND. ( oImage:className() == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) .AND. oImage:cType != NIL
SWITCH oImage:cType
CASE "jpeg"
cString := oImage:ToStringJpeg()
@@ -203,7 +203,7 @@ PROCEDURE gdImageToFile( oImage, cFile )
hb_default( @cFile, "image" )
IF HB_ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) .AND. oImage:cType != NIL
IF HB_ISOBJECT( oImage ) .AND. ( oImage:className() == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) ) .AND. oImage:cType != NIL
SWITCH oImage:cType
CASE "jpeg"
cString := oImage:ToStringJpeg()
@@ -231,7 +231,7 @@ PROCEDURE gdImageToHandle( oImage, nHandle )
hb_default( @nHandle, 1 )
IF HB_ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
IF HB_ISOBJECT( oImage ) .AND. ( oImage:className() == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
IF oImage:cType != NIL
SWITCH oImage:cType
CASE "jpeg"

View File

@@ -28,8 +28,7 @@ HB_FUNC( GT_CHRCOUNT )
each character of s1 */
for( count = 0, pos2 = 1; pos2 <= len; s2++, pos2++ )
if( *s1 == *s2 ) /* character matches s1 */
count++;
/* increment counter */
count++; /* increment counter */
hb_retns( count );
}

View File

@@ -4,24 +4,26 @@
#require "hbgt"
#include "hbtest.ch"
PROCEDURE Main()
? 'gt_AscPos( "Harbour", 1 ) =>', gt_AscPos( "Harbour", 1 )
? 'gt_AtDiff( "This Is Harbour", "This Is Clipper" ) =>', gt_AtDiff( "This Is Harbour", "This Is Clipper" )
? 'gt_CharEven( "The_Power_Of_Harbour" ) =>', gt_CharEven( "The_Power_Of_Harbour" )
? 'gt_CharOdd( "The_Power_Of_Harbour" ) =>', gt_CharOdd( "The_Power_Of_Harbour" )
? 'gt_ChrCount( "s", "she sells shells by the sea shore" ) =>', gt_ChrCount( "s", "she sells shells by the sea shore" )
? 'gt_ChrTotal( "sl", "she sells shells by the sea shore" ) =>', gt_ChrTotal( "sl", "she sells shells by the sea shore" )
? 'gt_CharMix( "CLIPPER", "harbour" ) =>', gt_CharMix( "CLIPPER", "harbour" )
? 'gt_AsciiSum( "harbour" ) =>', gt_AsciiSum( "harbour" )
? 'gt_ChrFirst( "Ho", "the power of Harbour" ) =>', gt_ChrFirst( "Ho", "the power of Harbour" )
? 'gt_StrCount( "the", "the cat sat on the mat" ) =>', gt_StrCount( "the", "the cat sat on the mat" )
? 'gt_StrCSPN( "this is a test", "as " ) =>', gt_StrCSPN( "this is a test", "as " )
? 'gt_StrCSPN( "this is a test", "elnjpq" ) =>', gt_StrCSPN( "this is a test", "elnjpq" )
? 'gt_StrDiff( "the cat", "the rat" ) =>', gt_StrDiff( "the cat", "the rat" )
? 'gt_StrExpand( "HARBOUR", 2, "-" ) =>', gt_StrExpand( "HARBOUR", 2, "-" )
? 'gt_StrLeft( "this is a test", "hsit " ) =>', gt_StrLeft( "this is a test", "hsit " )
? 'gt_StrPBRK( "this is a test", "sa " ) =>', gt_StrPBRK( "this is a test", "sa " )
? 'gt_StrRight( "this is a test", "teas " ) =>', gt_StrRight( "this is a test", "teas " )
HBTEST gt_AscPos( "Harbour", 1 ) IS 72
HBTEST gt_AtDiff( "This Is Harbour", "This Is Clipper" ) IS 9
HBTEST gt_CharEven( "The_Power_Of_Harbour" ) IS "h_oe_fHror"
HBTEST gt_CharOdd( "The_Power_Of_Harbour" ) IS "TePwrO_abu"
HBTEST gt_ChrCount( "s", "she sells shells by the sea shore" ) IS 7
HBTEST gt_ChrTotal( "sl", "she sells shells by the sea shore" ) IS 11
HBTEST gt_CharMix( "CLIPPER", "harbour" ) IS "ChLaIrPbPoEuRr"
HBTEST gt_AsciiSum( "harbour" ) IS 755
HBTEST gt_ChrFirst( "Ho", "the power of Harbour" ) IS 111
HBTEST gt_StrCount( "the", "the cat sat on the mat" ) IS 2
HBTEST gt_StrCSPN( "this is a test", "as " ) IS 3
HBTEST gt_StrCSPN( "this is a test", "elnjpq" ) IS 11
HBTEST gt_StrDiff( "the cat", "the rat" ) IS "rat"
HBTEST gt_StrExpand( "HARBOUR", 2, "-" ) IS "H--A--R--B--O--U--R"
HBTEST gt_StrLeft( "this is a test", "hsit " ) IS 8
HBTEST gt_StrPBRK( "this is a test", "sa " ) IS "s is a test"
HBTEST gt_StrRight( "this is a test", "teas " ) IS 8
RETURN

View File

@@ -1110,7 +1110,7 @@ STATIC FUNCTION cvt2str( xI, lLong )
cI += ",XVALUE=" + cvt2str( xJ )
ENDIF
ENDIF
RETURN "[O:" + xI:ClassName + cI + "]"
RETURN "[O:" + xI:ClassName() + cI + "]"
ELSEIF cValtype == "D"
RETURN iif( lLong, "[D]:", "" ) + DToC( xI )
ELSEIF cValtype == "L"

View File

@@ -251,7 +251,7 @@ METHOD SetFieldOption( cPart, cOption, cValue ) CLASS TIPMail
METHOD Attach( oSubPart ) CLASS TIPMail
IF HB_ISOBJECT( oSubPart ) .AND. oSubPart:ClassName == "TIPMAIL"
IF HB_ISOBJECT( oSubPart ) .AND. oSubPart:ClassName() == "TIPMAIL"
// reset wrong content-type
IF At( "multipart/", Lower( ::GetFieldPart( "Content-Type" ) ) ) == 0
::hHeaders[ "Content-Type" ] := "multipart/mixed"

View File

@@ -354,7 +354,7 @@ STATIC PROCEDURE AllocateMembers( oStructure )
aCTypes := oStructure:aCTypes
// TraceLog( "Scaning: " + oStructure:ClassName )
// TraceLog( "Scaning: " + oStructure:className() )
FOR EACH CType IN aCTypes
IF CType > CTYPE_STRUCTURE .AND. CType < CTYPE_STRUCTURE_PTR
@@ -363,7 +363,7 @@ STATIC PROCEDURE AllocateMembers( oStructure )
ENDIF
NEXT
// TraceLog( "Finished: " + oStructure:ClassName )
// TraceLog( "Finished: " + oStructure:className() )
RETURN
@@ -493,12 +493,12 @@ STATIC FUNCTION SayMembers( cPad, lShowMembers, lReturnString )
ENDIF
#if 0
QOut( cPad + SubStr( QSelf():ClassName, 13 ) )
QOut( cPad + Replicate( "-", Len( SubStr( QSelf():ClassName, 13 ) ) ) )
QOut( cPad + SubStr( QSelf():className(), 13 ) )
QOut( cPad + Replicate( "-", Len( SubStr( QSelf():className(), 13 ) ) ) )
#endif
cOut += cPad + SubStr( QSelf():ClassName, 13 )
cOut += hb_eol() + cPad + Replicate( "-", Len( SubStr( QSelf():ClassName, 13 ) ) )
cOut += cPad + SubStr( QSelf():className(), 13 )
cOut += hb_eol() + cPad + Replicate( "-", Len( SubStr( QSelf():className(), 13 ) ) )
FOR EACH xProperty IN QSelf():Array
IF hb_Is_CStructure( xProperty )
@@ -628,7 +628,7 @@ STATIC FUNCTION Init( aValues )
EXIT
ENDIF
IF Left( xProperty:ClassName, 11 ) == "C Structure"
IF Left( xProperty:className(), 11 ) == "C Structure"
xProperty:Init( aValues[ xProperty:__enumIndex() ] )
ELSE
xProperty := aValues[ xProperty:__enumIndex() ]

View File

@@ -111,7 +111,7 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion
DO CASE
CASE cType == "O"
IF ! lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY"
IF ! lAssocAsObj .AND. xVar:className() == "TASSOCIATIVEARRAY"
cString += Space( nIndent ) + "Type='Associative' -> " + hb_eol()
// Keys extraction.
IF Len( xVar:Keys ) > 0
@@ -129,7 +129,7 @@ STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursion
cString += Space( nIndent ) + "}" + hb_eol()
ENDIF
ELSE
cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + hb_eol()
cString += Space( nIndent ) + "<" + xVar:className() + " Object>" + hb_eol()
cString += Space( nIndent ) + " | " + hb_eol()
cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + hb_eol()
cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )

View File

@@ -138,7 +138,7 @@ FUNCTION dbModifyStructure( cFile )
ENDIF
RECOVER USING oErr
IF oErr:ClassName == "ERROR"
IF oErr:className() == "ERROR"
IF oErr:genCode == EG_RENAME
// This kind of error must be reported
lRet := Throw( oErr )

View File

@@ -336,14 +336,12 @@ HB_FUNC( C_METAFONE )
/* GN -> N */
if( sMeta[ iStrPtr + 1 ] == 'N' )
{
/* Put in the first return character and increment the pointer. */
sReturn[ iRetPtr++ ] = 'N';
iStrPtr += 2;
}
else if( sMeta[ iStrPtr + 1 ] == 'I' )
{
/* Put in the first return character and increment the pointer. */
sReturn[ iRetPtr++ ] = 'K';
iStrPtr += 2;

View File

@@ -175,7 +175,7 @@ METHOD EndSection( cSection, cFilename ) CLASS GenerateHTML
METHOD AddReference( oEntry, cReference, cSubReference ) CLASS GenerateHTML
IF HB_ISOBJECT( oEntry ) .AND. oEntry:ClassName == "ENTRY"
IF HB_ISOBJECT( oEntry ) .AND. oEntry:ClassName() == "ENTRY"
::OpenTag( "a", "href", ::TargetFilename + ::cExtension + "#" + oEntry:Filename ):Append( oEntry:Name ):CloseTag( "a" ):Append( oEntry:OneLiner ):Newline()
ELSE
IF cSubReference == NIL

View File

@@ -822,7 +822,7 @@ METHOD Decode( cData ) CLASS uhttpd_Session
#if 0
CASE "O"
// TraceLog( "Decode - xVal - Object", xVal )
IF xVal:classname == "TASSOCIATIVEARRAY"
IF xVal:className() == "TASSOCIATIVEARRAY"
// TraceLog( "Decode - xVal - Object - TAssociativeArray - Keys", xVal:Keys )
FOR EACH cKey IN xVal:Keys
// TraceLog( "Decode TassociativeArray - cKey, xVal:SendKey( cKey )", cKey, xVal:SendKey( cKey ) )

View File

@@ -1387,6 +1387,8 @@ DYNAMIC __hbdoc_LoadDir
DYNAMIC __hbdoc_LoadHBD
DYNAMIC __hbdoc_SaveHBD
DYNAMIC __hbdoc_ToSource
DYNAMIC __hbtest_Setup
DYNAMIC __hbtest_Call
DYNAMIC __HBHash
DYNAMIC __HBLogical
DYNAMIC __HBNil

View File

@@ -3410,7 +3410,7 @@ FUNCTION __dbgCStr( xVal )
CASE "L" ; RETURN iif( xVal, ".T.", ".F." )
CASE "S" ; RETURN "@" + xVal:name + "()"
CASE "B" ; RETURN "{|| ... }"
CASE "O" ; RETURN "{ " + xVal:className + " Object }"
CASE "O" ; RETURN "{ " + xVal:className() + " Object }"
CASE "A" ; RETURN "{ Array of " + hb_ntos( Len( xVal ) ) + " Items }"
CASE "H" ; RETURN "{ Hash of " + hb_ntos( Len( xVal ) ) + " Items }"
CASE "P" ; RETURN "<pointer>"

View File

@@ -239,6 +239,7 @@ PRG_SOURCES := \
hbfilehi.prg \
hbi18n2.prg \
hbini.prg \
hbtest.prg \
input.prg \
langcomp.prg \
langlgcy.prg \

258
harbour/src/rtl/hbtest.prg Normal file
View File

@@ -0,0 +1,258 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Regression tests for the runtime library (main)
*
* Copyright 1999-2012 Viktor Szakats (harbour syenar.net)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "error.ch"
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 15
#define TEST_RESULT_COL3_WIDTH 40
#define TEST_RESULT_COL4_WIDTH 85
#define TEST_RESULT_COL5_WIDTH 85
STATIC s_hParams := { => }
PROCEDURE __hbtest_Setup( cName, xValue )
IF HB_ISSTRING( cName ) .AND. ! Empty( cName )
IF PCount() > 1
s_hParams[ cName ] := xValue
ELSEIF cName $ s_hParams
hb_HDel( s_hParams, cName )
ENDIF
ENDIF
RETURN
PROCEDURE __hbtest_Call( cBlock, bBlock, xResultExpected )
LOCAL xResult
LOCAL oError
LOCAL bOldError
LOCAL lPPError
LOCAL lFailed
LOCAL bOut
IF HB_ISSTRING( cBlock )
lPPError := .F.
ELSE
cBlock := "[Preprocessor error]"
lPPError := .T.
ENDIF
bOldError := ErrorBlock( {| oError | Break( oError ) } )
BEGIN SEQUENCE
xResult := Eval( bBlock )
RECOVER USING oError
xResult := ErrorMessage( oError )
END SEQUENCE
ErrorBlock( bOldError )
IF !( ValType( xResult ) == ValType( xResultExpected ) )
IF ValType( xResultExpected ) == "C" .AND. ValType( xResult ) $ "ABMO"
lFailed := !( XToStr( xResult ) == xResultExpected )
ELSE
lFailed := .T.
ENDIF
ELSE
lFailed := !( xResult == xResultExpected )
ENDIF
IF lFailed .OR. lPPError .OR. hb_HGetDef( s_hParams, "showall", .T. )
bOut := hb_HGetDef( s_hParams, "output", {| cMsg | OutStd( cMsg ) } )
IF lFailed
Eval( bOut, PadR( iif( lFailed, "!", " " ), TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( ProcName( 1 ) + "(" + LTrim( Str( ProcLine( 1 ), 5 ) ) + ")", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) +;
hb_eol() +;
Space( 5 ) + " Result: " + XToStr( xResult ) +;
hb_eol() +;
Space( 5 ) + "Expected: " + XToStr( xResultExpected ) +;
hb_eol() )
ELSE
Eval( bOut, PadR( iif( lFailed, "!", " " ), TEST_RESULT_COL1_WIDTH ) + " " +;
PadR( ProcName( 1 ) + "(" + LTrim( Str( ProcLine( 1 ), 5 ) ) + ")", TEST_RESULT_COL2_WIDTH ) + " " +;
PadR( cBlock, TEST_RESULT_COL3_WIDTH ) + " -> " +;
PadR( XToStr( xResult ), TEST_RESULT_COL4_WIDTH ) + " | " +;
PadR( XToStr( xResultExpected ), TEST_RESULT_COL5_WIDTH ) +;
hb_eol() )
ENDIF
ENDIF
RETURN
STATIC FUNCTION ErrorMessage( oError )
LOCAL cMessage := ""
LOCAL tmp
IF HB_ISNUMERIC( oError:severity )
SWITCH oError:severity
CASE ES_WHOCARES ; cMessage += "M " ; EXIT
CASE ES_WARNING ; cMessage += "W " ; EXIT
CASE ES_ERROR ; cMessage += "E " ; EXIT
CASE ES_CATASTROPHIC ; cMessage += "C " ; EXIT
ENDSWITCH
ENDIF
IF HB_ISNUMERIC( oError:genCode )
cMessage += hb_ntos( oError:genCode ) + " "
ENDIF
IF HB_ISSTRING( oError:subsystem )
cMessage += oError:subsystem + " "
ENDIF
IF HB_ISNUMERIC( oError:subCode )
cMessage += hb_ntos( oError:subCode ) + " "
ENDIF
IF HB_ISSTRING( oError:description )
cMessage += oError:description + " "
ENDIF
IF ! Empty( oError:operation )
cMessage += "(" + oError:operation + ") "
ENDIF
IF ! Empty( oError:filename )
cMessage += "<" + oError:filename + "> "
ENDIF
IF HB_ISNUMERIC( oError:osCode )
cMessage += "OS:" + hb_ntos( oError:osCode ) + " "
ENDIF
IF HB_ISNUMERIC( oError:tries )
cMessage += "#:" + hb_ntos( oError:tries ) + " "
ENDIF
IF HB_ISARRAY( oError:Args )
cMessage += "A:" + hb_ntos( Len( oError:Args ) ) + ":"
FOR tmp := 1 TO Len( oError:Args )
cMessage += ValType( oError:Args[ tmp ] ) + ":" + XToStrE( oError:Args[ tmp ] )
IF tmp < Len( oError:Args )
cMessage += ";"
ENDIF
NEXT
cMessage += " "
ENDIF
IF oError:canDefault .OR. ;
oError:canRetry .OR. ;
oError:canSubstitute
cMessage += "F:"
IF oError:canDefault
cMessage += "D"
ENDIF
IF oError:canRetry
cMessage += "R"
ENDIF
IF oError:canSubstitute
cMessage += "S"
ENDIF
ENDIF
RETURN cMessage
FUNCTION XToStr( xValue )
SWITCH ValType( xValue )
CASE "C"
xValue := StrTran( xValue, Chr( 0 ), '" + Chr( 0 ) + "' )
xValue := StrTran( xValue, Chr( 9 ), '" + Chr( 9 ) + "' )
xValue := StrTran( xValue, Chr( 10 ), '" + Chr( 10 ) + "' )
xValue := StrTran( xValue, Chr( 13 ), '" + Chr( 13 ) + "' )
xValue := StrTran( xValue, Chr( 26 ), '" + Chr( 26 ) + "' )
RETURN '"' + xValue + '"'
CASE "N" ; RETURN hb_ntos( xValue )
CASE "D" ; RETURN "0d" + iif( Empty( xValue ), "0", DToS( xValue ) )
CASE "T" ; RETURN "t" + '"' + hb_TSToStr( xValue, .T. ) + '"'
CASE "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE "O" ; RETURN "{ " + xValue:className() + " Object }"
CASE "U" ; RETURN "NIL"
CASE "B" ; RETURN "{|| ... }"
CASE "A" ; RETURN "{ Array of " + hb_ntos( Len( xValue ) ) + " Items }"
CASE "H" ; RETURN "{ Hash of " + hb_ntos( Len( xValue ) ) + " Items }"
CASE "M" ; RETURN "M:" + '"' + xValue + '"'
CASE "S" ; RETURN "@" + xValue:name + "()"
CASE "P" ; RETURN "<pointer>"
ENDSWITCH
RETURN iif( xValue == NIL, "NIL", "" )
FUNCTION XToStrE( xValue )
LOCAL cType := ValType( xValue )
SWITCH cType
CASE "C"
xValue := StrTran( xValue, Chr( 0 ), '" + Chr( 0 ) + "' )
xValue := StrTran( xValue, Chr( 9 ), '" + Chr( 9 ) + "' )
xValue := StrTran( xValue, Chr( 10 ), '" + Chr( 10 ) + "' )
xValue := StrTran( xValue, Chr( 13 ), '" + Chr( 13 ) + "' )
xValue := StrTran( xValue, Chr( 26 ), '" + Chr( 26 ) + "' )
RETURN xValue
CASE "N" ; RETURN hb_ntos( xValue )
CASE "D" ; RETURN DToS( xValue )
CASE "T" ; RETURN "t" + '"' + hb_TSToStr( xValue, .T. ) + '"'
CASE "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE "O" ; RETURN "{ " + xValue:className() + " Object }"
CASE "U" ; RETURN "NIL"
CASE "B" ; RETURN "{|| ... }"
CASE "A" ; RETURN "{ Array of " + hb_ntos( Len( xValue ) ) + " Items }"
CASE "H" ; RETURN "{ Hash of " + hb_ntos( Len( xValue ) ) + " Items }"
CASE "M" ; RETURN "M:" + xValue
CASE "S" ; RETURN "@" + xValue:name + "()"
CASE "P" ; RETURN "<pointer>"
ENDSWITCH
RETURN iif( xValue == NIL, "NIL", "" )

View File

@@ -1202,7 +1202,7 @@ METHOD GUIPostValidate( oGet, oGUI, aMsg ) CLASS HBGetList
SetPos( oGet:row, oGet:col )
::ShowScoreBoard()
IF ! ( oGUI:ClassName == "TBROWSE" )
IF ! ( oGUI:ClassName() == "TBROWSE" )
oGUI:Select( oGet:varGet() )
ENDIF

View File

@@ -80,7 +80,7 @@ FUNCTION HBObject()
oClass:SetOnError( @HBObject_DftonError() )
oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", Self:className, cMsg, iif( Left( cMsg, 1 ) == "_", 1005, 1004 ) ) }, HB_OO_CLSTP_EXPORTED )
oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", Self:className(), cMsg, iif( Left( cMsg, 1 ) == "_", 1005, 1004 ) ) }, HB_OO_CLSTP_EXPORTED )
#if 0
oClass:AddMultiData( , , HB_OO_CLSTP_EXPORTED, { "CLASS" }, .F. )

View File

@@ -63,7 +63,7 @@ FUNCTION hb_CStr( xVal )
CASE "L" ; RETURN iif( xVal, ".T.", ".F." )
CASE "S" ; RETURN "@" + xVal:name + "()"
CASE "B" ; RETURN "{|| ... }"
CASE "O" ; RETURN "{ " + xVal:className + " Object }"
CASE "O" ; RETURN "{ " + xVal:className() + " Object }"
CASE "A" ; RETURN "{ Array of " + hb_ntos( Len( xVal ) ) + " Items }"
CASE "H" ; RETURN "{ Hash of " + hb_ntos( Len( xVal ) ) + " Items }"
CASE "P" ; RETURN "<pointer>"

View File

@@ -3,7 +3,7 @@
* $Id$
*/
// The following code tests the application of the className message
// The following code tests the application of the className method
// against the "fundemental" types of Clipper.
// These tests were written by Dave Pearson <davep@hagbard.demon.co.uk>
@@ -14,43 +14,43 @@ PROCEDURE Main()
// First, try all the types. This checks that the VM can cope.
AEval( { NIL, {}, "", 0, CToD( "" ), .F., {|| NIL }, ErrorNew() }, ;
{| x | QOut( x:className ) } )
{| x | QOut( x:className() ) } )
// Now try against values "in the code". This checks that the
// compiler can cope.
?
? NIL:className
? {}:className
? "":className
? 0:className
? CToD( "" ):className
? .F. :className
? {|| NIL }:className
? ErrorNew():className
? NIL:className()
? {}:className()
? "":className()
? 0:className()
? CToD( "" ):className()
? .F. :className()
? {|| NIL }:className()
? ErrorNew():className()
// For fun, do it again while ensuring the parser doesn't care about
// whitespace.
?
? NIL : className
? {} : className
? "" : className
? 0 : className
? CToD( "" ) : className
? .F. : className
? {|| NIL } : className
? ErrorNew() : className
? NIL : className()
? {} : className()
? "" : className()
? 0 : className()
? CToD( "" ) : className()
? .F. : className()
? {|| NIL } : className()
? ErrorNew() : className()
// Now for some sillier ones. If the above work the following should
// work too.
?
? ( NIL:className ):className
? ( NIL:className() ):className()
?
? ( ( NIL:className ):className ):className
? ( ( NIL:className() ):className() ):className()
RETURN

View File

@@ -13522,7 +13522,7 @@ STATIC PROCEDURE __hbshell_Err( oErr, cCommand )
LOCAL xArg, cMessage
cMessage := I_( "Could not execute:" ) + ";;" + cCommand + ";;"
IF oErr:ClassName == "ERROR"
IF oErr:ClassName() == "ERROR"
cMessage += oErr:Description
IF ! Empty( oErr:Operation )
cMessage += " " + oErr:Operation
@@ -14507,7 +14507,7 @@ STATIC PROCEDURE ShowHelp( hbmk, lLong )
I_( "Libraries and object files built with/for CA-Cl*pper won't work with any supported platform/compiler." ) , ;
I_( "Defaults and feature support may vary by platform/compiler." ) , ;
hb_StrFormat( I_( "Options can also be specified in environment variable %1$s" ), _HBMK_ENV_NAME ), ;
I_( ".hb or .hrb file passed as first parameter will be run as Harbour script." ) , ;
I_( ".hb or .hrb file passed as first parameter will be run as Harbour script. Note, for Harbour scripts, the codepage is set to UTF-8 by default." ) , ;
I_( ". (dot) passed as first parameter will enter the interactive Harbour shell." ) }
hb_default( @lLong, .F. )

View File

@@ -81,6 +81,12 @@
#xtranslate hb_eol() => ( Chr( 13 ) + Chr( 10 ) )
#endif
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 20
#define TEST_RESULT_COL3_WIDTH 40
#define TEST_RESULT_COL4_WIDTH 85
#define TEST_RESULT_COL5_WIDTH 85
STATIC s_nPass
STATIC s_nFail
STATIC s_nFhnd
@@ -277,19 +283,19 @@ STATIC PROCEDURE TEST_BEGIN( cParam )
bErrorOld := ErrorBlock( {| oError | Break( oError ) } )
BEGIN SEQUENCE
dbCreate( "_hbtmp_.dbf",;
{ { "TYPE_C" , "C", 15, 0 } ,;
{ "TYPE_C_E" , "C", 15, 0 } ,;
{ "TYPE_D" , "D", 8, 0 } ,;
{ "TYPE_D_E" , "D", 8, 0 } ,;
{ "TYPE_M" , "M", 10, 0 } ,;
{ "TYPE_M_E" , "M", 10, 0 } ,;
{ "TYPE_N_I" , "N", 11, 0 } ,;
{ "TYPE_N_IE", "N", 11, 0 } ,;
{ "TYPE_N_D" , "N", 11, 3 } ,;
{ "TYPE_N_DE", "N", 11, 3 } ,;
{ "TYPE_L" , "L", 1, 0 } ,;
{ "TYPE_L_E" , "L", 1, 0 } } )
dbCreate( "_hbtmp_.dbf", { ;
{ "TYPE_C" , "C", 15, 0 } ,;
{ "TYPE_C_E" , "C", 15, 0 } ,;
{ "TYPE_D" , "D", 8, 0 } ,;
{ "TYPE_D_E" , "D", 8, 0 } ,;
{ "TYPE_M" , "M", 10, 0 } ,;
{ "TYPE_M_E" , "M", 10, 0 } ,;
{ "TYPE_N_I" , "N", 11, 0 } ,;
{ "TYPE_N_IE", "N", 11, 0 } ,;
{ "TYPE_N_D" , "N", 11, 3 } ,;
{ "TYPE_N_DE", "N", 11, 3 } ,;
{ "TYPE_L" , "L", 1, 0 } ,;
{ "TYPE_L_E" , "L", 1, 0 } } )
USE ( "_hbtmp_.dbf" ) NEW ALIAS w_TEST EXCLUSIVE
@@ -460,9 +466,9 @@ FUNCTION XToStr( xValue )
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "M" ; RETURN 'M:"' + xValue + '"'
CASE cType == "B" ; RETURN "{||...}"
CASE cType == "A" ; RETURN "{.[" + LTrim( Str( Len( xValue ) ) ) + "].}"
CASE cType == "M" ; RETURN "M:" + '"' + xValue + '"'
ENDCASE
RETURN ""
@@ -486,9 +492,9 @@ FUNCTION XToStrE( xValue )
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "M" ; RETURN 'M:' + xValue
CASE cType == "B" ; RETURN "{||...}"
CASE cType == "A" ; RETURN "{.[" + LTrim( Str( Len( xValue ) ) ) + "].}"
CASE cType == "M" ; RETURN "M:" + xValue
ENDCASE
RETURN ""
@@ -515,10 +521,10 @@ FUNCTION XToStrX( xValue )
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...} -> ' + XToStrX( Eval( xValue ) )
CASE cType == "B" ; RETURN "{||...} -> " + XToStrX( Eval( xValue ) )
CASE cType == "A"
cRetVal := '{ '
cRetVal := "{ "
FOR tmp := 1 TO Len( xValue )
cRetVal += XToStrX( xValue[ tmp ] )
@@ -527,9 +533,9 @@ FUNCTION XToStrX( xValue )
ENDIF
NEXT
RETURN cRetVal + ' }'
RETURN cRetVal + " }"
CASE cType == "M" ; RETURN 'M:' + xValue
CASE cType == "M" ; RETURN "M:" + xValue
ENDCASE
RETURN ""

View File

@@ -62,12 +62,6 @@
#endif
#endif
#define TEST_RESULT_COL1_WIDTH 1
#define TEST_RESULT_COL2_WIDTH 20
#define TEST_RESULT_COL3_WIDTH 40
#define TEST_RESULT_COL4_WIDTH 85
#define TEST_RESULT_COL5_WIDTH 85
#ifdef __HARBOUR__
#pragma linenumber=on
#else