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