diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 92e20a7060..d36d740465 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,65 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-04-21 14:48 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * tests/rto_get.prg + * tests/rto_tb.prg + + Added more tests. + + Enabled object as array results by default. + + More details for TGet test results. + + * bin/bld_os2.cmd + ! Fixed lib names. Thanks David. + + * source/rtl/tobject.prg + * Formatting. + + * source/rtl/tget.prg + ! Delimiter colors in C5.3 mode made compatible. + ! ::colorSpec handling in C5.3 mode made compatible + for some invalid parameter types. + ! Fixed handling decimals in :row, :col, :pos + methods. + ! Fixed to compile in C5.2 mode without warning + (introduced in recent commit). + + * source/rtl/tbrowse.prg + ! Fixed handling decimals in :nTop, :nBottom, :nLeft, :nRight. + + Added unfinished XPP method :viewArea() + + Added untested XPP method :firstScrCol() + ; Few minor formatting. + + * include/hbextern.ch + * source/rtl/einstvar.prg + + Added _eInstVar52() which is the C5.2 compatible version + of this function. It also replicates a bug. + * _eInstVar() renamed to _eInstVar53(). + * _eInstVar() made a stub to call _eInstVar53(). + + * source/rtl/checkbox.prg + * source/rtl/listbox.prg + * source/rtl/pushbtn.prg + * source/rtl/radiobtn.prg + * source/rtl/radiogrp.prg + * source/rtl/scrollbr.prg + * source/rtl/symbol.prg + * source/rtl/teditor.prg + * source/rtl/tget.prg + * source/rtl/tget1.prg + * source/rtl/tgetlist.prg + * source/rtl/tmenuitm.prg + * source/rtl/tmenusys.prg + * source/rtl/tpopup.prg + * source/rtl/ttopbar.prg + * Formatting (EXPORT: -> EXPORTED:) + + * contrib/hbtip/thtml.prg + * contrib/hbtip/ftpcln.prg + ! Fixed to work regardless of SET EXACT setting. + ; NOTE: I'd suggest an optional compiler warning + to detect plain "=" usage. It's bad practice + in most cases. + 2008-04-20 13:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rtl/tobject.prg ! fixed the problem with SET EXACT ON I introduced recently by mistake diff --git a/harbour/bin/bld_os2.cmd b/harbour/bin/bld_os2.cmd index b3e600bb03..05ea90dd19 100644 --- a/harbour/bin/bld_os2.cmd +++ b/harbour/bin/bld_os2.cmd @@ -70,8 +70,8 @@ if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\include\ set _HB_GT_LIB=%HB_GT_LIB% if "%_HB_GT_LIB%" == "" set _HB_GT_LIB=gtos2 - if "%HB_COMPILER%" == "gcc" gcc %1.c %CFLAGS% -I%HB_INC_INSTALL% -L%HB_LIB_INSTALL% -ldebug -lvm -lrtl -l%_HB_GT_LIB% -llang -lrdd -lrtl -lvm -lmacro -lpp -ldbfntx -ldbfcdx -ldbffpt -lhbsix -lhsx -lcommon -lrtl -lvm - if "%HB_COMPILER%" == "icc" icc /Gs+ /W2 /Se /Sd+ /Ti+ /C- /Tp %CFLAGS% -I%HB_INC_INSTALL% %1.c %HB_LIB_INSTALL%\debug.lib %HB_LIB_INSTALL%\vm.lib %HB_LIB_INSTALL%\rtl.lib %HB_LIB_INSTALL%\%_HB_GT_LIB%.lib %HB_LIB_INSTALL%\lang.lib %HB_LIB_INSTALL%\rdd.lib %HB_LIB_INSTALL%\rtl.lib %HB_LIB_INSTALL%\vm.lib %HB_LIB_INSTALL%\macro.lib %HB_LIB_INSTALL%\pp.lib %HB_LIB_INSTALL%\dbfntx.lib %HB_LIB_INSTALL%\dbfcdx.lib %HB_LIB_INSTALL%\common.lib + if "%HB_COMPILER%" == "gcc" gcc %1.c %CFLAGS% -I%HB_INC_INSTALL% -L%HB_LIB_INSTALL% -lhbcpage -lhbdebug -lhbvm -lhbrtl -l%_HB_GT_LIB% -lhblang -lhbrdd -lhbrtl -lhbvm -lhbmacro -lhbpp -lrddfpt -lrddntx -lrddcdx -lhbsix -lhbcommon + if "%HB_COMPILER%" == "icc" icc /Gs+ /W2 /Se /Sd+ /Ti+ /C- /Tp %CFLAGS% -I%HB_INC_INSTALL% %1.c %HB_LIB_INSTALL%\hbcpage.lib %HB_LIB_INSTALL%\hbdebug.lib %HB_LIB_INSTALL%\hbvm.lib %HB_LIB_INSTALL%\hbrtl.lib %HB_LIB_INSTALL%\%_HB_GT_LIB%.lib %HB_LIB_INSTALL%\hblang.lib %HB_LIB_INSTALL%\hbrdd.lib %HB_LIB_INSTALL%\hbrtl.lib %HB_LIB_INSTALL%\hbvm.lib %HB_LIB_INSTALL%\hbmacro.lib %HB_LIB_INSTALL%\hbpp.lib %HB_LIB_INSTALL%\rddfpt.lib %HB_LIB_INSTALL%\rddntx.lib %HB_LIB_INSTALL%\rddcdx.lib %HB_LIB_INSTALL%\hbsix.lib %HB_LIB_INSTALL%\hbcommon.lib goto END :CLEANUP diff --git a/harbour/contrib/hbtip/ftpcln.prg b/harbour/contrib/hbtip/ftpcln.prg index 47f2d42451..f5cfd171fb 100644 --- a/harbour/contrib/hbtip/ftpcln.prg +++ b/harbour/contrib/hbtip/ftpcln.prg @@ -329,7 +329,7 @@ METHOD ScanLength() CLASS tIPClientFTP LOCAL aBytes aBytes := HB_Regex( ::RegBytes, ::cReply ) IF .not. Empty(aBytes) - ::nLength = Val( aBytes[2] ) + ::nLength := Val( aBytes[2] ) ENDIF RETURN .T. @@ -420,11 +420,11 @@ METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP ::InetSendAll( ::SocketCon, cCommand ) if lReadPort - lReadPort = ::ReadAuxPort() + lReadPort := ::ReadAuxPort() endif if lGetReply - lGetReply = ::GetReply() + lGetReply := ::GetReply() endif RETURN .t. @@ -517,7 +517,7 @@ METHOD Read( nLen ) CLASS tIPClientFTP IF .not. ::CWD( ::oUrl:cPath ) - ::bEof = .T. // no data for this transaction + ::bEof := .T. // no data for this transaction RETURN .F. ENDIF @@ -532,7 +532,7 @@ METHOD Read( nLen ) CLASS tIPClientFTP IF .not. ::Retr( ::oUrl:cFile ) - ::bEof = .T. // no data for this transaction + ::bEof := .T. // no data for this transaction RETURN .F. ENDIF @@ -761,7 +761,7 @@ METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP IF ! ::bInitialized IF ! Empty( ::oUrl:cPath ) .AND. ! ::CWD( ::oUrl:cPath ) - ::bEof = .T. // no data for this transaction + ::bEof := .T. // no data for this transaction RETURN .F. ENDIF @@ -770,7 +770,7 @@ METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP ENDIF IF ! ::Retr( ::oUrl:cFile ) - ::bEof = .T. // no data for this transaction + ::bEof := .T. // no data for this transaction RETURN .F. ENDIF diff --git a/harbour/contrib/hbtip/thtml.prg b/harbour/contrib/hbtip/thtml.prg index 5dad1eb851..6154c9cfd7 100644 --- a/harbour/contrib/hbtip/thtml.prg +++ b/harbour/contrib/hbtip/thtml.prg @@ -1240,7 +1240,7 @@ METHOD getAttributes() CLASS THtmlNode // Tag has no valid attributes RETURN NIL - ELSEIF ::htmlTagName = "!" + ELSEIF Left( ::htmlTagName, 1 ) == "!" // and have no HTML attributes RETURN ::htmlAttributes diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index 724ba081d9..af759f6dce 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -611,6 +611,8 @@ EXTERNAL __INPUT EXTERNAL __NONOALERT EXTERNAL __QQPUB EXTERNAL _EINSTVAR +EXTERNAL _EINSTVAR52 +EXTERNAL _EINSTVAR53 EXTERNAL _NATMSGVER EXTERNAL _NATSORTVER EXTERNAL DBGSHADOW diff --git a/harbour/source/rtl/checkbox.prg b/harbour/source/rtl/checkbox.prg index e655d3528b..f6cc8c45fb 100644 --- a/harbour/source/rtl/checkbox.prg +++ b/harbour/source/rtl/checkbox.prg @@ -68,7 +68,7 @@ CREATE CLASS CHECKBOX FUNCTION HBCheckBox - EXPORT: + EXPORTED: VAR cargo diff --git a/harbour/source/rtl/einstvar.prg b/harbour/source/rtl/einstvar.prg index 2f71adc1a5..a3cd4f4609 100644 --- a/harbour/source/rtl/einstvar.prg +++ b/harbour/source/rtl/einstvar.prg @@ -59,9 +59,12 @@ validation codeblock. In other words, in case of _eInstVar() Harbour is compatible with CA-Cl*pper 5.3, not with 5.2. */ +FUNCTION _eInstVar( ... ) + RETURN _eInstVar53( ... ) + /* NOTE: In CA-Cl*pper 5.2/5.3 the cMethod argument seems to be ignored. */ -FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid ) +FUNCTION _eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid ) LOCAL oError @@ -72,7 +75,48 @@ FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid ) oError:gencode := 1 oError:severity := 2 oError:cansubstitute := .T. - oError:subsystem := oVar:classname + oError:subsystem := oVar:className +#ifdef HB_C52_STRICT + HB_SYMBOL_UNUSED( cMethod ) +#else + oError:operation := cMethod +#endif + oError:subcode := nSubCode + oError:args := { xValue } + xValue := EVAL( ERRORBLOCK(), oError ) + IF VALTYPE( xValue ) != cType + __errInHandler() + ENDIF + ENDIF + + RETURN xValue + +FUNCTION _eInstVar52( oVar, cMethod, xValue, cType, nSubCode, xMin, xMax ) + + LOCAL oError + LOCAL lError + + IF VALTYPE( xValue ) == cType + lError := .F. + IF xMin != NIL + lError := !( xValue >= xMin ) + ENDIF + /* NOTE: In CA-Cl*pper 5.2, xMin validation result is + ignored when xMax != NIL. Harbour is doing the same. */ + IF xMax != NIL + lError := !( xValue <= xMax ) + ENDIF + ELSE + lError := .T. + ENDIF + + IF lError + oError := ErrorNew() + oError:description := HB_LANGERRMSG( 1 ) + oError:gencode := 1 + oError:severity := 2 + oError:cansubstitute := .T. + oError:subsystem := oVar:className #ifdef HB_C52_STRICT HB_SYMBOL_UNUSED( cMethod ) #else diff --git a/harbour/source/rtl/listbox.prg b/harbour/source/rtl/listbox.prg index d87fa0c11d..7bca3cb87c 100644 --- a/harbour/source/rtl/listbox.prg +++ b/harbour/source/rtl/listbox.prg @@ -75,7 +75,7 @@ CREATE CLASS LISTBOX FUNCTION HBListBox - EXPORT: + EXPORTED: VAR cargo diff --git a/harbour/source/rtl/pushbtn.prg b/harbour/source/rtl/pushbtn.prg index 3c7f8b0a45..75e36f70c3 100644 --- a/harbour/source/rtl/pushbtn.prg +++ b/harbour/source/rtl/pushbtn.prg @@ -68,7 +68,7 @@ CREATE CLASS PUSHBUTTON FUNCTION HBPushButton - EXPORT: + EXPORTED: VAR cargo /* NOTE: CA-Clipper 5.3 has a bug, where this var cannot be assigned NIL. */ diff --git a/harbour/source/rtl/radiobtn.prg b/harbour/source/rtl/radiobtn.prg index 675a159b90..70f2afed93 100644 --- a/harbour/source/rtl/radiobtn.prg +++ b/harbour/source/rtl/radiobtn.prg @@ -67,7 +67,7 @@ CREATE CLASS RADIOBUTTN FUNCTION HBRadioButton - EXPORT: + EXPORTED: VAR cargo /* NOTE: CA-Clipper 5.3 has a bug, where this var is filled with NIL everytime its value is read ( cargo := o:cargo ). */ diff --git a/harbour/source/rtl/radiogrp.prg b/harbour/source/rtl/radiogrp.prg index 73df67a0bd..f54bdf6d5e 100644 --- a/harbour/source/rtl/radiogrp.prg +++ b/harbour/source/rtl/radiogrp.prg @@ -68,7 +68,7 @@ CREATE CLASS RADIOGROUP FUNCTION HBRadioGroup - EXPORT: + EXPORTED: VAR cargo diff --git a/harbour/source/rtl/scrollbr.prg b/harbour/source/rtl/scrollbr.prg index 7b5825a000..2a90f08bc4 100644 --- a/harbour/source/rtl/scrollbr.prg +++ b/harbour/source/rtl/scrollbr.prg @@ -67,7 +67,7 @@ CREATE CLASS SCROLLBAR FUNCTION HBScrollBar - EXPORT: + EXPORTED: VAR cargo diff --git a/harbour/source/rtl/symbol.prg b/harbour/source/rtl/symbol.prg index facf7edf55..f0bdd72fda 100644 --- a/harbour/source/rtl/symbol.prg +++ b/harbour/source/rtl/symbol.prg @@ -54,7 +54,7 @@ CREATE CLASS Symbol - EXPORT: + EXPORTED: METHOD New( cSymName ) // Constructor. cSymName may already exists or not METHOD name() // retrieves the symbol name diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 85b83c0d28..5efb81b001 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -54,13 +54,14 @@ #define HB_CLS_NOTOBJECT -#include "common.ch" #include "hbclass.ch" + +#include "button.ch" #include "color.ch" +#include "common.ch" #include "error.ch" #include "inkey.ch" #include "setcurs.ch" -#include "button.ch" #include "tbrowse.ch" /* HB_BRW_STATICMOUSE controls if mouse position is static @@ -107,6 +108,11 @@ #define _TBR_CONF_COLUMNS 2 #define _TBR_CONF_ALL 3 +/* Footing/heading line separator. */ +#define _TBR_CHR_LINEDELIMITER ";" + +#define _TBR_COORD( n ) Int( n ) + /* NOTE: In CA-Cl*pper TBROWSE class does not inherit from any other classes and there is no public class function like TBrowse(). There is in XPP though. */ @@ -123,10 +129,10 @@ CREATE CLASS TBrowse VAR cargo AS USUAL EXPORTED // 01. User-definable variable HIDDEN: - VAR n_Top AS INTEGER INIT 0 // 02. Top row number for the TBrowse display - VAR n_Left AS INTEGER INIT 0 // 03. Leftmost column for the TBrowse display - VAR n_Bottom AS INTEGER INIT 0 // 04. Bottom row number for the TBrowse display - VAR n_Right AS INTEGER INIT 0 // 05. Rightmost column for the TBrowse display + VAR n_Top AS NUMERIC INIT 0 // 02. Top row number for the TBrowse display + VAR n_Left AS NUMERIC INIT 0 // 03. Leftmost column for the TBrowse display + VAR n_Bottom AS NUMERIC INIT 0 // 04. Bottom row number for the TBrowse display + VAR n_Right AS NUMERIC INIT 0 // 05. Rightmost column for the TBrowse display VAR columns AS ARRAY INIT {} // 06. Array of TBrowse columns @@ -249,6 +255,11 @@ EXPORTED: /* NOTE: nMode is an undocumented parameter in CA-Cl*pper */ METHOD configure( nMode ) // mark that the internal settings of the TBrowse object should be reconfigured +#ifdef HB_COMPAT_XPP + METHOD viewArea() // Xbase++ compatible method + METHOD firstScrCol() // Xbase++ compatible method +#endif + METHOD new( nTop, nLeft, nBottom, nRight ) // constructor, NOTE: This method is a Harbour extension [vszakats] HIDDEN: @@ -421,7 +432,7 @@ STATIC FUNCTION _DISP_FHNAME( nRow, nHeight, nLeft, nRight, nType, nColor, aColo ENDIF FOR nPos := 1 TO nHeight DispOutAt( nRow + nPos - 1, nCol, ; - PadR( hb_tokenGet( cName, nPos, ";" ), nWidth ), ; + PadR( hb_tokenGet( cName, nPos, _TBR_CHR_LINEDELIMITER ), nWidth ), ; IIF( aCol[ _TBCI_DEFCOLOR ][ nColor ] == 0, "N/N", ; aColors[ aCol[ _TBCI_DEFCOLOR ][ nColor ] ] ) ) NEXT @@ -970,7 +981,7 @@ STATIC FUNCTION _SETDEFCOLOR( aColData, aColors ) aClr := { aCol[ _TBCI_DEFCOLOR ][ 1 ], aCol[ _TBCI_DEFCOLOR ][ 2 ] } NEXT -RETURN NIL + RETURN NIL /* If oCol:colorBlock does not return array length enough then colors @@ -1399,7 +1410,7 @@ METHOD doConfigure() CLASS TBROWSE ENDIF NEXT - nHeight := MAx( ::n_Bottom - ::n_Top, 0 ) + nHeight := Max( _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ), 0 ) IF lHeadSep .AND. nHeight > 0 --nHeight ELSE @@ -1427,7 +1438,7 @@ METHOD doConfigure() CLASS TBROWSE /* update headings to maximum size and missing head/foot separators */ FOR EACH aCol IN ::aColData - aCol[ _TBCI_HEADING ] := Replicate( ";", nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], ";" ) ) + ; + aCol[ _TBCI_HEADING ] := Replicate( _TBR_CHR_LINEDELIMITER, nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], _TBR_CHR_LINEDELIMITER ) ) + ; aCol[ _TBCI_HEADING ] IF lHeadSep .AND. aCol[ _TBCI_HEADSEP ] == "" aCol[ _TBCI_HEADSEP ] := " " @@ -1469,7 +1480,7 @@ METHOD doConfigure() CLASS TBROWSE /* CA-Clipper update visible columns here but without * colPos repositioning. [druzus] */ - _SETVISIBLE( ::aColData, ::n_Right - ::n_Left + 1, ; + _SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ; @::nFrozen, @::nLeftVisible, @::nRightVisible ) ::nLastPos := 0 @@ -1517,12 +1528,12 @@ STATIC FUNCTION _DECODE_FH( cName, nHeight, nWidth ) /* When last character of heading/footing is ';' then CA-Cl*pper * does not calculate it as separator */ - IF Right( cName, 1 ) == ";" + IF Right( cName, 1 ) == _TBR_CHR_LINEDELIMITER cName := Left( cName, Len( cName ) - 1 ) ENDIF - nHeight := hb_TokenCount( cName, ";" ) + nHeight := hb_TokenCount( cName, _TBR_CHR_LINEDELIMITER ) FOR i := 1 TO nHeight - nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, ";" ) ) ) + nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, _TBR_CHR_LINEDELIMITER ) ) ) NEXT ENDIF @@ -1725,7 +1736,7 @@ METHOD setVisible() CLASS TBROWSE lFrames := .F. nColumns := Len( ::aColData ) - nWidth := ::n_Right - ::n_Left + 1 + nWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 nColPos := ::nColPos IF nColPos > nColumns @@ -1769,7 +1780,7 @@ METHOD setVisible() CLASS TBROWSE #endif /* update column size and positions on the screen */ - nLeft := ::n_Left + nLeft := _TBR_COORD( ::n_Left ) lFirst := .T. FOR nCol := 1 TO ::nRightVisible aCol := ::aColData[ nCol ] @@ -1784,7 +1795,7 @@ METHOD setVisible() CLASS TBROWSE ELSE nLeft += aCol[ _TBCI_SEPWIDTH ] ENDIF - nLast := IIF( nCol == ::nRightVisible, ::n_Right - nLeft + 1, 0 ) + nLast := IIF( nCol == ::nRightVisible, _TBR_COORD( ::n_Right ) - nLeft + 1, 0 ) IF aCol[ _TBCI_COLPOS ] != nColPos .OR. ; aCol[ _TBCI_FROZENSPACE ] != nFrozen .OR. ; @@ -1832,8 +1843,8 @@ METHOD hiLite() CLASS TBROWSE IF ::setCursorPos() IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_SELECTED ] ) - IF ::n_Col + Len( cValue ) > ::n_Right - cValue := Left( cValue, ::n_Right - ::n_Col + 1 ) + IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right ) + cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 ) ENDIF DispOut( cValue, cColor ) SetPos( ::n_Row, ::n_Col ) @@ -1859,8 +1870,8 @@ METHOD deHilite() CLASS TBROWSE IF ::setCursorPos() IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_STANDARD ] ) - IF ::n_Col + Len( cValue ) > ::n_Right - cValue := Left( cValue, ::n_Right - ::n_Col + 1 ) + IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right ) + cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 ) ENDIF DispOut( cValue, cColor ) SetPos( ::n_Row, ::n_Col ) @@ -1909,7 +1920,7 @@ METHOD freeze( nColumns ) CLASS TBROWSE IF ISNUMBER( nColumns ) nCols := Int( nColumns ) - IF _MAXFREEZE( nCols, ::aColData, ::n_Right - ::n_Left + 1 ) == nCols + IF _MAXFREEZE( nCols, ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 ) == nCols ::nFrozen := nCols ::lFrames := .T. @@ -1917,7 +1928,7 @@ METHOD freeze( nColumns ) CLASS TBROWSE /* CA-Clipper update visible columns here but without * colPos repositioning. [druzus] */ - _SETVISIBLE( ::aColData, ::n_Right - ::n_Left + 1, ; + _SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ; @::nFrozen, @::nLeftVisible, @::nRightVisible ) ENDIF /* NOTE: CA-Cl*pper compatible behaviour. [vszakats] */ @@ -1951,7 +1962,7 @@ METHOD rowCount() CLASS TBROWSE ::doConfigure() ENDIF - nRows := ::n_Bottom - ::n_Top + 1 - ; + nRows := _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ) + 1 - ; ::nHeadHeight - IIF( ::lHeadSep, 1, 0 ) - ; ::nFootHeight - IIF( ::lFootSep, 1, 0 ) @@ -2133,7 +2144,7 @@ METHOD rightVisible() CLASS TBROWSE /* Adds a TBColumn object to the TBrowse object */ METHOD addColumn( oCol ) CLASS TBROWSE - /* NOTE: CA-Cl*pper does not check at all on the parameters. */ + /* NOTE: CA-Cl*pper doesn't check the parameters. */ AAdd( ::columns, oCol ) ::configure( _TBR_CONF_COLUMNS ) @@ -2146,7 +2157,7 @@ METHOD delColumn( nColumn ) CLASS TBROWSE LOCAL oCol - /* NOTE: CA-Cl*pper does not check at all on the parameters. */ + /* NOTE: CA-Cl*pper doesn't check the parameters. */ #ifndef HB_C52_STRICT IF nColumn >= 1 .AND. nColumn <= ::colCount #else @@ -2164,7 +2175,7 @@ METHOD delColumn( nColumn ) CLASS TBROWSE /* Insert a column object in a browse */ METHOD insColumn( nColumn, oCol ) CLASS TBROWSE - /* NOTE: CA-Cl*pper does not check at all on the parameters. */ + /* NOTE: CA-Cl*pper doesn't check the parameters. */ #ifndef HB_C52_STRICT IF nColumn >= 1 .AND. nColumn <= ::colCount + 1 #else @@ -2365,6 +2376,30 @@ METHOD nRight( nRight ) CLASS TBROWSE RETURN ::n_Right +#ifdef HB_COMPAT_XPP + +METHOD viewArea() CLASS TBROWSE + + // TOFIX + + RETURN { ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ),; + ::n_Left,; + ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ),; + ::n_Right,; + 0 /* nFrozenWidth */ } + + +/* NOTE: Returns the left margin relative column position of the first + non-freezed column. Xbase++ compatible method. */ +METHOD firstScrCol() CLASS TBROWSE + + // TOFIX + + RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] ) + +#endif + + #ifdef HB_COMPAT_C53 METHOD nRow() CLASS TBROWSE diff --git a/harbour/source/rtl/teditor.prg b/harbour/source/rtl/teditor.prg index fa33f8bd77..79a1d6edf0 100644 --- a/harbour/source/rtl/teditor.prg +++ b/harbour/source/rtl/teditor.prg @@ -62,7 +62,7 @@ CREATE CLASS HBEditor - EXPORT: + EXPORTED: METHOD LoadFile( cFileName ) // Load cFileName into active editor METHOD LoadText( cString ) // Load cString into active editor diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 23f8d3edb0..7bec82ca98 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -255,9 +255,9 @@ METHOD display( lForced ) CLASS Get LOCAL nOldCursor := SetCursor( SC_NONE ) LOCAL cBuffer LOCAL nDispPos - LOCAL nPos #ifdef HB_COMPAT_C53 + LOCAL nPos LOCAL cCaption #endif @@ -330,8 +330,14 @@ METHOD display( lForced ) CLASS Get iif( ::lHideInput, PadR( Replicate( SubStr( ::cStyle, 1, 1 ), Len( RTrim( cBuffer ) ) ), ::nDispLen ), SubStr( cBuffer, nDispPos, ::nDispLen ) ),; hb_ColorIndex( ::cColorSpec, iif( ::hasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) IF Set( _SET_DELIMITERS ) .AND. !::hasFocus +#ifdef HB_COMPAT_C53 + DispOutAt( ::nRow, ::nCol - 1, SubStr( Set( _SET_DELIMCHARS ), 1, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_UNSELECTED ) ) + DispOutAt( ::nRow, ::nCol + ::nDispLen, SubStr( Set( _SET_DELIMCHARS ), 2, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_UNSELECTED ) ) +#else + /* NOTE: C5.x will use the default color. We're replicating this here. [vszakats] */ DispOutAt( ::nRow, ::nCol - 1, SubStr( Set( _SET_DELIMCHARS ), 1, 1 ) ) DispOutAt( ::nRow, ::nCol + ::nDispLen, SubStr( Set( _SET_DELIMCHARS ), 2, 1 ) ) +#endif ENDIF ENDIF @@ -1181,11 +1187,30 @@ METHOD colorSpec( cColorSpec ) CLASS Get "," + hb_NToColor( iif( ( nClrOth := hb_ColorToN( cClrOth := hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ) ) != -1, nClrOth, nClrUns ) ) #endif - RETURN cColorSpec + /* NOTE: CA-Cl*pper oddity. [vszakats] */ + ELSEIF ValType( cColorSpec ) $ "UNDBA" + RETURN NIL + +#ifdef HB_COMPAT_C53 + /* NOTE: This code doesn't seem to make any sense, but seems to + replicate some original C5.3 behaviour. */ + ELSE + IF Set( _SET_INTENSITY ) + ::cColorSpec := hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," +; + hb_ColorIndex( SetColor(), CLR_ENHANCED ) + "," +; + hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +; + hb_ColorIndex( SetColor(), CLR_BACKGROUND ) + ELSE + ::cColorSpec := hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +; + hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +; + hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +; + hb_ColorIndex( SetColor(), CLR_STANDARD ) + ENDIF +#endif ENDIF - RETURN iif( ValType( cColorSpec ) $ "UNDBA", NIL, cColorSpec ) /* ; CA-Cl*pper oddity [vszakats] */ + RETURN cColorSpec METHOD pos( nPos ) CLASS Get @@ -1197,6 +1222,8 @@ METHOD pos( nPos ) CLASS Get IF ISNUMBER( nPos ) + nPos := Int( nPos ) + IF ::hasFocus DO CASE @@ -1875,7 +1902,7 @@ METHOD minus( lMinus ) CLASS Get METHOD row( nRow ) CLASS Get IF PCount() > 0 - ::nRow := iif( ISNUMBER( nRow ), nRow, 0 ) + ::nRow := iif( ISNUMBER( nRow ), Int( nRow ), 0 ) ENDIF RETURN ::nRow @@ -1886,7 +1913,7 @@ METHOD row( nRow ) CLASS Get METHOD col( nCol ) CLASS Get IF PCount() > 0 - ::nCol := iif( ISNUMBER( nCol ), nCol, 0 ) + ::nCol := iif( ISNUMBER( nCol ), Int( nCol ), 0 ) ENDIF RETURN ::nCol diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index 4650103ec6..ca7fb68190 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -87,7 +87,7 @@ CREATE CLASS HBGetList - EXPORT: + EXPORTED: VAR HasFocus AS LOGICAL INIT .F. diff --git a/harbour/source/rtl/tmenuitm.prg b/harbour/source/rtl/tmenuitm.prg index b02a22b022..44dd6011ee 100644 --- a/harbour/source/rtl/tmenuitm.prg +++ b/harbour/source/rtl/tmenuitm.prg @@ -62,7 +62,7 @@ CREATE CLASS MENUITEM FUNCTION HBMenuItem - EXPORT: + EXPORTED: VAR cargo diff --git a/harbour/source/rtl/tmenusys.prg b/harbour/source/rtl/tmenusys.prg index b9b5bfa4db..ca39ccb4cd 100644 --- a/harbour/source/rtl/tmenusys.prg +++ b/harbour/source/rtl/tmenusys.prg @@ -70,7 +70,7 @@ CREATE CLASS HBMenuSys - EXPORT: + EXPORTED: METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) METHOD New( oMenu ) diff --git a/harbour/source/rtl/tobject.prg b/harbour/source/rtl/tobject.prg index 86e01bc967..281a9b7a11 100644 --- a/harbour/source/rtl/tobject.prg +++ b/harbour/source/rtl/tobject.prg @@ -86,7 +86,7 @@ FUNCTION HBObject() /*s_oClass:AddInline( "CLASSNAME" , {| Self | __OBJGETCLSNAME( Self ) }, HB_OO_CLSTP_EXPORTED ) */ /*s_oClass:AddInline( "CLASSH" , {| Self | __CLASSH( Self ) }, HB_OO_CLSTP_EXPORTED ) */ /*s_oClass:AddInline( "CLASSSEL" , {| Self | __CLASSSEL( Self:CLASSH() ) }, HB_OO_CLSTP_EXPORTED ) */ - /*s_oClass:AddInline( "EVAL" , {| Self | __EVAL( Self ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "EVAL" , {| Self | __EVAL( Self ) }, HB_OO_CLSTP_EXPORTED ) */ /* xBase++ */ s_oClass:AddInline( "ISDERIVEDFROM" , {| Self, xPar1 | __ObjDerivedFrom( Self, xPar1 ) }, HB_OO_CLSTP_EXPORTED ) @@ -102,11 +102,11 @@ FUNCTION HBObject() s_oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", __OBJGETCLSNAME( Self ), cMsg, IIF( Left( cMsg, 1 ) == "_", 1005, 1004 ) ) }, HB_OO_CLSTP_EXPORTED ) - /*s_oClass:AddMultiData(,,HB_OO_CLSTP_EXPORTED,{"CLASS"}, .F. )*/ + /*s_oClass:AddMultiData( , , HB_OO_CLSTP_EXPORTED, { "CLASS" }, .F. ) */ - /*s_oClass:AddInline( "ADDMETHOD" , { | Self, cMeth, pFunc, nScopeMeth | __clsAddMsg( __CLASSH( Self ) , cMeth , pFunc ,HB_OO_MSG_METHOD , NIL, iif(nScopeMeth==NIL,1,nScopeMeth) ) }, HB_OO_CLSTP_EXPORTED ) */ - /*s_oClass:AddInline( "ADDVAR" , { | Self, cVAR, nScopeMeth, uiData , hClass | __clsAddMsg( hClass:=__CLASSH( Self ) , cVar , uidata := __CLS_INCDATA(hClass) , HB_OO_MSG_ACCESS, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) , ; */ - /* __clsAddMsg( hClass , "_"+cVar , uiData , HB_OO_MSG_ASSIGN, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "ADDMETHOD" , { | Self, cMeth, pFunc, nScopeMeth | __clsAddMsg( __CLASSH( Self ) , cMeth , pFunc ,HB_OO_MSG_METHOD , NIL, iif( nScopeMeth == NIL, 1, nScopeMeth ) ) }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "ADDVAR" , { | Self, cVAR, nScopeMeth, uiData, hClass | __clsAddMsg( hClass:=__CLASSH( Self ) , cVar , uidata := __CLS_INCDATA( hClass ), HB_OO_MSG_ACCESS, NIL, iif( nScopeMeth == NIL, 1, nScopeMeth ) ) , ; */ + /* __clsAddMsg( hClass , "_"+cVar , uiData , HB_OO_MSG_ASSIGN, NIL, iif( nScopeMeth == NIL, 1, nScopeMeth ) ) }, HB_OO_CLSTP_EXPORTED ) */ /* Those one exist within Class(y), so we will probably try to implement it */ @@ -137,7 +137,7 @@ FUNCTION HBObject() /*s_oClass:AddInline( "badMethod" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ /* this one exist within VO and seem to be Auto Called when object ran out of scope */ - /*s_oClass:AddInline( "Axit" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ + /*s_oClass:AddInline( "Axit" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */ s_oClass:Create() @@ -152,16 +152,16 @@ FUNCTION HBObject() RETURN s_oClass:Instance() -static function HBObject_New( ... ) -return QSelf():Init( ... ) +STATIC function HBObject_New( ... ) + RETURN QSelf():Init( ... ) -static function HBObject_Init() -return QSelf() +STATIC FUNCTION HBObject_Init() + RETURN QSelf() -static function HBObject_Dftonerror( ... ) -return QSelf():MSGNOTFOUND( __GetMessage(), ... ) +STATIC FUNCTION HBObject_Dftonerror( ... ) + RETURN QSelf():MSGNOTFOUND( __GetMessage(), ... ) -static function HBObject_Error( cDesc, cClass, cMsg, nCode ) +STATIC FUNCTION HBObject_Error( cDesc, cClass, cMsg, nCode ) DEFAULT nCode TO 1004 diff --git a/harbour/source/rtl/tpopup.prg b/harbour/source/rtl/tpopup.prg index 9a4de2ee60..5d72275fcd 100644 --- a/harbour/source/rtl/tpopup.prg +++ b/harbour/source/rtl/tpopup.prg @@ -68,7 +68,7 @@ CREATE CLASS POPUPMENU FUNCTION HBPopUpMenu - EXPORT: + EXPORTED: VAR cargo #ifdef HB_EXTENSION diff --git a/harbour/source/rtl/ttopbar.prg b/harbour/source/rtl/ttopbar.prg index a5da5ea879..ecd5e0dd34 100644 --- a/harbour/source/rtl/ttopbar.prg +++ b/harbour/source/rtl/ttopbar.prg @@ -64,7 +64,7 @@ CREATE CLASS TOPBARMENU FUNCTION HBTopBarMenu - EXPORT: + EXPORTED: METHOD addItem( oItem ) METHOD delItem( nPos ) diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg index 29db1899b9..f42d518c4e 100644 --- a/harbour/tests/rto_get.prg +++ b/harbour/tests/rto_get.prg @@ -94,7 +94,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine ) s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine ) - s_lObjectDump := "ODUMP" $ Upper( cCommandLine ) + s_lObjectDump := !( "NODUMP" $ Upper( cCommandLine ) ) // ; @@ -250,17 +250,55 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) // ; ColorSpec SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01",,, ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := ",N/G" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "," ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/N" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N /N" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N " ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" ) - o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := NIL ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .F. ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .T. ) + SetColor( "W+/R,G+/BR,RG+/B,BG+/G,N/GR,GR+/BG,B/GR*" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .F. ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .T. ) + SetColor( "" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := 100 ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := {} ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := ",N/G" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "," ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,N/N" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,N /N" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G, N/N" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G, N/N " ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" ) + o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" ) + + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := NIL ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .F. ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .T. ) + SetColor( "W+/R,G+/BR,RG+/B,BG+/G,N/GR,GR+/BG,B/GR*" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .F. ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. ) + Set( _SET_INTENSITY, .T. ) + SetColor( "" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := 100 ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := {} ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := ",N/G" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "," ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,N/N" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,N /N" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G, N/N" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G, N/N " ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" ) + o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" ) // ; Pos @@ -322,6 +360,8 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) TGetAssign( 0 ) TGetAssign( 1 ) TGetAssign( 3 ) + TGetAssign( 3.3 ) + TGetAssign( 3.7 ) TGetAssign( 100 ) TGetAssign( "" ) TGetAssign( "az" ) @@ -944,7 +984,11 @@ PROCEDURE LogGETVars( o, desc, xResult ) #endif /* Both indexes contain binary trash (except the first char of [11] which is type. [vszakats] */ +#ifdef HB_COMPAT_C53 + IF tmp != 8 .AND. tmp != 17 +#else IF tmp != 8 .AND. tmp != 11 +#endif FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_OSNewLine() ) ENDIF NEXT @@ -985,13 +1029,26 @@ 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 == "B" ; RETURN '{||...} -> ' + XToStr( Eval( xValue ) ) + CASE cType == "A" ; RETURN '{ ' + ArrayToList( xValue ) + ' }' CASE cType == "M" ; RETURN 'M:"' + xValue + '"' ENDCASE RETURN "" +FUNCTION ArrayToList( a ) + LOCAL tmp + LOCAL cString := "" + + FOR tmp := 1 TO Len( a ) + cString += XToStr( a[ tmp ] ) + IF tmp < Len( a ) + cString += ", " + ENDIF + NEXT + + RETURN cString + FUNCTION XToStrE( xValue ) LOCAL cType := ValType( xValue ) @@ -1011,8 +1068,8 @@ 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 == "B" ; RETURN '{||...} -> ' + XToStr( Eval( xValue ) ) + CASE cType == "A" ; RETURN '{ ' + ArrayToList( xValue ) + ' }' CASE cType == "M" ; RETURN 'M:' + xValue ENDCASE diff --git a/harbour/tests/rto_tb.prg b/harbour/tests/rto_tb.prg index ed12875a82..fabca9d54a 100644 --- a/harbour/tests/rto_tb.prg +++ b/harbour/tests/rto_tb.prg @@ -104,7 +104,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine ) s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine ) s_lIgnoreErrOp := "IGNERROP" $ Upper( cCommandLine ) - s_lObjectDump := "ODUMP" $ Upper( cCommandLine ) + s_lObjectDump := !( "NODUMP" $ Upper( cCommandLine ) ) s_lCatchErr := .T. s_lCheckResult := .F.