03ac58b17b
* bin/commit.hb
* config/detect.mk
* config/detfun.mk
* config/detplat.mk
* config/dir.mk
* config/dirsh.mk
* config/global.mk
* config/globsh.mk
* config/instsh.mk
* config/lang.hb
* config/lang2po.hb
* config/po2lang.hb
* config/postinst.hb
* contrib/hbexpat/tests/tohash.prg
* contrib/hbformat/utils/hbformat.ini
* contrib/hbmisc/hbedit.prg
* contrib/hbmxml/tests/testmxml.prg
* contrib/hbnetio/utils/hbnetio/_console.prg
* contrib/hbnetio/utils/hbnetio/_winsvc.prg
* contrib/hbnetio/utils/hbnetio/hbnetio.prg
* contrib/hbnetio/utils/hbnetio/netiomgm.hb
* contrib/hbwin/tests/ole.prg
* contrib/hbwin/tests/oletst2.js
* contrib/hbwin/tests/oletst2.vbs
* contrib/hbxpp/doc/en/binnumx.txt
* contrib/hbxpp/doc/en/dbcmdx.txt
* contrib/xhb/htmutil.prg
* contrib/xhb/tfile.prg
* contrib/xhb/tframe.prg
* contrib/xhb/thtm.prg
* ChangeLog.txt
* debian/copyright
* doc/class_tp.txt
* doc/hdr_tpl.txt
* doc/xhb-diff.txt
* LICENSE.txt
* package/harbour-wce.spec.in
* package/harbour-win.spec.in
* package/harbour.spec
* package/mpkg_rpm_wce.sh
* package/mpkg_rpm_win.sh
* package/mpkg_rpm.sh
* package/mpkg_src.sh
* package/mpkg_ver.sh
* src/rtl/achoice.prg
* src/rtl/getsys53.prg
* src/rtl/tgetlist.prg
* src/rtl/tlabel.prg
* src/rtl/tmenusys.prg
* tests/hbdoc.prg
* tests/langmsg.prg
* tests/rto_get.prg
* tests/rto_tb.prg
+ doc/en/ati.txt
+ doc/en/dirdrive.txt
+ doc/en/hashfunc.txt
+ doc/en/hbtoken.txt
+ doc/en/left.txt
+ doc/en/proc.txt
+ doc/en/strtran.txt
+ doc/en/transfrm.txt
+ doc/en/typefile.txt
* doc/en/*
* more partial sync with 3.4 fork
820 lines
27 KiB
Plaintext
820 lines
27 KiB
Plaintext
/*
|
|
* Regression tests for classes TBrowse()/TBColumn()
|
|
*
|
|
* Copyright 1999-2007 Viktor Szakats (vszakats.net/harbour)
|
|
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl> (eInstVar() - from RTL)
|
|
*
|
|
* 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 program; see the file LICENSE.txt. If not, write to
|
|
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
|
|
*
|
|
* 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.
|
|
*
|
|
*/
|
|
|
|
/* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */
|
|
|
|
#include "error.ch"
|
|
#include "fileio.ch"
|
|
|
|
#ifndef __HARBOUR__
|
|
#define hb_eol() ( Chr( 13 ) + Chr( 10 ) )
|
|
#define hb_ntos( n ) LTrim( Str( n ) )
|
|
#endif
|
|
|
|
#ifdef __XHARBOUR__
|
|
#ifndef HB_COMPAT_C53
|
|
/* It makes xHarbour crash. */
|
|
/* #define HB_COMPAT_C53 */
|
|
#endif
|
|
#endif
|
|
|
|
#xtranslate TEST_L_TBR( <x> ) => TEST_C_TBR( o, #<x>, {|| <x> } )
|
|
#xtranslate TEST_L_TBC( <x> ) => TEST_C_TBC( o, #<x>, {|| <x> } )
|
|
|
|
STATIC s_cTest := ""
|
|
STATIC s_xVar := NIL
|
|
STATIC s_fhnd
|
|
STATIC s_lCallBackStack
|
|
STATIC s_lRTEDetails
|
|
STATIC s_lIgnoreErrOp
|
|
STATIC s_lObjectDump
|
|
STATIC s_lCatchErr
|
|
STATIC s_lCheckResult
|
|
|
|
PROCEDURE Main( cArg01, cArg02, cArg03, cArg04 )
|
|
|
|
LOCAL o
|
|
|
|
LOCAL cCommandLine
|
|
|
|
IF cArg01 == NIL
|
|
cArg01 := ""
|
|
ENDIF
|
|
IF cArg02 == NIL
|
|
cArg02 := ""
|
|
ENDIF
|
|
IF cArg03 == NIL
|
|
cArg03 := ""
|
|
ENDIF
|
|
IF cArg04 == NIL
|
|
cArg04 := ""
|
|
ENDIF
|
|
|
|
Set( _SET_DATEFORMAT, "yyyy-mm-dd" )
|
|
|
|
// ;
|
|
|
|
cCommandLine := cArg01 + " " + cArg02 + " " + cArg03 + " " + cArg04
|
|
|
|
s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine )
|
|
s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine )
|
|
s_lIgnoreErrOp := "IGNERROP" $ Upper( cCommandLine )
|
|
s_lObjectDump := !( "NODUMP" $ Upper( cCommandLine ) )
|
|
s_lCatchErr := .T.
|
|
s_lCheckResult := .F.
|
|
|
|
s_lRTEDetails := .T.
|
|
// s_lIgnoreErrOp := .T.
|
|
|
|
// ;
|
|
|
|
#ifdef __HARBOUR__
|
|
s_fhnd := FCreate( "tb_hb.txt", FC_NORMAL )
|
|
#else
|
|
s_fhnd := FCreate( "tb_cl5.txt", FC_NORMAL )
|
|
#endif
|
|
|
|
IF s_fhnd == F_ERROR
|
|
RETURN
|
|
ENDIF
|
|
|
|
// ;
|
|
|
|
o := TBColumnNew( "test00", {|| "test00" } )
|
|
TEST_L_TBC( OBJ_CREATE() )
|
|
TEST_L_TBC( o:defColor := {} )
|
|
TEST_L_TBC( o:defColor := { 1 } )
|
|
TEST_L_TBC( o:defColor := NIL )
|
|
TEST_L_TBC( o:defColor := { 1, 2 } )
|
|
TEST_L_TBC( o:defColor := { 1, 2, 3 } )
|
|
TEST_L_TBC( o:defColor := { 1, 2, 3, 4 } )
|
|
TEST_L_TBC( o:defColor := { 1, 2, 3, 4, 5 } )
|
|
TEST_L_TBC( o:defColor := { "1" } )
|
|
TEST_L_TBC( o:defColor := { "1", "2" } )
|
|
TEST_L_TBC( o:defColor := { "1", "2", "3" } )
|
|
TEST_L_TBC( o:defColor := { "1", "2", "3", "4" } )
|
|
TEST_L_TBC( o:defColor := { "1", "2", "3", "4", "5" } )
|
|
TEST_L_TBC( o:defColor := { "1", 2, "3" } )
|
|
|
|
// ;
|
|
|
|
s_lCheckResult := .T.
|
|
|
|
TEST_L_TBC( TBColumnNew( NIL , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( -1 , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( 0 , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( 1 , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( 3 , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( 25 , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( "" , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( "az" , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( hb_SToD( "20070425" ), {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( .F. , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( .T. , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( {|| NIL } , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( {} , {|| "test00" } ) )
|
|
TEST_L_TBC( TBColumnNew( { "" } , {|| "test00" } ) )
|
|
|
|
TEST_L_TBC( TBColumnNew( "test00", NIL ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", -1 ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", 0 ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", 1 ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", 3 ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", 25 ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", "" ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", "az" ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", hb_SToD( "20070425" ) ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", .F. ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", .T. ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", {|| NIL } ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", {} ) )
|
|
TEST_L_TBC( TBColumnNew( "test00", { "" } ) )
|
|
|
|
s_lCheckResult := .F.
|
|
|
|
// ;
|
|
|
|
TBRAssign( NIL )
|
|
TBRAssign( -1 )
|
|
TBRAssign( 0 )
|
|
TBRAssign( 1 )
|
|
TBRAssign( 3 )
|
|
TBRAssign( 3.3 )
|
|
TBRAssign( 3.7 )
|
|
TBRAssign( 25 )
|
|
TBRAssign( 25.3 )
|
|
TBRAssign( 25.7 )
|
|
TBRAssign( "" )
|
|
TBRAssign( "az" )
|
|
TBRAssign( hb_SToD( "20070425" ) )
|
|
TBRAssign( .F. )
|
|
TBRAssign( .T. )
|
|
TBRAssign( {|| NIL } )
|
|
TBRAssign( {} )
|
|
TBRAssign( { "" } )
|
|
|
|
// ;
|
|
|
|
TBCAssign( NIL )
|
|
TBCAssign( -1 )
|
|
TBCAssign( 0 )
|
|
TBCAssign( 1 )
|
|
TBCAssign( 3 )
|
|
TBCAssign( 3.3 )
|
|
TBCAssign( 3.7 )
|
|
TBCAssign( 25 )
|
|
TBCAssign( 25.3 )
|
|
TBCAssign( 25.7 )
|
|
TBCAssign( "" )
|
|
TBCAssign( "az" )
|
|
TBCAssign( hb_SToD( "20070425" ) )
|
|
TBCAssign( .F. )
|
|
TBCAssign( .T. )
|
|
TBCAssign( {|| NIL } )
|
|
TBCAssign( {} )
|
|
TBCAssign( { "" } )
|
|
|
|
// ;
|
|
|
|
s_cTest := ""
|
|
|
|
// ;
|
|
|
|
s_lCatchErr := .F.
|
|
|
|
o := TBrowseNew( 10, 10, 20, 50 )
|
|
TEST_L_TBR( OBJ_CREATE() )
|
|
TEST_L_TBR( o:AddColumn( TBColumnNew( "test01h", {|| "test01d" } ) ) )
|
|
TEST_L_TBR( o:DelColumn( 1 ) )
|
|
TEST_L_TBR( o:Left() )
|
|
TEST_L_TBR( o:Right() )
|
|
|
|
// ;
|
|
|
|
#ifdef HB_COMPAT_C53
|
|
|
|
o := TBColumnNew( "test01h", {|| "test01d" } )
|
|
TEST_L_TBC( OBJ_CREATE() )
|
|
TEST_L_TBC( o:SetStyle( 1 ) )
|
|
TEST_L_TBC( o:SetStyle( 2 ) )
|
|
TEST_L_TBC( o:SetStyle( 3 ) )
|
|
TEST_L_TBC( o:SetStyle( 4, .T. ) )
|
|
TEST_L_TBC( o:SetStyle( 4 ) )
|
|
TEST_L_TBC( o:SetStyle( 4, NIL ) )
|
|
TEST_L_TBC( o:SetStyle( 4 ) )
|
|
TEST_L_TBC( o:SetStyle( 5 ) )
|
|
TEST_L_TBC( o:SetStyle( 5, .T. ) )
|
|
TEST_L_TBC( o:SetStyle( 5, .F. ) )
|
|
|
|
o := TBrowseNew( 10, 10, 20, 50 )
|
|
TEST_L_TBR( OBJ_CREATE() )
|
|
TEST_L_TBR( o:SetStyle( 1 ) )
|
|
TEST_L_TBR( o:SetStyle( 2 ) )
|
|
TEST_L_TBR( o:SetStyle( 3 ) )
|
|
TEST_L_TBR( o:SetStyle( 4 ) )
|
|
TEST_L_TBR( o:SetStyle( 5 ) )
|
|
TEST_L_TBR( o:SetStyle( 4, .T. ) )
|
|
TEST_L_TBR( o:SetStyle( 4 ) )
|
|
TEST_L_TBR( o:SetStyle( 4, NIL ) )
|
|
TEST_L_TBR( o:SetStyle( 4 ) )
|
|
TEST_L_TBR( o:SetStyle( 6 ) )
|
|
TEST_L_TBR( o:SetStyle( 6, .T. ) )
|
|
TEST_L_TBR( o:SetStyle( 6, .F. ) )
|
|
|
|
#endif
|
|
|
|
// ;
|
|
|
|
FClose( s_fhnd )
|
|
|
|
RETURN
|
|
|
|
PROCEDURE TBRAssign( xVar )
|
|
LOCAL o
|
|
|
|
s_xVar := xVar
|
|
|
|
s_cTest := "TBrowse (empty) assigning: " + XToStr( xVar )
|
|
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:AutoLite := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:Cargo := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:ColCount := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:ColorSpec := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:ColPos := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:ColSep := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:FootSep := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:Freeze := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:GoBottomBlock := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:GoTopBlock := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:HeadSep := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:HitBottom := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:HitTop := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:LeftVisible := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nBottom := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nLeft := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nRight := xVar )
|
|
// ; This is needed for CA-Cl*pper 5.x otherwise an unmaskable (bug?) RTE would be thrown. [vszakats]
|
|
IF ValType( xVar ) == "N" .AND. xVar < o:nBottom
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nTop := xVar )
|
|
ENDIF
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:RightVisible := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:RowCount := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:RowPos := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:SkipBlock := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:Stable := xVar )
|
|
#ifdef HB_COMPAT_C53
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:border := xVar )
|
|
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:message := xVar )
|
|
#endif
|
|
|
|
RETURN
|
|
|
|
PROCEDURE TBCAssign( xVar )
|
|
LOCAL o
|
|
|
|
s_xVar := xVar
|
|
|
|
s_cTest := "TBColumn assigning: " + XToStr( xVar )
|
|
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Block := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Cargo := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:ColorBlock := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:ColSep := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:DefColor := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Footing := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:FootSep := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Heading := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:HeadSep := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Picture := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:Width := xVar )
|
|
#ifdef HB_COMPAT_C53
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:preBlock := xVar )
|
|
o := TBColumnNew( "test01h", {|| "test01d" } ) ; TEST_L_TBC( o:postBlock := xVar )
|
|
#endif
|
|
|
|
RETURN
|
|
|
|
PROCEDURE TEST_C_TBR( o, cBlock, bBlock )
|
|
LOCAL xResult
|
|
LOCAL bOldError
|
|
LOCAL oError
|
|
|
|
SetPos( 0, 0 ) // ; To check where the cursor was moved after evaluating the block.
|
|
|
|
IF s_lCatchErr
|
|
bOldError := ErrorBlock( {| oError | Break( oError ) } )
|
|
ENDIF
|
|
|
|
BEGIN SEQUENCE
|
|
xResult := Eval( bBlock )
|
|
RECOVER USING oError
|
|
xResult := ErrorMessage( oError )
|
|
END SEQUENCE
|
|
|
|
IF s_lCatchErr
|
|
ErrorBlock( bOldError )
|
|
ENDIF
|
|
|
|
LogTBRVars( o, cBlock, xResult )
|
|
|
|
RETURN
|
|
|
|
PROCEDURE TEST_C_TBC( o, cBlock, bBlock )
|
|
LOCAL xResult
|
|
LOCAL bOldError
|
|
LOCAL oError
|
|
|
|
SetPos( 0, 0 ) // ; To check where the cursor was moved after evaluating the block.
|
|
|
|
IF s_lCatchErr
|
|
bOldError := ErrorBlock( {| oError | Break( oError ) } )
|
|
ENDIF
|
|
|
|
BEGIN SEQUENCE
|
|
xResult := Eval( bBlock )
|
|
RECOVER USING oError
|
|
xResult := ErrorMessage( oError )
|
|
END SEQUENCE
|
|
|
|
IF s_lCatchErr
|
|
ErrorBlock( bOldError )
|
|
ENDIF
|
|
|
|
IF s_lCheckResult
|
|
LogTBCVars( xResult, cBlock, xResult )
|
|
ELSE
|
|
LogTBCVars( o, cBlock, xResult )
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
PROCEDURE LogMe( data, desc )
|
|
LOCAL nLevel
|
|
LOCAL cStack
|
|
|
|
cStack := ""
|
|
FOR nLevel := 2 TO 5
|
|
IF Empty( ProcName( nLevel ) )
|
|
EXIT
|
|
ENDIF
|
|
cStack += ProcName( nLevel ) + " (" + hb_ntos( ProcLine( nLevel ) ) + ") "
|
|
NEXT
|
|
|
|
IF desc == NIL
|
|
desc := ""
|
|
ENDIF
|
|
desc := s_cTest + " " + desc
|
|
|
|
IF ! s_lCallBackStack
|
|
cStack := ""
|
|
ENDIF
|
|
|
|
IF PCount() > 2
|
|
FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + hb_eol() )
|
|
ELSE
|
|
FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + hb_eol() )
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
PROCEDURE LogTBRVars( o, desc, xResult )
|
|
LOCAL nLevel
|
|
LOCAL cStack
|
|
|
|
LOCAL tmp
|
|
LOCAL col
|
|
|
|
cStack := ""
|
|
FOR nLevel := 2 TO 2
|
|
IF Empty( ProcName( nLevel ) )
|
|
EXIT
|
|
ENDIF
|
|
cStack += ProcName( nLevel ) + " (" + hb_ntos( ProcLine( nLevel ) ) + ") "
|
|
NEXT
|
|
|
|
IF desc == NIL
|
|
desc := ""
|
|
ENDIF
|
|
desc := s_cTest + " " + XToStr( desc )
|
|
|
|
FWrite( s_fhnd, cStack + " " + desc + hb_eol() )
|
|
FWrite( s_fhnd, "---------------------" + hb_eol() )
|
|
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + hb_eol() )
|
|
FWrite( s_fhnd, " xResult " + XToStr( xResult ) + hb_eol() )
|
|
FWrite( s_fhnd, " Row() " + XToStr( Row() ) + hb_eol() )
|
|
FWrite( s_fhnd, " Col() " + XToStr( Col() ) + hb_eol() )
|
|
FWrite( s_fhnd, " AutoLite " + XToStr( o:AutoLite ) + hb_eol() )
|
|
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColCount " + XToStr( o:ColCount ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColorSpec " + XToStr( o:ColorSpec ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColPos " + XToStr( o:ColPos ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColSep " + XToStr( o:ColSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " FootSep " + XToStr( o:FootSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " Freeze " + XToStr( o:Freeze ) + hb_eol() )
|
|
FWrite( s_fhnd, " GoBottomBlock " + XToStr( o:GoBottomBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " GoTopBlock " + XToStr( o:GoTopBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " HeadSep " + XToStr( o:HeadSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " HitBottom " + XToStr( o:HitBottom ) + hb_eol() )
|
|
FWrite( s_fhnd, " HitTop " + XToStr( o:HitTop ) + hb_eol() )
|
|
FWrite( s_fhnd, " LeftVisible " + XToStr( o:LeftVisible ) + hb_eol() )
|
|
FWrite( s_fhnd, " nBottom " + XToStr( o:nBottom ) + hb_eol() )
|
|
FWrite( s_fhnd, " nLeft " + XToStr( o:nLeft ) + hb_eol() )
|
|
FWrite( s_fhnd, " nRight " + XToStr( o:nRight ) + hb_eol() )
|
|
FWrite( s_fhnd, " nTop " + XToStr( o:nTop ) + hb_eol() )
|
|
FWrite( s_fhnd, " RightVisible " + XToStr( o:RightVisible ) + hb_eol() )
|
|
FWrite( s_fhnd, " RowCount " + XToStr( o:RowCount ) + hb_eol() )
|
|
FWrite( s_fhnd, " RowPos " + XToStr( o:RowPos ) + hb_eol() )
|
|
FWrite( s_fhnd, " SkipBlock " + XToStr( o:SkipBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " Stable " + XToStr( o:Stable ) + hb_eol() )
|
|
#ifdef HB_COMPAT_C53
|
|
FWrite( s_fhnd, " border " + XToStr( o:border ) + hb_eol() )
|
|
FWrite( s_fhnd, " message " + XToStr( o:message ) + hb_eol() )
|
|
#endif
|
|
IF s_lObjectDump
|
|
#ifdef __HARBOUR__
|
|
#ifdef HB_COMPAT_C53
|
|
FOR tmp := 1 TO 18
|
|
#else
|
|
FOR tmp := 1 TO 13
|
|
#endif
|
|
#else
|
|
FOR tmp := 1 TO Len( o )
|
|
#endif
|
|
/* [14] is binary data, not replicated in Harbour. */
|
|
IF tmp != 14
|
|
FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_eol() )
|
|
ENDIF
|
|
NEXT
|
|
ENDIF
|
|
FOR tmp := 1 TO o:colCount
|
|
FWrite( s_fhnd, " Column: " + StrZero( tmp, 3 ) + hb_eol() )
|
|
col := o:GetColumn( tmp )
|
|
IF ValType( col ) == "O"
|
|
FWrite( s_fhnd, " Block " + XToStr( col:Block ) + hb_eol() )
|
|
FWrite( s_fhnd, " Cargo " + XToStr( col:Cargo ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColorBlock " + XToStr( col:ColorBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColSep " + XToStr( col:ColSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " DefColor " + XToStr( col:DefColor ) + hb_eol() )
|
|
FWrite( s_fhnd, " Footing " + XToStr( col:Footing ) + hb_eol() )
|
|
FWrite( s_fhnd, " FootSep " + XToStr( col:FootSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " Heading " + XToStr( col:Heading ) + hb_eol() )
|
|
FWrite( s_fhnd, " HeadSep " + XToStr( col:HeadSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " Picture " + XToStr( col:Picture ) + hb_eol() )
|
|
FWrite( s_fhnd, " Width " + XToStr( col:Width ) + hb_eol() )
|
|
#ifdef HB_COMPAT_C53
|
|
FWrite( s_fhnd, " preBlock " + XToStr( col:preBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " postBlock " + XToStr( col:postBlock ) + hb_eol() )
|
|
#endif
|
|
ELSE
|
|
FWrite( s_fhnd, " Col: " + XToStr( col ) + hb_eol() )
|
|
ENDIF
|
|
NEXT
|
|
FWrite( s_fhnd, "---------------------" + hb_eol() )
|
|
|
|
RETURN
|
|
|
|
PROCEDURE LogTBCVars( o, desc, xResult )
|
|
LOCAL nLevel
|
|
LOCAL cStack
|
|
|
|
LOCAL tmp
|
|
|
|
cStack := ""
|
|
FOR nLevel := 2 TO 2
|
|
IF Empty( ProcName( nLevel ) )
|
|
EXIT
|
|
ENDIF
|
|
cStack += ProcName( nLevel ) + " (" + hb_ntos( ProcLine( nLevel ) ) + ") "
|
|
NEXT
|
|
|
|
IF desc == NIL
|
|
desc := ""
|
|
ENDIF
|
|
desc := s_cTest + " " + XToStr( desc )
|
|
|
|
FWrite( s_fhnd, cStack + " " + desc + hb_eol() )
|
|
FWrite( s_fhnd, "---------------------" + hb_eol() )
|
|
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + hb_eol() )
|
|
FWrite( s_fhnd, " xResult " + XToStr( xResult ) + hb_eol() )
|
|
IF ValType( o ) == "O"
|
|
FWrite( s_fhnd, " Block " + XToStr( o:Block ) + hb_eol() )
|
|
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColorBlock " + XToStr( o:ColorBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " ColSep " + XToStr( o:ColSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " DefColor " + XToStr( o:DefColor ) + hb_eol() )
|
|
FWrite( s_fhnd, " Footing " + XToStr( o:Footing ) + hb_eol() )
|
|
FWrite( s_fhnd, " FootSep " + XToStr( o:FootSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " Heading " + XToStr( o:Heading ) + hb_eol() )
|
|
FWrite( s_fhnd, " HeadSep " + XToStr( o:HeadSep ) + hb_eol() )
|
|
FWrite( s_fhnd, " Picture " + XToStr( o:Picture ) + hb_eol() )
|
|
FWrite( s_fhnd, " Width " + XToStr( o:Width ) + hb_eol() )
|
|
#ifdef HB_COMPAT_C53
|
|
FWrite( s_fhnd, " preBlock " + XToStr( o:preBlock ) + hb_eol() )
|
|
FWrite( s_fhnd, " postBlock " + XToStr( o:postBlock ) + hb_eol() )
|
|
#endif
|
|
IF s_lObjectDump
|
|
#ifdef __HARBOUR__
|
|
#ifdef HB_COMPAT_C53
|
|
FOR tmp := 1 TO 14
|
|
#else
|
|
FOR tmp := 1 TO 11
|
|
#endif
|
|
#else
|
|
FOR tmp := 1 TO Len( o )
|
|
#endif
|
|
FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_eol() )
|
|
NEXT
|
|
ENDIF
|
|
ELSE
|
|
FWrite( s_fhnd, " o " + XToStr( o ) + hb_eol() )
|
|
ENDIF
|
|
FWrite( s_fhnd, "---------------------" + hb_eol() )
|
|
|
|
RETURN
|
|
|
|
FUNCTION XToStr( xValue )
|
|
LOCAL cType := ValType( xValue )
|
|
|
|
DO CASE
|
|
CASE cType == "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 cType == "N" ; RETURN hb_ntos( xValue )
|
|
CASE cType == "D" ; RETURN 'hb_SToD("' + DToS( 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 '{||...} -> ' + 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 )
|
|
|
|
DO CASE
|
|
CASE cType == "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 cType == "N" ; RETURN hb_ntos( xValue )
|
|
CASE cType == "D" ; RETURN DToS( 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 '{||...} -> ' + XToStrE( Eval( xValue ) )
|
|
CASE cType == "A" ; RETURN '{ ' + ArrayToEList( xValue ) + ' }'
|
|
CASE cType == "M" ; RETURN 'M:' + xValue
|
|
ENDCASE
|
|
|
|
RETURN ""
|
|
|
|
FUNCTION XToStrX( xValue )
|
|
LOCAL cType := ValType( xValue )
|
|
|
|
LOCAL tmp
|
|
LOCAL cRetVal
|
|
|
|
DO CASE
|
|
CASE cType == "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 cType == "N" ; RETURN hb_ntos( xValue )
|
|
CASE cType == "D" ; RETURN DToS( 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 == "A"
|
|
|
|
cRetVal := '{ '
|
|
|
|
FOR tmp := 1 TO Len( xValue )
|
|
cRetVal += XToStrX( xValue[ tmp ] )
|
|
IF tmp < Len( xValue )
|
|
cRetVal += ", "
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN cRetVal + ' }'
|
|
|
|
CASE cType == "M" ; RETURN 'M:' + xValue
|
|
ENDCASE
|
|
|
|
RETURN ""
|
|
|
|
FUNCTION ArrayToEList( a )
|
|
LOCAL tmp
|
|
LOCAL cString := ""
|
|
|
|
FOR tmp := 1 TO Len( a )
|
|
cString += XToStrE( a[ tmp ] )
|
|
IF tmp < Len( a )
|
|
cString += ", "
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN cString
|
|
|
|
STATIC FUNCTION ErrorMessage( oError )
|
|
LOCAL cMessage
|
|
LOCAL tmp
|
|
|
|
IF s_lRTEDetails
|
|
|
|
cMessage := ""
|
|
|
|
IF ValType( oError:severity ) == "N"
|
|
DO CASE
|
|
CASE oError:severity == ES_WHOCARES ; cMessage += "M "
|
|
CASE oError:severity == ES_WARNING ; cMessage += "W "
|
|
CASE oError:severity == ES_ERROR ; cMessage += "E "
|
|
CASE oError:severity == ES_CATASTROPHIC ; cMessage += "C "
|
|
ENDCASE
|
|
ENDIF
|
|
IF ValType( oError:subsystem ) == "C"
|
|
cMessage += oError:subsystem + " "
|
|
ENDIF
|
|
IF ValType( oError:subCode ) == "N"
|
|
cMessage += hb_ntos( oError:subCode ) + " "
|
|
ENDIF
|
|
IF ValType( oError:description ) == "C"
|
|
cMessage += oError:description + " "
|
|
ENDIF
|
|
IF ! Empty( oError:operation ) .AND. ! s_lIgnoreErrOp
|
|
/* NOTE: Clipping this to hide the difference in maximum symbol name length in error messages. [vszakats] */
|
|
cMessage += Left( oError:operation, 9 ) + " "
|
|
ENDIF
|
|
IF ! Empty( oError:filename )
|
|
cMessage += oError:filename + " "
|
|
ENDIF
|
|
|
|
IF ValType( oError:Args ) == "A"
|
|
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
|
|
ELSE
|
|
cMessage := "(ERROR)"
|
|
ENDIF
|
|
|
|
RETURN cMessage
|
|
|
|
#ifdef __XPP__
|
|
FUNCTION hb_SToD( cDate )
|
|
RETURN SToD( cDate )
|
|
#endif
|
|
|
|
#ifdef __XHARBOUR__
|
|
FUNCTION hb_SToD( cDate )
|
|
RETURN SToD( cDate )
|
|
#endif
|
|
|
|
#ifndef HAVE_HBCLIP
|
|
#ifndef __HARBOUR__
|
|
#ifndef __XPP__
|
|
|
|
FUNCTION hb_SToD( s )
|
|
|
|
LOCAL cDf := Set( _SET_DATEFORMAT, "YYYY/MM/DD" ), dt
|
|
|
|
dt := CToD( Stuff( Stuff( s, 7, 0, "/" ), 5, 0, "/" ) )
|
|
Set( _SET_DATEFORMAT, cDf )
|
|
|
|
RETURN dt
|
|
|
|
#endif
|
|
#endif
|
|
#endif
|
|
|
|
PROCEDURE OBJ_CREATE()
|
|
|
|
// ; Dummy
|
|
|
|
RETURN
|
|
|
|
/* We use this to wash out a small incompatibility in Harbour's built-in __eInstVar53(). */
|
|
|
|
FUNCTION __eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid )
|
|
|
|
LOCAL oError
|
|
|
|
IF !( ValType( xValue ) == cType ) .OR. ;
|
|
( bValid != NIL .AND. ! Eval( bValid, oVar, xValue ) )
|
|
oError := ErrorNew()
|
|
oError:description := hb_langErrMsg( 1 )
|
|
oError:gencode := 1
|
|
oError:severity := 2
|
|
oError:cansubstitute := .T.
|
|
oError:subsystem := oVar:classname
|
|
HB_SYMBOL_UNUSED( cMethod )
|
|
oError:subcode := nSubCode
|
|
oError:args := { xValue }
|
|
xValue := Eval( ErrorBlock(), oError )
|
|
IF !( ValType( xValue ) == cType )
|
|
__errInHandler()
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN xValue
|