paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-13 16:49:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow to hook uncaught exceptions

Browse Source
This commit is contained in:
michael 2020-05-16 11:53:21 +00:00
parent ec3efe0ad5
commit 8e45a4dd32
2 changed files with 112 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/rtl/js.pas
View File

@ -796,7 +796,7 @@ type
{ TJSError }
TJSError = Class external name 'Error'
TJSError = Class external name 'Error' (TJSObject)
private
FMessage: String; external name 'message';
{$ifdef NodeJS}

124
packages/rtl/sysutils.pas
View File

@ -314,16 +314,30 @@ type
TOnGetEnvironmentVariable = function(Const EnvVar: String): String;
TOnGetEnvironmentString = function(Index: Integer): String;
TOnGetEnvironmentVariableCount = function: Integer;
TShowExceptionHandler = Procedure (Const Msg : String);
TUncaughtPascalExceptionHandler = Procedure(aObject : TObject);
TUncaughtJSExceptionHandler = Procedure(aObject : TJSObject);
var
OnGetEnvironmentVariable: TOnGetEnvironmentVariable;
OnGetEnvironmentString: TOnGetEnvironmentString;
OnGetEnvironmentVariableCount: TOnGetEnvironmentVariableCount;
// Handler to show an exception (used when showexception is called)
OnShowException : TShowExceptionHandler = nil;
// Set handlers for uncaught exceptions. These will call HookUncaughtExceptions
Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtPascalExceptionHandler) : TUncaughtPascalExceptionHandler;
Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtJSExceptionHandler) : TUncaughtJSExceptionHandler;
// Hook the rtl handler for uncaught exceptions. If any exception handlers were set, they will be called.
// If none was set, the exceptions will be displayed using ShowException.
Procedure HookUncaughtExceptions;
function GetEnvironmentVariable(Const EnvVar: String): String;
function GetEnvironmentVariableCount: Integer;
function GetEnvironmentString(Index: Integer): String;
procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer = Nil);
Procedure Abort;
{*****************************************************************************
@ -1131,28 +1145,111 @@ Type
implementation
procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
{ ---------------------------------------------------------------------
Exception handling
---------------------------------------------------------------------}
Resourcestring
SAbortError = 'Operation aborted';
SApplicationException = 'Application raised an exception: ';
SErrUnknownExceptionType = 'Caught unknown exception type : ';
procedure DoShowException(S : String);
begin
if Assigned(OnShowException) then
OnShowException(S)
else
begin
{$IFDEF BROWSER}
asm
window.alert(S);
end;
{$ENDIF}
{$IFDEF NODEJS}
Writeln(S);
{$ENDIF}
end;
end;
procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer = Nil);
Var
S : String;
begin
S:='Application raised an exception '+ExceptObject.ClassName;
S:=SApplicationException+ExceptObject.ClassName;
if ExceptObject is Exception then
S:=S+' : '+Exception(ExceptObject).Message;
{$IFDEF BROWSER}
asm
window.alert(S);
end;
{$ENDIF}
{$IFDEF NODEJS}
Writeln(S);
{$ENDIF}
DoShowException(S);
if ExceptAddr=nil then;
end;
Const
SAbortError = 'Operation aborted';
Type
TRTLExceptionHandler = procedure (aError : JSValue);
Var
rtlExceptionHandler : TRTLExceptionHandler; External name 'rtl.onUncaughtException';
rtlShowUncaughtExceptions : Boolean; External name 'rtl.showUncaughtExceptions';
OnPascalException : TUncaughtPascalExceptionHandler;
OnJSException : TUncaughtJSExceptionHandler;
Procedure RTLExceptionHook(aError : JSValue);
Var
S : String;
begin
if isClassInstance(aError) then
begin
if Assigned(OnPascalException) then
OnPascalException(TObject(aError))
else
ShowException(TObject(aError),Nil);
end
else if isObject(aError) then
begin
if Assigned(OnJSException) then
OnJSException(TJSObject(aError))
else
begin
if TJSObject(aError).hasOwnProperty('message') then
S:=SErrUnknownExceptionType+String(TJSObject(aError).Properties['message'])
else
S:=SErrUnknownExceptionType+TJSObject(aError).toString;
DoShowException(S);
end
end
else
begin
S:=SErrUnknownExceptionType+String(aError);
DoShowException(S);
end;
end;
Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtPascalExceptionHandler) : TUncaughtPascalExceptionHandler;
begin
Result:=OnPascalException;
OnPascalException:=aValue;
HookUncaughtExceptions;
end;
Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtJSExceptionHandler) : TUncaughtJSExceptionHandler;
begin
Result:=OnJSException;
OnJSException:=aValue;
HookUncaughtExceptions;
end;
Procedure HookUncaughtExceptions;
begin
rtlExceptionHandler:=@RTLExceptionHook;
rtlShowUncaughtExceptions:=True;
end;
procedure Abort;
begin
@ -1161,6 +1258,7 @@ end;
Type
TCharSet = Set of Char;
Function CharInSet(Ch: Char;Const CSet : TCharSet) : Boolean;
begin