From 1100bf13dc606a52d4d43eeec65897ce36dd4560 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 23 Apr 2008 12:08:49 +0000 Subject: [PATCH] 2008-04-23 14:03 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * source/rtl/tget.prg ! Fixed o[13] and o[14] content (they were swapped) in C5.3 mode. ! Fixed ::varPut() to not have the extra Harbour parameter. ! Fixed ::picture to not mess with ::nDispLen when @S is used. Now solved with new internal var ::nPicLen. % ::ResetPar() internal method moved inside ::display() ! Fixed ::updateBuffer() to set ::xVarGet (o[19] in C5.3 mode and o[11] in C5.2 mode when ::hasFocus) to ::original. ! Fixed ::display() behavior when not in focus. ! Fixed ::reset() to be more compatible by setting ::xVarGet. ! Fixed ::undo() for non-gettable variable types. ! Fixed ::killFocus() to never call ::assign(). ! Fixed ::varPut() to never touch internal vars (old 'lReFormat' mode). ! Fixed ::varGet() to not touch ::xVarGet internal var. ! Fixed ::insert()/::overStrike() to call ::display() in out of bound and rejected cases. ! Fixed ::insert()/::overStrike() to not set ::Rejected when position is out of bound. ! Fixed internal ::PutMask() to never initiate a ::block evaluation. ; NOTE: Since Get() object is a highly complicated beast, bumps are expected. Pls test this code with your applications and report any problems with reduced code snippet. I'll include those tests in the regression test suite. Notice that after these changes, the number of differences between C5.x and Harbour are further reduced, especially regarding the "object as array" kind of access and regarding block evaluation. Currently, differences are mostly present in o[16] in C5.3 mode, plus some odd cases testing mostly invalid picture values, and a few other minor differences here and there. Plus of course further differences may happen to exist in cases not covered by rto_get.prg. * source/rtl/einstvar.prg ! Fixed to only include _eInstVar() if HB_C52_UNDOC is #defined (it is by default). * source/rtl/tbrowse.prg + Added missing XPP methods (three synomyms to existing methods). * tests/rto_get.prg + Added even more tests. + Added some additional info about errors. ! Fixed ::block SETGET tracing. --- harbour/ChangeLog | 50 +++++++ harbour/source/rtl/einstvar.prg | 4 + harbour/source/rtl/tbrowse.prg | 4 + harbour/source/rtl/tget.prg | 125 ++++++++---------- harbour/tests/rto_get.prg | 223 ++++++++++++++++++++++++++++++-- 5 files changed, 321 insertions(+), 85 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 46613df6ae..8bda9a4d12 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,56 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-04-23 14:03 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * source/rtl/tget.prg + ! Fixed o[13] and o[14] content (they were swapped) in C5.3 mode. + ! Fixed ::varPut() to not have the extra Harbour parameter. + ! Fixed ::picture to not mess with ::nDispLen when @S is used. + Now solved with new internal var ::nPicLen. + % ::ResetPar() internal method moved inside ::display() + ! Fixed ::updateBuffer() to set ::xVarGet (o[19] in C5.3 mode + and o[11] in C5.2 mode when ::hasFocus) to ::original. + ! Fixed ::display() behavior when not in focus. + ! Fixed ::reset() to be more compatible by setting ::xVarGet. + ! Fixed ::undo() for non-gettable variable types. + ! Fixed ::killFocus() to never call ::assign(). + ! Fixed ::varPut() to never touch internal vars (old 'lReFormat' mode). + ! Fixed ::varGet() to not touch ::xVarGet internal var. + ! Fixed ::insert()/::overStrike() to call ::display() in + out of bound and rejected cases. + ! Fixed ::insert()/::overStrike() to not set ::Rejected + when position is out of bound. + ! Fixed internal ::PutMask() to never initiate a ::block + evaluation. + ; NOTE: Since Get() object is a highly complicated beast, + bumps are expected. Pls test this code with your + applications and report any problems with reduced + code snippet. I'll include those tests in the + regression test suite. + Notice that after these changes, the number of + differences between C5.x and Harbour are further + reduced, especially regarding the "object as array" + kind of access and regarding block evaluation. + Currently, differences are mostly present in o[16] + in C5.3 mode, plus some odd cases testing + mostly invalid picture values, and a few other minor + differences here and there. Plus of course further + differences may happen to exist in cases not covered + by rto_get.prg. + + * source/rtl/einstvar.prg + ! Fixed to only include _eInstVar() if HB_C52_UNDOC is + #defined (it is by default). + + * source/rtl/tbrowse.prg + + Added missing XPP methods (three synomyms to + existing methods). + + * tests/rto_get.prg + + Added even more tests. + + Added some additional info about errors. + ! Fixed ::block SETGET tracing. + 2008-04-23 09:46 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/pp/ppcore.c ! fixed some combinations of user functions in stream pragmas, f.e.: diff --git a/harbour/source/rtl/einstvar.prg b/harbour/source/rtl/einstvar.prg index 0bc49b5295..6cd41b3a23 100644 --- a/harbour/source/rtl/einstvar.prg +++ b/harbour/source/rtl/einstvar.prg @@ -53,6 +53,8 @@ #include "common.ch" +#ifdef HB_C52_UNDOC + FUNCTION _eInstVar( ... ) #ifdef HB_COMPAT_C53 RETURN __eInstVar53( ... ) @@ -60,6 +62,8 @@ FUNCTION _eInstVar( ... ) RETURN __eInstVar52( ... ) #endif +#endif + /* NOTE: In CA-Cl*pper 5.2/5.3 the cMethod argument seems to be ignored. */ FUNCTION __eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid ) diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 6ce9da972a..dc604ae5b9 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -258,6 +258,10 @@ EXPORTED: #ifdef HB_COMPAT_XPP METHOD viewArea() // Xbase++ compatible method METHOD firstScrCol() // Xbase++ compatible method + + MESSAGE _left() METHOD Left() + MESSAGE _right() METHOD Right() + MESSAGE _end() METHOD End() #endif METHOD new( nTop, nLeft, nBottom, nRight ) // constructor, NOTE: This method is a Harbour extension [vszakats] diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 2e1562977d..7356a71dc1 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -105,8 +105,8 @@ CREATE CLASS Get #ifdef HB_COMPAT_C53 VAR oControl PROTECTED /* 11. CA-Clipper 5.3 only. */ VAR cCaption PROTECTED INIT "" /* 12. CA-Clipper 5.3 only. */ - VAR nCapRow PROTECTED INIT 0 /* 13. CA-Clipper 5.3 only. */ - VAR nCapCol PROTECTED INIT 0 /* 14. CA-Clipper 5.3 only. */ + VAR nCapCol PROTECTED INIT 0 /* 13. CA-Clipper 5.3 only. */ + VAR nCapRow PROTECTED INIT 0 /* 14. CA-Clipper 5.3 only. */ VAR cMessage PROTECTED INIT "" /* 15. CA-Clipper 5.3 only. */ VAR nDispLen PROTECTED /* 16. CA-Clipper 5.3 places it here. */ #endif @@ -160,7 +160,7 @@ CREATE CLASS Get METHOD unTransform() METHOD updateBuffer() METHOD varGet() - METHOD varPut( xValue, lReFormat ) /* NOTE: lReFormat is an undocumented Harbour parameter. Should not be used by app code. [vszakats] */ + METHOD varPut( xValue ) METHOD end() METHOD home() @@ -209,6 +209,7 @@ CREATE CLASS Get VAR cPicMask INIT "" VAR cPicFunc INIT "" + VAR nPicLen VAR nMaxLen VAR lEdit INIT .F. VAR lDecRev INIT .F. @@ -227,7 +228,6 @@ CREATE CLASS Get METHOD PutMask( xValue, lEdit ) METHOD FirstEditable() METHOD LastEditable() - METHOD ResetPar() ENDCLASS @@ -243,6 +243,7 @@ METHOD updateBuffer() CLASS Get IF ::hasFocus ::cBuffer := ::PutMask( ::varGet() ) + ::xVarGet := ::original ::display() ELSE ::varGet() @@ -263,22 +264,25 @@ METHOD display( lForced ) CLASS Get DEFAULT lForced TO .T. - IF ! ISCHARACTER( ::cBuffer ) - ::cType := ValType( ::xVarGet ) - ::picture := ::cPicture - ENDIF - IF ::hasFocus - cBuffer := ::cBuffer + cBuffer := ::cBuffer + + IF ::nMaxLen == NIL + ::nMaxLen := Len( cBuffer ) + ENDIF + IF ::nDispLen == NIL + ::nDispLen := ::nMaxLen + ENDIF ELSE - cBuffer := ::PutMask( ::varGet() ) + ::cType := ValType( ::xVarGet := ::varGet() ) + ::picture := ::cPicture + cBuffer := ::PutMask( ::xVarGet ) + ::nMaxLen := Len( cBuffer ) + ::nDispLen := ::nMaxLen ENDIF - IF ::nMaxLen == NIL - ::nMaxLen := Len( cBuffer ) - ENDIF - IF ::nDispLen == NIL - ::nDispLen := ::nMaxLen + IF ::nPicLen != NIL + ::nDispLen := ::nPicLen ENDIF IF ::cType == "N" .AND. ::hasFocus .AND. ! ::lMinusPrinted .AND. ; @@ -401,6 +405,8 @@ METHOD reset() CLASS Get IF ::hasFocus ::cBuffer := ::PutMask( ::varGet(), .F. ) + ::xVarGet := ::original + ::cType := ValType( ::xVarGet ) ::Pos := ::FirstEditable() /* ; Simple 0 in CA-Cl*pper [vszakats] */ ::lClear := ( "K" $ ::cPicFunc .OR. ::cType == "N" ) ::lEdit := .F. @@ -415,8 +421,9 @@ METHOD reset() CLASS Get METHOD undo() CLASS Get IF ::hasFocus - /* ! TOFIX: when PICTURE "@S" is used on a longer buffer. */ - ::varPut( ::original ) + IF ValType( ::original ) $ "CNDL" + ::varPut( ::original ) + ENDIF ::reset() ::lChanged := .F. ENDIF @@ -431,7 +438,7 @@ METHOD setFocus() CLASS Get RETURN Self ENDIF - xVarGet := ::varGet() + xVarGet := ::xVarGet := ::varGet() ::hasFocus := .T. ::rejected := .F. @@ -440,7 +447,23 @@ METHOD setFocus() CLASS Get ::cType := ValType( xVarGet ) ::picture := ::cPicture ::cBuffer := ::PutMask( xVarGet, .F. ) - ::ResetPar() + + ::nMaxLen := Len( ::cBuffer ) + + IF ::nDispLen == NIL + ::nDispLen := ::nMaxLen + ENDIF + + IF ::cType == "N" + ::decPos := At( iif( ::lDecRev .OR. "E" $ ::cPicFunc, ",", "." ), ::cBuffer ) + IF ::decPos == 0 + ::decPos := Len( ::cBuffer ) + 1 + ENDIF + ::lMinus2 := ( ::xVarGet < 0 ) + ELSE + ::decPos := 0 /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ + ENDIF + ::lChanged := .F. ::lClear := ( "K" $ ::cPicFunc .OR. ::cType == "N" ) ::lEdit := .F. @@ -455,13 +478,7 @@ METHOD setFocus() CLASS Get METHOD killFocus() CLASS Get - LOCAL lHadFocus - - IF ::lEdit - ::assign() - ENDIF - - lHadFocus := ::hasFocus + LOCAL lHadFocus := ::hasFocus ::hasFocus := .F. ::nPos := 0 @@ -481,12 +498,12 @@ METHOD killFocus() CLASS Get RETURN Self -METHOD varPut( xValue, lReFormat ) CLASS Get +METHOD varPut( xValue ) CLASS Get LOCAL aSubs LOCAL nLen - LOCAL aValue LOCAL i + LOCAL aValue IF ISBLOCK( ::bBlock ) aSubs := ::subScript @@ -506,16 +523,6 @@ METHOD varPut( xValue, lReFormat ) CLASS Get ELSE Eval( ::bBlock, xValue ) ENDIF - - DEFAULT lReFormat TO .T. - - IF lReFormat - ::cType := ValType( xValue ) - ::xVarGet := xValue - ::lEdit := .F. - ::picture := ::cPicture - ::nDispLen := NIL - ENDIF ELSE xValue := NIL ENDIF @@ -548,8 +555,6 @@ METHOD varGet() CLASS Get xValue := ::xVarGet ENDIF - ::xVarGet := xValue - RETURN xValue METHOD unTransform() CLASS Get @@ -685,7 +690,7 @@ METHOD overStrike( cChar ) CLASS Get ENDIF IF ::Pos > ::nMaxEdit - ::rejected := .T. + ::display() RETURN Self ENDIF @@ -693,6 +698,7 @@ METHOD overStrike( cChar ) CLASS Get IF cChar == "" ::rejected := .T. + ::display() RETURN Self ELSE ::rejected := .F. @@ -742,7 +748,7 @@ METHOD insert( cChar ) CLASS Get ENDIF IF ::nPos > ::nMaxEdit - ::rejected := .T. + ::display() RETURN Self ENDIF @@ -750,6 +756,7 @@ METHOD insert( cChar ) CLASS Get IF cChar == "" ::rejected := .T. + ::display() RETURN Self ELSE ::rejected := .F. @@ -1292,10 +1299,10 @@ METHOD picture( cPicture ) CLASS Get ::cPicFunc := "" ::cPicMask := "" ::lPicComplex := .F. + ::nPicLen := NIL IF ISCHARACTER( cPicture ) - ::nDispLen := NIL cNum := "" IF Left( cPicture, 1 ) == "@" @@ -1331,7 +1338,7 @@ METHOD picture( cPicture ) CLASS Get ENDIF NEXT IF Val( cNum ) > 0 - ::nDispLen := Val( cNum ) + ::nPicLen := Val( cNum ) ENDIF ::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor ) ENDIF @@ -1352,11 +1359,6 @@ METHOD picture( cPicture ) CLASS Get ::lCleanZero := .F. ENDIF -// IF ::cType == NIL -// ::original := ::xVarGet -// ::cType := ValType( ::original ) -// ENDIF - IF ::cType == "D" ::cPicMask := LTrim( ::cPicMask ) ENDIF @@ -1477,26 +1479,6 @@ METHOD lastEditable() CLASS Get RETURN 0 -METHOD resetPar() CLASS Get - - ::nMaxLen := Len( ::cBuffer ) - - IF ::nDispLen == NIL - ::nDispLen := ::nMaxLen - ENDIF - - IF ::cType == "N" - ::decPos := At( iif( ::lDecRev .OR. "E" $ ::cPicFunc, ",", "." ), ::cBuffer ) - IF ::decPos == 0 - ::decPos := Len( ::cBuffer ) + 1 - ENDIF - ::lMinus2 := ( ::xVarGet < 0 ) - ELSE - ::decPos := 0 /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ - ENDIF - - RETURN Self - METHOD badDate() CLASS Get LOCAL xValue @@ -1761,8 +1743,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get LOCAL nFor LOCAL nNoEditable := 0 - DEFAULT xValue TO ::varGet() - DEFAULT lEdit TO ::hasFocus + DEFAULT lEdit TO ::hasFocus IF !( ValType( xValue ) $ "CNDL" ) xValue := "" diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg index f42d518c4e..8a611a8268 100644 --- a/harbour/tests/rto_get.prg +++ b/harbour/tests/rto_get.prg @@ -74,13 +74,22 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) LOCAL nInt01 := 98 LOCAL cStr01 := "AbC DF 974" LOCAL cStr02E := "" + LOCAL cStr03 := "" + LOCAL cStr04 := "" + LOCAL cStr05 := "" + LOCAL cStr06 := "" +#ifdef NULL LOCAL dDate01 +#endif LOCAL bOldBlock LOCAL o LOCAL cCommandLine + LOCAL nOldRow + LOCAL nOldCol + DEFAULT cArg01 TO "" DEFAULT cArg02 TO "" DEFAULT cArg03 TO "" @@ -151,16 +160,88 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) // ; colorDisp / VarPut / display (::nDispLen recalc) - SetPos( 14, 16 ) ; o := _GET_( uNIL, "uNIL" ) + SetPos( 14, 16 ) ; o := _GET_( cStr03, "cStr03" ) TEST_LINE( o:colorDisp( "GR/N" ) ) TEST_LINE( o:VarPut( "" ) ) TEST_LINE( o:display() ) - - SetPos( 14, 16 ) ; o := _GET_( uNIL, "uNIL" ) + + SetPos( 14, 16 ) ; o := _GET_( cStr04, "cStr04" ) TEST_LINE( o:colorSpec := "GR/N" ) TEST_LINE( o:VarPut( "" ) ) TEST_LINE( o:display() ) + SetPos( 14, 16 ) ; o := _GET_( cStr05, "cStr05",,, ) + TEST_LINE( o:VarPut(Space(30)) ) + TEST_LINE( o:display() ) + TEST_LINE( o:VarPut(1) ) + TEST_LINE( o:VarGet() ) + TEST_LINE( o:VarPut("abcdefghijklm1234nopqrstuvwxyz") ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:assign() ) + TEST_LINE( o:VarPut("abcdefghijklmnopqrstuvwxyz1234") ) + TEST_LINE( o:updateBuffer() ) + nOldRow := o:row + nOldCol := o:col + TEST_LINE( o:row := 50 ) + TEST_LINE( o:col := 80 ) + TEST_LINE( o:VarPut(2) ) + TEST_LINE( o:VarGet() ) + TEST_LINE( o:VarPut("1234abcdefghijklmnopqrstuvwxyz") ) + TEST_LINE( o:updateBuffer() ) + TEST_LINE( o:row := nOldRow ) + TEST_LINE( o:col := nOldCol ) + TEST_LINE( o:killFocus() ) + TEST_LINE( o:VarPut(4) ) + + SetPos( 14, 16 ) ; o := _GET_( cStr05, "cStr05",,, ) + TEST_LINE( o:VarPut(Space(30)) ) + TEST_LINE( o:display() ) + TEST_LINE( o:VarPut(1) ) + TEST_LINE( o:VarGet() ) + TEST_LINE( o:VarPut("abcdefghijklm1234nopqrstuvwxyz") ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:assign() ) + TEST_LINE( o:VarPut("abcdefghijklmnopqrstuvwxyz1234") ) + TEST_LINE( o:updateBuffer() ) + TEST_LINE( o:VarPut(2) ) + TEST_LINE( o:Type ) + + // ; + + SetPos( 14, 16 ) ; o := _GET_( cStr06, "cStr06",,, ) + TEST_LINE( o:VarPut(Replicate("a", 30)) ) + TEST_LINE( o:display() ) + TEST_LINE( o:VarPut(1) ) + + SetPos( 14, 16 ) ; o := _GET_( cStr06, "cStr06",,, ) + TEST_LINE( o:VarPut(Replicate("a", 30)) ) + TEST_LINE( o:display() ) + TEST_LINE( o:VarPut(Replicate("b", 20)) ) + + SetPos( 14, 16 ) ; o := _GET_( cStr06, "cStr06",,, ) + TEST_LINE( o:VarPut(Replicate("a", 30)) ) + TEST_LINE( o:display() ) + TEST_LINE( o:VarPut(NIL) ) + TEST_LINE( o:VarPut(Replicate("b", 20)) ) + + SetPos( 14, 16 ) ; o := _GET_( cStr06, "cStr06",,, ) + TEST_LINE( o:VarPut(Replicate("a", 30)) ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:VarPut(1) ) + + SetPos( 14, 16 ) ; o := _GET_( cStr06, "cStr06",,, ) + TEST_LINE( o:VarPut(Replicate("a", 30)) ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:VarPut(Replicate("b", 20)) ) + + SetPos( 14, 16 ) ; o := _GET_( cStr06, "cStr06",,, ) + TEST_LINE( o:VarPut(Replicate("a", 30)) ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:VarPut(NIL) ) + TEST_LINE( o:VarPut(Replicate("b", 20)) ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:assign() ) + // ; Minus SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01", "9999.99",, ) @@ -378,7 +459,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) TEST_LINE( OBJ_CREATE() ) TEST_LINE( o:SetFocus() ) TEST_LINE( o:KillFocus() ) - TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, cStr01, cStr01 := h ) } ) + TEST_LINE( o:block := {| h | LogMe( PCount(), h ), iif( PCount() == 0, cStr01, cStr01 := h ) } ) TEST_LINE( o:SetFocus() ) // ; Reform @@ -397,7 +478,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) TEST_LINE( OBJ_CREATE() ) bOldBlock := o:block - TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:block := {| h | LogMe( PCount(), h ), iif( PCount() == 0, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) TEST_LINE( o:SetFocus() ) TEST_LINE( o:insert("-") ) TEST_LINE( o:KillFocus() ) @@ -409,6 +490,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) SET CENTURY ON +#ifdef NULL SetPos( 14, 16 ) ; dDate01 := hb_SToD( "20070425" ) o := _GET_( dDate01, "dDate01" ) TEST_LINE( OBJ_CREATE() ) @@ -466,6 +548,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) TEST_LINE( o:SetFocus() ) TEST_LINE( o:OverStrike("12345678") ) TEST_LINE( o:KillFocus() ) +#endif // ; Exercises @@ -531,6 +614,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ) ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "Non-Focus Assign To C: " + XToStr( xVar ) @@ -558,6 +648,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ) ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( cStr01, "nStr01" ) ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "nStr01" ) ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "nStr01" ) ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "nStr01" ) ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "nStr01" ) ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "Non-Focus Assign To D: " + XToStr( xVar ) @@ -585,6 +682,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ) ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "Non-Focus Assign To L: " + XToStr( xVar ) @@ -612,6 +716,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ) ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "Non-Focus Assign To B: " + XToStr( xVar ) @@ -639,6 +750,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ) ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "InFocus Assign to N: " + XToStr( xVar ) @@ -666,6 +784,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01" ):SetFocus ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "InFocus Assign to C: " + XToStr( xVar ) @@ -693,6 +818,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( cStr01, "cStr01" ):SetFocus ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "InFocus Assign to D: " + XToStr( xVar ) @@ -720,6 +852,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( dDat01, "dDat01" ):SetFocus ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "InFocus Assign to L: " + XToStr( xVar ) @@ -747,6 +886,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( lLog01, "lLog01" ):SetFocus ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "InFocus Assign to B: " + XToStr( xVar ) @@ -774,6 +920,13 @@ PROCEDURE TGetAssign( xVar ) SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:SubScript := xVar ) SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:Type := xVar ) SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:TypeOut := xVar ) +#ifdef HB_COMPAT_C53 + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:control := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:message := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:caption := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:capRow := xVar ) + SetPos( 14, 16 ) ; o := _GET_( bBlo01, "bBlo01" ):SetFocus ; TEST_LINE( o:capCol := xVar ) +#endif s_cTest := "InFocus/SetFocus " + XToStr( xVar ) @@ -806,7 +959,7 @@ PROCEDURE TGetTest( xVar, cPic ) SetPos( 14, 16 ) ; o := _GET_( s_xVar, "s_xVar" ) TEST_LINE( OBJ_CREATE() ) bOldBlock := o:block - TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:block := {| h | LogMe( PCount(), h ), iif( PCount() == 0, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) TEST_LINE( o:SetFocus() ) IF cPic != NIL TEST_LINE( o:picture := "99999" ) @@ -826,7 +979,7 @@ PROCEDURE TGetTest( xVar, cPic ) SetPos( 14, 16 ) ; o := _GET_( s_xVar, "s_xVar" ) TEST_LINE( OBJ_CREATE() ) bOldBlock := o:block - TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:block := {| h | LogMe( PCount(), h ), iif( PCount() == 0, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) IF cPic != NIL TEST_LINE( o:picture := "99999" ) TEST_LINE( o:picture := cPic ) @@ -844,7 +997,36 @@ PROCEDURE TGetTest( xVar, cPic ) SetPos( 14, 16 ) ; o := _GET_( s_xVar, "s_xVar" ) bOldBlock := o:block - TEST_LINE( o:block := {| h | LogMe( h ), iif( h == NIL, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:block := {| h | LogMe( PCount(), h ), iif( PCount() == 0, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Insert( "6" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:Insert( "5" ) ) + TEST_LINE( o:Assign() ) + TEST_LINE( o:Reset() ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:VarPut( "newvalue " ) ) + TEST_LINE( o:Insert( "7" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:Assign() ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Insert( "3" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:KillFocus() ) + TEST_LINE( o:VarPut( 0 ) ) + TEST_LINE( o:SetFocus() ) + TEST_LINE( o:Insert( "3" ) ) + TEST_LINE( o:Undo(.T.) ) + TEST_LINE( o:KillFocus() ) + + // ; + + s_xVar := xVar + + SetPos( 14, 16 ) ; o := _GET_( s_xVar, "s_xVar" ) + TEST_LINE( o:picture := cPic ) + bOldBlock := o:block + TEST_LINE( o:block := {| h | LogMe( PCount(), h ), iif( PCount() == 0, Eval( bOldBlock ), Eval( bOldBlock, h ) ) } ) TEST_LINE( o:SetFocus() ) TEST_LINE( o:Insert( "6" ) ) TEST_LINE( o:Undo(.T.) ) @@ -879,7 +1061,7 @@ PROCEDURE TEST_CALL( o, cBlock, bBlock ) SetPos( 0, 0 ) // ; To check where the cursor was moved after evaluating the block. - bOldError := ErrorBlock( {|oError| Break( oError ) } ) + bOldError := ErrorBlock( {|oError| oError:cargo := CallStack(), Break( oError ) } ) BEGIN SEQUENCE xResult := Eval( bBlock ) @@ -893,7 +1075,18 @@ PROCEDURE TEST_CALL( o, cBlock, bBlock ) RETURN -PROCEDURE LogMe( data, desc ) +FUNCTION CallStack() + LOCAL tmp := 1 + LOCAL cString := "" + + DO WHILE !Empty( ProcName( tmp ) ) + cString += ProcName( tmp ) + " (" + LTrim( Str( ProcLine( tmp ) ) ) + ") " + tmp++ + ENDDO + + RETURN RTrim( cString ) + +PROCEDURE LogMe( nPCount, data, desc ) LOCAL nLevel LOCAL cStack @@ -914,10 +1107,10 @@ PROCEDURE LogMe( data, desc ) cStack := "" ENDIF - IF PCount() > 2 - FWrite( s_fhnd, cStack + "BLOCK_SET " + iif( data == NIL, "NIL", data ) + " " + desc + hb_OSNewLine() ) - ELSE + IF nPCount == 0 FWrite( s_fhnd, cStack + "BLOCK_GET " + desc + hb_OSNewLine() ) + ELSE + FWrite( s_fhnd, cStack + "BLOCK_SET " + XToStr( data ) + " " + desc + hb_OSNewLine() ) ENDIF RETURN @@ -1174,6 +1367,10 @@ STATIC FUNCTION ErrorMessage( oError ) cMessage += "S" ENDIF ENDIF + + IF !Empty( oError:cargo ) + cMessage += " " + oError:cargo + ENDIF ELSE cMessage := "(ERROR)" ENDIF