From 0a4bccada81711da037cca3e09cb777b5a46c868 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 27 Oct 2011 23:30:35 +0000 Subject: [PATCH] 2011-10-28 01:26 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * src/rtl/tget.prg ! fixed RTE when setting :picture to NIL for N and C types in some certain rare circumstantances. The :picture setting operation is ignored in such case, since the internally stored original value is not known. Tested OK against CA-Cl*pper 5.3, though maybe it's possible to refine this even further with more test cases. * tests/rto_get.prg + added test case for RTE reported by Quique ! fixed warnings --- harbour/ChangeLog | 15 +++++++++++- harbour/src/rtl/tget.prg | 22 ++++++++++------- harbour/tests/rto_get.prg | 50 ++++++++++++++++++++++++++------------- 3 files changed, 61 insertions(+), 26 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d604a4a811..bef9481d1b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,19 @@ The license applies to all entries newer than 2009-04-28. */ +2011-10-28 01:26 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + * src/rtl/tget.prg + ! fixed RTE when setting :picture to NIL for + N and C types in some certain rare circumstantances. + The :picture setting operation is ignored in such case, + since the internally stored original value is not known. + Tested OK against CA-Cl*pper 5.3, though maybe it's + possible to refine this even further with more test cases. + + * tests/rto_get.prg + + added test case for RTE reported by Quique + ! fixed warnings + 2011-10-27 19:12 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbziparc/ziparc.prg ! HB_ZIPFILE(): one fix to filename matching @@ -49,7 +62,7 @@ 2011-10-24 13:34 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * src/rtl/gtwin/gtwin.c - ! Missing break clause causing following code also changes + ! Missing break clause causing following code also changes console window title. hb_gtInfo( HB_GTI_BOXCP, hb_cdpSelect() ) Patch by Aleksander Czajczynski diff --git a/harbour/src/rtl/tget.prg b/harbour/src/rtl/tget.prg index 6af85253cd..35266bf5fb 100644 --- a/harbour/src/rtl/tget.prg +++ b/harbour/src/rtl/tget.prg @@ -1108,20 +1108,24 @@ METHOD picture( cPicture ) CLASS GET CASE "N" - cNum := Str( ::xVarGet ) - IF ( nAt := At( ".", cNum ) ) > 0 - ::cPicMask := Replicate( "9", nAt - 1 ) + "." - ::cPicMask += Replicate( "9", Len( cNum ) - Len( ::cPicMask ) ) - ELSE - ::cPicMask := Replicate( "9", Len( cNum ) ) + IF ::xVarGet != NIL + cNum := Str( ::xVarGet ) + IF ( nAt := At( ".", cNum ) ) > 0 + ::cPicMask := Replicate( "9", nAt - 1 ) + "." + ::cPicMask += Replicate( "9", Len( cNum ) - Len( ::cPicMask ) ) + ELSE + ::cPicMask := Replicate( "9", Len( cNum ) ) + ENDIF ENDIF EXIT CASE "C" - IF ::cPicFunc == "@9" - ::cPicMask := Replicate( "9", Len( ::xVarGet ) ) - ::cPicFunc := "" + IF ::xVarGet != NIL + IF ::cPicFunc == "@9" + ::cPicMask := Replicate( "9", Len( ::xVarGet ) ) + ::cPicFunc := "" + ENDIF ENDIF EXIT diff --git a/harbour/tests/rto_get.prg b/harbour/tests/rto_get.prg index 0b333f51c4..9546f213cf 100644 --- a/harbour/tests/rto_get.prg +++ b/harbour/tests/rto_get.prg @@ -81,9 +81,9 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) LOCAL cStr05 := "" LOCAL cStr06 := "" LOCAL cStr07 := "" -#ifdef NULL +//#ifdef NULL LOCAL dDate01 -#endif +//#endif LOCAL bOldBlock LOCAL o @@ -396,6 +396,24 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 ) TEST_LINE( o:reset() ) TEST_LINE( o:killFocus() ) + // ; Quique + + nInt02 := 198.12 + SetPos( 14, 16 ) ; o := _GET_( nInt02, "nInt02",,, ) + TEST_LINE( o:display() ) + TEST_LINE( o:killFocus() ) + TEST_LINE( o:picture := NIL ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:display() ) + + nInt02 := 198.12 + SetPos( 14, 16 ) ; o := _GET_( nInt02, "nInt02", "999.999",, ) + TEST_LINE( o:display() ) + TEST_LINE( o:killFocus() ) + TEST_LINE( o:picture := NIL ) + TEST_LINE( o:setFocus() ) + TEST_LINE( o:display() ) + // ; Buffer s_xVar := "abcdefg" @@ -722,26 +740,26 @@ PROCEDURE TGetTOVS( o, aKeys, lInsert ) ELSEIF ISNUM( aKeys[ tmp ] ) DO CASE CASE aKeys[ tmp ] == K_INS ; lInsert := ! lInsert - CASE aKeys[ tmp ] == K_HOME ; TEST_LINE( oGet:Home() ) - CASE aKeys[ tmp ] == K_END ; TEST_LINE( oGet:End() ) - CASE aKeys[ tmp ] == K_RIGHT ; TEST_LINE( oGet:Right() ) - CASE aKeys[ tmp ] == K_LEFT ; TEST_LINE( oGet:Left() ) - CASE aKeys[ tmp ] == K_CTRL_RIGHT ; TEST_LINE( oGet:WordRight() ) - CASE aKeys[ tmp ] == K_CTRL_LEFT ; TEST_LINE( oGet:WordLeft() ) - CASE aKeys[ tmp ] == K_BS ; TEST_LINE( oGet:BackSpace() ) - CASE aKeys[ tmp ] == K_DEL ; TEST_LINE( oGet:Delete() ) - CASE aKeys[ tmp ] == K_CTRL_T ; TEST_LINE( oGet:DelWordRight() ) - CASE aKeys[ tmp ] == K_CTRL_Y ; TEST_LINE( oGet:DelEnd() ) - CASE aKeys[ tmp ] == K_CTRL_BS ; TEST_LINE( oGet:DelWordLeft() ) - CASE aKeys[ tmp ] == K_CTRL_U ; TEST_LINE( oGet:Undo() ) - CASE o:type == "N" .AND. Chr( aKeys[ tmp ] ) $ ".," ; TEST_LINE( oGet:ToDecPos() ) + CASE aKeys[ tmp ] == K_HOME ; TEST_LINE( o:Home() ) + CASE aKeys[ tmp ] == K_END ; TEST_LINE( o:End() ) + CASE aKeys[ tmp ] == K_RIGHT ; TEST_LINE( o:Right() ) + CASE aKeys[ tmp ] == K_LEFT ; TEST_LINE( o:Left() ) + CASE aKeys[ tmp ] == K_CTRL_RIGHT ; TEST_LINE( o:WordRight() ) + CASE aKeys[ tmp ] == K_CTRL_LEFT ; TEST_LINE( o:WordLeft() ) + CASE aKeys[ tmp ] == K_BS ; TEST_LINE( o:BackSpace() ) + CASE aKeys[ tmp ] == K_DEL ; TEST_LINE( o:Delete() ) + CASE aKeys[ tmp ] == K_CTRL_T ; TEST_LINE( o:DelWordRight() ) + CASE aKeys[ tmp ] == K_CTRL_Y ; TEST_LINE( o:DelEnd() ) + CASE aKeys[ tmp ] == K_CTRL_BS ; TEST_LINE( o:DelWordLeft() ) + CASE aKeys[ tmp ] == K_CTRL_U ; TEST_LINE( o:Undo() ) + CASE o:type == "N" .AND. Chr( aKeys[ tmp ] ) $ ".," ; TEST_LINE( o:ToDecPos() ) ENDCASE ENDIF NEXT RETURN -PROCEDURE TGetTIns( o, aKeys ) +FUNCTION TGetTIns( o, aKeys ) RETURN TGetTOVS( o, aKeys, .T. ) PROCEDURE TGetAssign( xVar )