fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
fdac3b6883a89ddced64f75e961bf8848bbd61ba
harbour-core/harbour/tests/rto_tb.prg
Viktor Szakats 0ea981e9c4 2009-06-03 12:20 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) 
* tests/langapi.prg
  * tests/rto_get.prg
  * tests/lnlenli2.prg
  * tests/fortest.prg
  * tests/memory.prg
  * tests/rto_tb.prg
  * tests/statinit.prg
  * tests/memfile.prg
  * tests/vec1.prg
  * tests/lnlenli1.prg
  * doc/cmdline.txt
  * doc/en-EN/hb_date.txt
  * doc/en-EN/terminal.txt
  * doc/en-EN/hb_apiln.txt
  * doc/en-EN/hb_compa.txt
  * doc/howtosvn.txt
  * INSTALL
  * bin/postinst.cmd
  * bin/postinst.bat
  * include/hbvmpub.h
  * include/vm.api
  * include/extend.api
  * include/item.api
  * include/hbapilng.h
  * include/rdd.api
  * include/gt.api
  * include/hbundoc.api
  * include/error.api
  * include/hbsetup.ch
  * include/hblang.ch
  * include/hbsetup.h
  * include/hbapigt.h
  * include/hbmemory.ch
  * include/clipdefs.h
  * include/hboo.ch
  * include/hbver.ch
  * include/hbzlib.h
  * include/fm.api
  * include/hbdate.h
  * include/extend.h
  * ChangeLog
  * harbour.spec
  * make_gnu.bat
  * make_gnu.sh
  * contrib/hbmysql/mysqlold.c
  * contrib/hbct/charmix.c
  * contrib/hbct/charevod.c
  * contrib/hbct/ctchksum.c
  * contrib/hbct/pos1.c
  * contrib/hbct/ctmisc.prg
  * contrib/hbct/ctcrypt.c
  * contrib/hbct/getinfo.prg
  * contrib/hbct/ctdummy.prg
  * contrib/hbct/readme.txt
  * contrib/hbodbc/odbcold.c
  * contrib/hbodbc/browodbc.prg
  * contrib/hbodbc/odbc.c
  * contrib/xhb/datesxhb.c
  * contrib/xhb/xhbat.c
  * contrib/xhb/xhbver.prg
  * contrib/xhb/xhbcomp.prg
  * contrib/hbziparc/hbziparc.prg
  * contrib/hbnf/iamidle.c
  * contrib/hbnf/fttext.c
  * contrib/hbnf/setkeys.c
  * contrib/hbnf/ftisprn.c
  * contrib/hbnf/setlastk.c
  * contrib/hbcurl/hbcurl.c
  * contrib/hbcurl/hbcurl.ch
  * contrib/hbcurl/hbcurlm.c
  * contrib/rddads/adsextrn.ch
  * contrib/rddads/adsmgmnt.c
  * contrib/hbmisc/strfmt.c
  * contrib/hbmisc/numtxthu.prg
  * contrib/hbmisc/doc/en/ht_str.txt
  * contrib/hbtip/utils.c
  * contrib/hbwin/win_reg.prg
  * contrib/hbwin/legacyc.c
  * contrib/hbwin/win_misc.c
  * contrib/hbwin/wapi_winbase.c
  * contrib/hbwin/wapi_winuser.c
  * contrib/hbwin/hbwinole.h
  * contrib/hbwin/hbwin.ch
  * contrib/hbwin/tests/testdll.prg
  * contrib/hbwin/tests/testole.prg
  * contrib/hbwin/win_regc.c
  * contrib/hbvpdf/hbvpsup.prg
  * contrib/hbssl/sslsess.c
  * contrib/hbssl/hbssl.h
  * contrib/hbssl/sslctx.c
  * contrib/hbssl/tests/test.prg
  * contrib/hbssl/ssl.c
  * contrib/hbssl/hbssl.ch
  * contrib/hbssl/sslciph.c
  * contrib/hbssl/sslrand.c
  * contrib/hbcrypt/tests/testsha2.prg
  * contrib/hbcrypt/hbsha2.c
  * contrib/hbcrypt/hbsha2hm.c
  * source/lang/msghuiso.c
  * source/lang/msghuwin.c
  * source/lang/msgro.c
  * source/lang/msghriso.c
  * source/lang/msghrwin.c
  * source/lang/msghe862.c
  * source/lang/msgcskam.c
  * source/lang/msgbgiso.c
  * source/lang/msgbgwin.c
  * source/lang/msgcs852.c
  * source/lang/msgfr.c
  * source/lang/msgis850.c
  * source/lang/msghu852.c
  * source/lang/msgbg866.c
  * source/lang/msghr852.c
  * source/lang/msghewin.c
  * source/lang/msghucwi.c
  * source/lang/msgcsiso.c
  * source/lang/msgcswin.c
  * source/vm/harbinit.prg
  * source/vm/asort.c
  * source/vm/itemapi.c
  * source/vm/hvm.c
  * source/vm/cmdarg.c
  * source/vm/arrays.c
  * source/vm/fm.c
  * source/vm/extrap.c
  * source/vm/proc.c
  * source/vm/memvars.c
  * source/vm/memvclip.c
  * source/vm/main.c
  * source/vm/eval.c
  * source/vm/extend.c
  * source/vm/set.c
  * source/vm/classes.c
  * source/common/hbver.c
  * source/common/hbfsapi.c
  * source/common/hbstr.c
  * source/common/hbdate.c
  * source/rtl/lennum.c
  * source/rtl/gtdos/gtdos.c
  * source/rtl/diskspac.c
  * source/rtl/setposbs.c
  * source/rtl/mousehb.c
  * source/rtl/console.c
  * source/rtl/fscopy.c
  * source/rtl/gtwin/gtwin.c
  * source/rtl/mousex.c
  * source/rtl/philes.c
  * source/rtl/adir.prg
  * source/rtl/oldclear.c
  * source/rtl/tbcolumn.prg
  * source/rtl/hbgtcore.c
  * source/rtl/fieldbl.prg
  * source/rtl/dirdrive.c
  * source/rtl/dateshb.c
  * source/rtl/philesx.c
  * source/rtl/fnsplit.c
  * source/rtl/box.c
  * source/rtl/datesx.c
  * source/rtl/filehb.c
  * source/rtl/hbfile.c
  * source/rtl/gtapiu.c
  * source/rtl/fstemp.c
  * source/rtl/accept.c
  * source/rtl/radiobhb.prg
  * source/rtl/tgethb.prg
  * source/rtl/oemansix.c
  * source/rtl/strmatch.c
  * source/rtl/readkey.prg
  * source/rtl/ampm.c
  * source/rtl/oemansi.c
  * source/rtl/xsavescr.c
  * source/rtl/gtstd/gtstd.c
  * source/rtl/gtsln/mousesln.c
  * source/rtl/disksphb.c
  * source/rtl/xhelp.c
  * source/rtl/getlist.prg
  * source/rtl/net.c
  * source/rtl/hbntos.c
  * source/rtl/tgetx.prg
  * source/rtl/samples.c
  * source/rtl/idlex.c
  * source/rtl/tget.prg
  * source/rtl/alert.prg
  * source/rtl/inkey.c
  * source/rtl/gete.c
  * source/rtl/readvar.prg
  * source/rtl/fkmax.c
  * source/rtl/strzero.c
  * source/rtl/typefilx.prg
  * source/rtl/langapi.c
  * source/rtl/word.c
  * source/rtl/gtcgi/gtcgi.c
  * source/rtl/fmhb.c
  * source/rtl/natmsgu.c
  * source/rtl/errapi.c
  * source/rtl/version.c
  * source/rtl/natmsg.c
  * source/rtl/mouse53.c
  * source/rtl/errint.c
  * source/rtl/fssize.c
  * source/rtl/errapiu.c
  * source/rtl/colorind.c
  * source/rtl/gt.c
  * source/rtl/gx.c
  * source/rtl/binnumx.c
  * source/rtl/mouseapi.c
  * source/rtl/soundex.c
  * source/rtl/memofile.c
  * source/rtl/errintlo.c
  * source/rtl/hbffind.c
  * source/rtl/gtapi.c
  * source/rtl/pad.c
  * source/rtl/hbstrsh.c
  * source/rtl/filesys.c
  * source/rtl/file.c
  * source/rtl/lang.c
  * source/rtl/val.c
  * source/rtl/isprint.c
  * source/rtl/tbrowse.prg
  * source/codepage/ucmacce.c
  * source/codepage/uc885910.c
  * source/codepage/ucmacice.c
  * source/codepage/uc885914.c
  * source/codepage/uc874.c
  * source/codepage/cpes850.c
  * source/codepage/uc1258.c
  * source/codepage/cphu852.c
  * source/codepage/cpsk852.c
  * source/codepage/uc424.c
  * source/codepage/ucmacrom.c
  * source/codepage/uc862.c
  * source/codepage/cpesisoc.c
  * source/codepage/cpbg866.c
  * source/codepage/cphu852s.c
  * source/codepage/uc8859_3.c
  * source/codepage/uc8859_7.c
  * source/codepage/ucmacgrk.c
  * source/codepage/uc037.c
  * source/codepage/cpesiso.c
  * source/codepage/uc885911.c
  * source/codepage/uc885915.c
  * source/codepage/uc875.c
  * source/codepage/uc1255.c
  * source/codepage/cphuisos.c
  * source/codepage/cpfriso.c
  * source/codepage/uc863.c
  * source/codepage/cpfrwin.c
  * source/codepage/uc1026.c
  * source/codepage/cpbgiso.c
  * source/codepage/uc8859_4.c
  * source/codepage/cpskkam.c
  * source/codepage/cpbgwin.c
  * source/codepage/uc8859_8.c
  * source/codepage/uc855.c
  * source/codepage/uc885916.c
  * source/codepage/cproiso.c
  * source/codepage/ucascii.c
  * source/codepage/cprowin.c
  * source/codepage/uc1256.c
  * source/codepage/ucatari.c
  * source/codepage/uc860.c
  * source/codepage/ucmaccyr.c
  * source/codepage/uc864.c
  * source/codepage/uc1006.c
  * source/codepage/cpsviso.c
  * source/codepage/uc8859_5.c
  * source/codepage/uc8859_9.c
  * source/codepage/cphuwins.c
  * source/codepage/ucnext.c
  * source/codepage/ucmactrk.c
  * source/codepage/uc885913.c
  * source/codepage/cphuiso.c
  * source/codepage/uc775.c
  * source/codepage/uc856.c
  * source/codepage/cpskiso.c
  * source/codepage/cphuwin.c
  * source/codepage/cpskwin.c
  * source/codepage/uc500.c
  * source/codepage/cpro852.c
  * source/codepage/uc861.c
  * source/codepage/uc865.c
  * source/codepage/cpitwin.c
  * source/codepage/uc869.c
  * source/codepage/uc8859_6.c
  * source/rdd/dbjoinx.prg
  * source/rdd/dbnubs.c
  * source/rdd/dblistx.prg
  * source/rdd/dbtotalx.prg
  * source/rdd/dbstruxx.prg
  * source/rdd/dbsortx.prg
  * source/rdd/dbupdatx.prg
  * source/rdd/dbfuncsx.prg
  * source/rdd/dbcmdhb.c
  * source/compiler/cmdcheck.c
  * source/compiler/hbusage.c
  * source/hbzlib/ChangeLog
  * utils/hbmk2/hbmk2.prg
  * utils/hbtest/rt_main.h
  * utils/hbtest/hbtest.prg
  * utils/hbtest/rt_main.ch
  * utils/hbtest/rt_trans.prg
  * utils/hbtest/rt_miscc.c
  * utils/hbtest/rt_math.prg
  * utils/hbtest/rt_hvm.prg
  * utils/hbtest/rt_hvma.prg
  * utils/hbtest/rt_misc.prg
  * utils/hbtest/make_c5x.bat
  * utils/hbtest/rt_init.ch
  * utils/hbtest/rt_str.prg
  * utils/hbtest/rt_stra.prg
  * utils/hbtest/rt_date.prg
  * utils/hbtest/rt_vars.ch
  * utils/hbtest/rt_array.prg
  * utils/hbtest/rt_file.prg
  * examples/pp/hbppcore.c
  * examples/superlib/hbsuper.prg
    * My e-mail address corrected to the same one using the
      same format in all files. Corrected mistyped ones.
