From d1183b40732a2a01a453bf25286e5cfb3b7961a7 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Tue, 16 Nov 2010 09:30:13 +0000 Subject: [PATCH] 2010-11-16 10:29 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/contrib/xhb/xthrow.prg ! removed unreachable RETURN statement reported by extended BREAK() detection in compiler code * harbour/contrib/xhb/xhbmvinf.c * harbour/contrib/xhb/xhbscr.c * updated header comments * harbour/contrib/xhb/xhb.hbx * harbour/contrib/xhb/xhberr.prg + added xhb_ErrorNew() function which accepts xHarbour ErrorNew() parameters ! fixed xHarbour error handlers to work with Harbour error object which does not contain some local xHarbour extensions * harbour/contrib/xhb/stream.prg * harbour/contrib/xhb/xcstr.prg ! use xhb_ErrorNew() instead of ErrorNew() --- harbour/ChangeLog | 20 ++++++ harbour/contrib/xhb/stream.prg | 14 ++--- harbour/contrib/xhb/xcstr.prg | 22 +++---- harbour/contrib/xhb/xhb.hbx | 1 + harbour/contrib/xhb/xhberr.prg | 110 +++++++++++++++++++++++++++++---- harbour/contrib/xhb/xhbmvinf.c | 2 +- harbour/contrib/xhb/xhbscr.c | 2 +- harbour/contrib/xhb/xthrow.prg | 2 - 8 files changed, 139 insertions(+), 34 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index abbb59e44f..15f4e5c68b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,26 @@ The license applies to all entries newer than 2009-04-28. */ +2010-11-16 10:29 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/contrib/xhb/xthrow.prg + ! removed unreachable RETURN statement reported by extended BREAK() + detection in compiler code + + * harbour/contrib/xhb/xhbmvinf.c + * harbour/contrib/xhb/xhbscr.c + * updated header comments + + * harbour/contrib/xhb/xhb.hbx + * harbour/contrib/xhb/xhberr.prg + + added xhb_ErrorNew() function which accepts xHarbour ErrorNew() + parameters + ! fixed xHarbour error handlers to work with Harbour error object + which does not contain some local xHarbour extensions + + * harbour/contrib/xhb/stream.prg + * harbour/contrib/xhb/xcstr.prg + ! use xhb_ErrorNew() instead of ErrorNew() + 2010-11-15 16:13 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/src/rtl/gtclip.c ! fixed bug in calculation of maximum unicode clipboard buffer size diff --git a/harbour/contrib/xhb/stream.prg b/harbour/contrib/xhb/stream.prg index d2667abd6e..75155d87a6 100644 --- a/harbour/contrib/xhb/stream.prg +++ b/harbour/contrib/xhb/stream.prg @@ -102,7 +102,7 @@ METHOD PROCEDURE CopyTo( oTargetStream ) CLASS TStream LOCAL nPosition IF oTargetStream:lCanWrite == .F. - Throw( ErrorNew( "Stream", 0, 1001, ProcName(), "Target not writable.", HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1001, ProcName(), "Target not writable.", HB_aParams() ) ) ENDIF // Save. @@ -154,7 +154,7 @@ METHOD New( cFile, nMode ) CLASS TStreamFileReader ::Handle := FOpen( cFile, nMode ) IF ::Handle <= 0 - Throw( ErrorNew( "Stream", 0, 1004, ProcName(), "Open Error: " + Str( FError() ), HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1004, ProcName(), "Open Error: " + Str( FError() ), HB_aParams() ) ) ENDIF ::nPosition := 0 @@ -174,7 +174,7 @@ METHOD Read( sBuffer, nOffset, nCount ) CLASS TStreamFileReader /* IF ! HB_IsByRef( @sBuffer ) - Throw( ErrorNew( "Stream", 0, 1002, ProcName(), "Buffer not BYREF.", HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1002, ProcName(), "Buffer not BYREF.", HB_aParams() ) ) ENDIF */ @@ -223,7 +223,7 @@ METHOD New( cFile, nMode ) CLASS TStreamFileWriter ::Handle := FOpen( cFile, nMode ) IF ::Handle <= 0 - Throw( ErrorNew( "Stream", 0, 1004, ProcName(), "Open Error: " + Str( FError() ), HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1004, ProcName(), "Open Error: " + Str( FError() ), HB_aParams() ) ) ENDIF ::nLength := FSeek( ::Handle, 0, FS_END ) @@ -233,7 +233,7 @@ METHOD New( cFile, nMode ) CLASS TStreamFileWriter ::Handle := FCreate( cFile, nMode ) IF ::Handle <= 0 - Throw( ErrorNew( "Stream", 0, 1004, ProcName(), "Create Error: " + Str( FError() ), HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1004, ProcName(), "Create Error: " + Str( FError() ), HB_aParams() ) ) ENDIF ::nPosition := 0 @@ -255,7 +255,7 @@ METHOD Write( sBuffer, nOffset, nCount ) CLASS TStreamFileWriter ::nPosition += nWritten IF nWritten != nCount - Throw( ErrorNew( "Stream", 0, 1003, ProcName(), "Write failed - written:" + Str( nWritten ) + " bytes", HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1003, ProcName(), "Write failed - written:" + Str( nWritten ) + " bytes", HB_aParams() ) ) ENDIF RETURN nWritten @@ -267,7 +267,7 @@ METHOD PROCEDURE WriteByte( cByte ) CLASS TStreamFileWriter ::nPosition += nWritten IF nWritten != 1 - Throw( ErrorNew( "Stream", 0, 1006, ProcName(), "Write failed", HB_aParams() ) ) + Throw( xhb_ErrorNew( "Stream", 0, 1006, ProcName(), "Write failed", HB_aParams() ) ) ENDIF RETURN diff --git a/harbour/contrib/xhb/xcstr.prg b/harbour/contrib/xhb/xcstr.prg index 3120a4159a..cc0eec3a4b 100644 --- a/harbour/contrib/xhb/xcstr.prg +++ b/harbour/contrib/xhb/xcstr.prg @@ -67,7 +67,7 @@ FUNCTION CStrToVal( cExp, cType ) IF ! ISCHAR( cExp ) - Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + Throw( xhb_ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) ENDIF SWITCH cType @@ -95,17 +95,17 @@ FUNCTION CStrToVal( cExp, cType ) /* CASE 'A' - Throw( ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) CASE 'B' - Throw( ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) CASE 'O' - Throw( ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) */ OTHERWISE - Throw( ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) + Throw( xhb_ErrorNew( "CSTRTOVAL", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) ) ENDSWITCH RETURN NIL @@ -243,7 +243,7 @@ FUNCTION ValToPrg( xVal, cName, nPad, aObjs ) IF xVal == NIL cRet := "NIL" ELSE - Throw( ErrorNew( "VALTOPRG", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + Throw( xhb_ErrorNew( "VALTOPRG", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDIF ENDSWITCH @@ -315,7 +315,7 @@ FUNCTION ValToDate( xVal ) RETURN 0d19000101 + xVal OTHERWISE - Throw( ErrorNew( "VALTODATE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + Throw( xhb_ErrorNew( "VALTODATE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH RETURN hb_SToD() @@ -361,7 +361,7 @@ FUNCTION ValToLogical( xVal ) RETURN .F. OTHERWISE - Throw( ErrorNew( "VALTOLOGICAL", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + Throw( xhb_ErrorNew( "VALTOLOGICAL", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH RETURN .F. @@ -399,7 +399,7 @@ FUNCTION ValToNumber( xVal ) RETURN 0 OTHERWISE - Throw( ErrorNew( "VALTONUMBER", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + Throw( xhb_ErrorNew( "VALTONUMBER", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH RETURN 0 @@ -448,7 +448,7 @@ FUNCTION ValToObject( xVal ) EXIT OTHERWISE - Throw( ErrorNew( "VALTOOBJECT", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + Throw( xhb_ErrorNew( "VALTOOBJECT", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH RETURN 0 @@ -488,7 +488,7 @@ FUNCTION ValToType( xVal, cType ) RETURN NIL OTHERWISE - Throw( ErrorNew( "VALTOTYPE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) + Throw( xhb_ErrorNew( "VALTOTYPE", 0, 3103, ProcName(), "Unsupported type", { xVal } ) ) ENDSWITCH RETURN NIL diff --git a/harbour/contrib/xhb/xhb.hbx b/harbour/contrib/xhb/xhb.hbx index d069281f56..93d02e0fa9 100644 --- a/harbour/contrib/xhb/xhb.hbx +++ b/harbour/contrib/xhb/xhb.hbx @@ -414,6 +414,7 @@ DYNAMIC XHB_DEC DYNAMIC XHB_DIV DYNAMIC XHB_EEQUAL DYNAMIC XHB_EQUAL +DYNAMIC XHB_ERRORNEW DYNAMIC XHB_ERRORSYS DYNAMIC XHB_GREATER DYNAMIC XHB_GREATEREQ diff --git a/harbour/contrib/xhb/xhberr.prg b/harbour/contrib/xhb/xhberr.prg index 137d77b12f..9c73bfbf08 100644 --- a/harbour/contrib/xhb/xhberr.prg +++ b/harbour/contrib/xhb/xhberr.prg @@ -4,8 +4,13 @@ /* * Harbour Project source code: - * The default error handler + * xHarbour default error handler and error functions: + * xhb_ErrorSys(), __BreakBlock(), __ErrorBlock(), + * __MinimalErrorHandler(), xhb_ErrorNew() * + * Copyright 2010 Przemyslaw Czerpak + * Copyright 2009 Viktor Szakats (harbour.01 syenar.hu) + * Copyright 2004 Ron Pinkas * Copyright 1999 Antonio Linares * www - http://harbour-project.org * @@ -74,6 +79,18 @@ PROCEDURE xhb_ErrorSys() ErrorBlock( { | oError | xhb_DefError( oError ) } ) RETURN +STATIC FUNCTION err_ModuleName( oError, n ) + RETURN IIF( __objHasMsg( oError, "MODULENAME" ), oError:ModuleName, ; + IIF( n != NIL, ProcFile( n ), NIL ) ) + +STATIC FUNCTION err_ProcName( oError, n ) + RETURN IIF( __objHasMsg( oError, "PROCNAME" ), oError:ProcName, ; + IIF( n != NIL, ProcName( n ), NIL ) ) + +STATIC FUNCTION err_ProcLine( oError, n ) + RETURN IIF( __objHasMsg( oError, "PROCLINE" ), oError:ProcLine, ; + IIF( n != NIL, ProcLine( n ), NIL ) ) + STATIC FUNCTION xhb_DefError( oError ) LOCAL cMessage LOCAL cDOSError @@ -86,8 +103,9 @@ STATIC FUNCTION xhb_DefError( oError ) n := 0 WHILE ! Empty( ProcName( ++n ) ) IF ProcName( n ) == ProcName() - TraceLog( "Error system failure!", oError:ProcName, oError:ProcLine(), oError:ModuleName, oError:description ) - Alert( "Error system failure!;Please correct error handler:;" + oError:ProcName + "(" + LTrim( Str( oError:ProcLine() ) ) + ") in module: " + oError:ModuleName ) + n := 3 + TraceLog( "Error system failure!", err_ProcName( oError, n ), err_ProcLine( oError, n ), err_ModuleName( oError, n ), oError:description ) + Alert( "Error system failure!;Please correct error handler:;" + err_ProcName( oError, n ) + "(" + LTrim( Str( err_ProcLine( oError, n ) ) ) + ") in module: " + err_ModuleName( oError, n ) ) ErrorLevel( 1 ) QUIT ENDIF @@ -177,9 +195,9 @@ STATIC FUNCTION xhb_DefError( oError ) ENDIF ELSE IF Empty( oError:osCode ) - Alert( cMessage + ";" + oError:ProcName + "(" + LTrim( Str( oError:ProcLine() ) ) + ") in module: " + oError:ModuleName ) + Alert( cMessage + ";" + err_ProcName( oError, 3 ) + "(" + LTrim( Str( err_ProcLine( oError, 3 ) ) ) + ") in module: " + err_ModuleName( oError, 3 ) ) ELSE - Alert( cMessage + ";" + cDOSError + ";" + oError:ProcName + "(" + LTrim( Str( oError:ProcLine() ) ) + ") in module: " + oError:ModuleName ) + Alert( cMessage + ";" + cDOSError + ";" + err_ProcName( oError, 3 ) + "(" + LTrim( Str( err_ProcLine( oError, 3 ) ) ) + ") in module: " + err_ModuleName( oError, 3 ) ) ENDIF ENDIF @@ -654,7 +672,14 @@ FUNCTION __ErrorBlock( ) PROCEDURE __MinimalErrorHandler( oError ) - LOCAL cError := "Error!" + hb_eol() + LOCAL cError + LOCAL xData + + cError := "Error" + IF ISNUMBER( oError:SubCode ) + cError += ": " + hb_ntos( oError:SubCode ) + ENDIF + cError += "!" + hb_eol() IF ISCHARACTER( oError:Operation ) cError += "Operation: " + oError:Operation + hb_eol() @@ -662,14 +687,14 @@ PROCEDURE __MinimalErrorHandler( oError ) IF ISCHARACTER( oError:Description ) cError += "Description: " + oError:Description + hb_eol() ENDIF - IF ISCHARACTER( oError:ModuleName ) - cError += "Source: " + oError:ModuleName + hb_eol() + IF ISCHARACTER( xData := err_ModuleName( oError ) ) + cError += "Source: " + xData + hb_eol() ENDIF - IF ISCHARACTER( oError:ProcName ) - cError += "Procedure: " + oError:ProcName + hb_eol() + IF ISCHARACTER( xData := err_ProcName( oError ) ) + cError += "Procedure: " + xData + hb_eol() ENDIF - IF ISNUMBER( oError:ProcLine ) - cError += "Line: " + hb_ntos( oError:ProcLine ) + hb_eol() + IF ISNUMBER( xData := err_ProcLine( oError ) ) + cError += "Line: " + hb_ntos( xData ) + hb_eol() ENDIF OutStd( cError ) @@ -677,3 +702,64 @@ PROCEDURE __MinimalErrorHandler( oError ) QUIT RETURN + +FUNCTION xhb_ErrorNew( cSubSystem, nGenCode, nSubCode, ; + cOperation, cDescription, aArgs, ; + cModuleName, cProcName, nProcLine ) + + LOCAL oError := ErrorNew() + LOCAL aStack, n + + IF ISCHARACTER( cSubSystem ) + oError:SubSystem := cSubSystem + ENDIF + IF ISNUMBER( nGenCode ) + oError:GenCode := nGenCode + ENDIF + IF ISNUMBER( nSubCode ) + oError:SubCode := nSubCode + ENDIF + IF ISCHARACTER( cOperation ) + oError:Operation := cOperation + ENDIF + IF ISCHARACTER( cDescription ) + oError:Description := cDescription + ENDIF + IF ISARRAY( aArgs ) + oError:Args := aArgs + ENDIF + + IF __objHasMsg( oError, "MODULENAME" ) + IF ISCHARACTER( cModuleName ) + oError:ModuleName := cModuleName + ELSE + oError:ModuleName := ProcFile( 1 ) + ENDIF + ENDIF + + IF __objHasMsg( oError, "PROCNAME" ) + IF ISCHARACTER( cProcName ) + oError:ProcName := cProcName + ELSE + oError:ProcName := ProcName( 1 ) + ENDIF + ENDIF + + IF __objHasMsg( oError, "PROCLINE" ) + IF ISNUMBER( nProcLine ) + oError:ProcLine := nProcLine + ELSE + oError:ProcLine := ProcLine( 1 ) + ENDIF + ENDIF + + IF __objHasMsg( oError, "AASTACK" ) + aStack := {} + n := 0 + WHILE ! Empty( ProcName( ++n ) ) + AAdd( aStack, { ProcFile( n ), ProcName( n ), ProcLine( n ) } ) + ENDDO + oError:aAStack := aStack + ENDIF + + RETURN oError diff --git a/harbour/contrib/xhb/xhbmvinf.c b/harbour/contrib/xhb/xhbmvinf.c index 529e4ae79c..65a28e2383 100644 --- a/harbour/contrib/xhb/xhbmvinf.c +++ b/harbour/contrib/xhb/xhbmvinf.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * + * xHarbour compatible __MVSYMBOLINFO() function * * Copyright 2010 Przemyslaw Czerpak * www - http://www.harbour-project.org diff --git a/harbour/contrib/xhb/xhbscr.c b/harbour/contrib/xhb/xhbscr.c index e07999d657..c17ca6660c 100644 --- a/harbour/contrib/xhb/xhbscr.c +++ b/harbour/contrib/xhb/xhbscr.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * SCROLL() function + * SCROLLFIXED() function * * Copyright 1999 David G. Holm * www - http://harbour-project.org diff --git a/harbour/contrib/xhb/xthrow.prg b/harbour/contrib/xhb/xthrow.prg index 3223e71353..2c6b29d5c2 100644 --- a/harbour/contrib/xhb/xthrow.prg +++ b/harbour/contrib/xhb/xthrow.prg @@ -54,5 +54,3 @@ PROCEDURE THROW( oError ) Eval( ErrorBlock(), oError ) Break( oError ) - - RETURN