With this example we can see how call stack inform incorrect function
at harbour...
But Why recursive error is produced too?
Best regards,
Miguel Angel Marchuet
PROCEDURE Main()
#ifdef __XHARBOUR__
REQUEST HB_GT_WIN
#endif
? Nil * "A"
RETURN
//----------------------------------------//
PROCEDURE ErrorSys()
ErrorBlock( { | e | ErrorDialog( e ) } )
RETURN
//----------------------------------------//
proc ErrorLink()
return
//----------------------------------------//
PROCEDURE ErrorDialog( e )
LOCAL cErrorLog := '', n, j
// Cambiamos manejador de error para evitar llamadas recursivas. No usamos
TRY porque en ocasiones deja la
// pantalla de error bloqueada y sin terminar de pintar probablemente
debido a que el dibujado del dialogo
// de error, provoca un anidamiento de errores.
ErrorBlock( {|e| Alert( ErrorMessage( e ) + " from Errorsys, line:" + Str(
ProcLine( 1 ), 3 ) ), __Quit() } )
n := 2 // we don't disscard any info again !
while ( n < 74 )
FOR j = 1 to LocalCount( n )
cErrorLog += " Local " + Str( j, 3 ) + ": " + ;
ValType( GetLocal( n, j ) ) + ;
" " + cGetInfo( GetLocal( n, j ) ) + CRLF
NEXT
ENDDO
? "Don't arrive, for GPF"
RETURN
//----------------------------------------------------------------------------//
static function ErrorMessage( e )
// start error message
local cMessage := if( empty( e:OsCode ), ;
if( e:severity > ES_WARNING, "Error ", "Atención " ),;
"(DOS Error " + AllTrim(Str(e:osCode)) + ") " )
// add subsystem name if available
cMessage += if( ValType( e:SubSystem ) == "C",;
e:SubSystem() ,;
"???" )
// add subsystem's error code if available
cMessage += if( ValType( e:SubCode ) == "N",;
"/" + AllTrim( Str( e:SubCode ) ) ,;
"/???" )
// add error description if available
if ( ValType( e:Description ) == "C" )
cMessage += " " + e:Description
end
// add either filename or operation
cMessage += if( ! Empty( e:FileName ),;
": " + e:FileName ,;
if( !Empty( e:Operation ),;
": " + e:Operation ,;
"" ) )
return cMessage
//----------------------------------------------------------------------------//
// returns extended info for a certain variable type
static function cGetInfo( uVal )
local cType := ValType( uVal )
do case
case cType == "C"
return '"' + cValToChar( uVal ) + '"'
case cType == "O"
return "Class: " + uVal:ClassName()
case cType == "A"
return "Len: " + Str( Len( uVal ), 4 )
otherwise
return cValToChar( uVal )
endcase
return nil
//----------------------------------------//
function GetLocal( nProcLevel, nLocal )
return HB_DBG_VMVARLGET( nProcLevel + 1, ParamCount( nProcLevel + 1 ) + nLocal )
//----------------------------------------//
function LocalCount( nProcLevel )
return HB_DBG_VMSTKLCOUNT( nProcLevel + 1 ) - ParamCount( nProcLevel + 1 )
//----------------------------------------//
function cValToChar( uVal )
local cType := ValType( uVal )
do case
case cType == "C" .or. cType == "M"
return uVal
case cType == "D"
return DToC( uVal )
case cType == "L"
return If( uVal, ".T.", ".F." )
case cType == "N"
return AllTrim( Str( uVal ) )
case cType == "B"
return "{|| ... }"
case cType == "A"
return "{ ... }"
case cType == "O"
return "Object"
otherwise
return ""
endcase
return nil
function ParamCount( nProcLevel )
return Len( HB_DBG_VMPARLLIST( nProcLevel + 1 ) )
//----------------------------------------------------------------------------//
_______________________________________________
Harbour mailing list
[email protected]
http://lists.harbour-project.org/mailman/listinfo/harbour