2009-06-03 10:26:40 +00:00

850 lines
28 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* Regression tests for classes TBrowse/TBColumn
*
* Copyright 1999-2007 Viktor Szakats (harbour.01 syenar.hu)
* www - http://www.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.
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* eInstVar() (from RTL)
*
* See COPYING for licensing terms.
*
*/
/* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
#ifndef __HARBOUR__
#define hb_OSNewLine() ( Chr( 13 ) + Chr( 10 ) )
#endif
#ifdef __XHARBOUR__
#ifndef HB_COMPAT_C53
/* It makes xhb crash. */
/* #define HB_COMPAT_C53 */
#endif
#endif
#translate TEST_L_TBR( <x> ) => TEST_C_TBR( o, #<x>, {|| <x> } )
#translate 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
FUNCTION Main( cArg01, cArg02, cArg03, cArg04 )
LOCAL o
LOCAL cCommandLine
DEFAULT cArg01 TO ""
DEFAULT cArg02 TO ""
DEFAULT cArg03 TO ""
DEFAULT cArg04 TO ""
SET DATE ANSI
// ;
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 1
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 0
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 ISNUMBER( xVar ) .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 ) + " (" + LTrim( Str( 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_OSNewLine() )
ELSE
FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + hb_OSNewLine() )
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 ) + " (" + LTrim( Str( ProcLine( nLevel ) ) ) + ") "
NEXT
IF desc == NIL
desc := ""
ENDIF
desc := s_cTest + " " + XToStr( desc )
FWrite( s_fhnd, cStack + " " + desc + hb_OSNewLine() )
FWrite( s_fhnd, "---------------------" + hb_OSNewLine() )
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + hb_OSNewLine() )
FWrite( s_fhnd, " xResult " + XToStr( xResult ) + hb_OSNewLine() )
FWrite( s_fhnd, " Row() " + XToStr( Row() ) + hb_OSNewLine() )
FWrite( s_fhnd, " Col() " + XToStr( Col() ) + hb_OSNewLine() )
FWrite( s_fhnd, " AutoLite " + XToStr( o:AutoLite ) + hb_OSNewLine() )
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColCount " + XToStr( o:ColCount ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColorSpec " + XToStr( o:ColorSpec ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColPos " + XToStr( o:ColPos ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColSep " + XToStr( o:ColSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " FootSep " + XToStr( o:FootSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " Freeze " + XToStr( o:Freeze ) + hb_OSNewLine() )
FWrite( s_fhnd, " GoBottomBlock " + XToStr( o:GoBottomBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " GoTopBlock " + XToStr( o:GoTopBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " HeadSep " + XToStr( o:HeadSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " HitBottom " + XToStr( o:HitBottom ) + hb_OSNewLine() )
FWrite( s_fhnd, " HitTop " + XToStr( o:HitTop ) + hb_OSNewLine() )
FWrite( s_fhnd, " LeftVisible " + XToStr( o:LeftVisible ) + hb_OSNewLine() )
FWrite( s_fhnd, " nBottom " + XToStr( o:nBottom ) + hb_OSNewLine() )
FWrite( s_fhnd, " nLeft " + XToStr( o:nLeft ) + hb_OSNewLine() )
FWrite( s_fhnd, " nRight " + XToStr( o:nRight ) + hb_OSNewLine() )
FWrite( s_fhnd, " nTop " + XToStr( o:nTop ) + hb_OSNewLine() )
FWrite( s_fhnd, " RightVisible " + XToStr( o:RightVisible ) + hb_OSNewLine() )
FWrite( s_fhnd, " RowCount " + XToStr( o:RowCount ) + hb_OSNewLine() )
FWrite( s_fhnd, " RowPos " + XToStr( o:RowPos ) + hb_OSNewLine() )
FWrite( s_fhnd, " SkipBlock " + XToStr( o:SkipBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " Stable " + XToStr( o:Stable ) + hb_OSNewLine() )
#ifdef HB_COMPAT_C53
FWrite( s_fhnd, " border " + XToStr( o:border ) + hb_OSNewLine() )
FWrite( s_fhnd, " message " + XToStr( o:message ) + hb_OSNewLine() )
#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_OSNewLine() )
ENDIF
NEXT
ENDIF
FOR tmp := 1 TO o:colCount
FWrite( s_fhnd, " Column: " + StrZero( tmp, 3 ) + hb_OSNewLine() )
col := o:GetColumn( tmp )
IF ISOBJECT( col )
FWrite( s_fhnd, " Block " + XToStr( col:Block ) + hb_OSNewLine() )
FWrite( s_fhnd, " Cargo " + XToStr( col:Cargo ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColorBlock " + XToStr( col:ColorBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColSep " + XToStr( col:ColSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " DefColor " + XToStr( col:DefColor ) + hb_OSNewLine() )
FWrite( s_fhnd, " Footing " + XToStr( col:Footing ) + hb_OSNewLine() )
FWrite( s_fhnd, " FootSep " + XToStr( col:FootSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " Heading " + XToStr( col:Heading ) + hb_OSNewLine() )
FWrite( s_fhnd, " HeadSep " + XToStr( col:HeadSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " Picture " + XToStr( col:Picture ) + hb_OSNewLine() )
FWrite( s_fhnd, " Width " + XToStr( col:Width ) + hb_OSNewLine() )
#ifdef HB_COMPAT_C53
FWrite( s_fhnd, " preBlock " + XToStr( col:preBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " postBlock " + XToStr( col:postBlock ) + hb_OSNewLine() )
#endif
ELSE
FWrite( s_fhnd, " Col: " + XToStr( col ) + hb_OSNewLine() )
ENDIF
NEXT
FWrite( s_fhnd, "---------------------" + hb_OSNewLine() )
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 ) + " (" + LTrim( Str( ProcLine( nLevel ) ) ) + ") "
NEXT
IF desc == NIL
desc := ""
ENDIF
desc := s_cTest + " " + XToStr( desc )
FWrite( s_fhnd, cStack + " " + desc + hb_OSNewLine() )
FWrite( s_fhnd, "---------------------" + hb_OSNewLine() )
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + hb_OSNewLine() )
FWrite( s_fhnd, " xResult " + XToStr( xResult ) + hb_OSNewLine() )
IF ISOBJECT( o )
FWrite( s_fhnd, " Block " + XToStr( o:Block ) + hb_OSNewLine() )
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColorBlock " + XToStr( o:ColorBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " ColSep " + XToStr( o:ColSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " DefColor " + XToStr( o:DefColor ) + hb_OSNewLine() )
FWrite( s_fhnd, " Footing " + XToStr( o:Footing ) + hb_OSNewLine() )
FWrite( s_fhnd, " FootSep " + XToStr( o:FootSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " Heading " + XToStr( o:Heading ) + hb_OSNewLine() )
FWrite( s_fhnd, " HeadSep " + XToStr( o:HeadSep ) + hb_OSNewLine() )
FWrite( s_fhnd, " Picture " + XToStr( o:Picture ) + hb_OSNewLine() )
FWrite( s_fhnd, " Width " + XToStr( o:Width ) + hb_OSNewLine() )
#ifdef HB_COMPAT_C53
FWrite( s_fhnd, " preBlock " + XToStr( o:preBlock ) + hb_OSNewLine() )
FWrite( s_fhnd, " postBlock " + XToStr( o:postBlock ) + hb_OSNewLine() )
#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_OSNewLine() )
NEXT
ENDIF
ELSE
FWrite( s_fhnd, " o " + XToStr( o ) + hb_OSNewLine() )
ENDIF
FWrite( s_fhnd, "---------------------" + hb_OSNewLine() )
RETURN
STATIC FUNCTION ObjToList( o )
LOCAL cString := ""
LOCAL tmp
FOR tmp := 1 TO Len( o )
cString += XToStr( o[ tmp ] )
IF tmp < Len( o )
cString += ", "
ENDIF
NEXT
RETURN cString
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 LTrim( Str( 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 LTrim( Str( 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 LTrim( Str( 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 += LTrim( Str( 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:" + LTrim( Str( 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( cDate )
LOCAL cOldDateFormat
LOCAL dDate
IF ValType( cDate ) == "C" .AND. !Empty( cDate )
cOldDateFormat := Set( _SET_DATEFORMAT, "yyyy/mm/dd" )
dDate := CToD( SubStr( cDate, 1, 4 ) + "/" +;
SubStr( cDate, 5, 2 ) + "/" +;
SubStr( cDate, 7, 2 ) )
Set( _SET_DATEFORMAT, cOldDateFormat )
ELSE
dDate := CToD( "" )
ENDIF
RETURN dDate
#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
Reference in New Issue View Git Blame Copy Permalink