* Demo for exception hooks in sysutils

This commit is contained in:
michael 2020-05-16 11:58:19 +00:00
parent 43a68f985a
commit 497319ec87
3 changed files with 176 additions and 0 deletions

View File

@ -0,0 +1,90 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<Runnable Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="errordemo"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<CustomData Count="4">
<Item0 Name="MaintainHTML" Value="1"/>
<Item1 Name="PasJSHTMLFile" Value="project1.html"/>
<Item2 Name="PasJSPort" Value="0"/>
<Item3 Name="PasJSWebBrowserProject" Value="1"/>
</CustomData>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="errordemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="index.html"/>
<IsPartOfProject Value="True"/>
<CustomData Count="1">
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
</CustomData>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target FileExt=".js">
<Filename Value="errordemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="js"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<TargetOS Value="browser"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
<CompilerPath Value="$(pas2js)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,66 @@
program errordemo;
{$mode objfpc}
uses
BrowserConsole, JS, Classes, SysUtils, Web;
function DoRaise(aEvent : TJSMouseEvent) : boolean;
begin
Result:=False;
raise exception.Create('A exception');
end;
function DoHook(aEvent : TJSMouseEvent) : boolean;
begin
Result:=False;
HookUncaughtExceptions;
end;
Procedure DoPascalException(O : TObject);
begin
Writeln('O :',O.ClassName);
if O is Exception then
Writeln('Exception class message : ',Exception(O).Message);
end;
Procedure DoJSException(O : TJSObject);
begin
writeln('Javascript exception: ',O.toString);
if O is TJSError then
Writeln('Error message : ',TJSError(O).Message);
end;
Procedure DoRaiseJS; assembler;
asm
throw new Object();
end;
Procedure DoRaiseJSError; assembler;
asm
var e = new Error();
e.message="My error message";
throw e;
end;
begin
// This will only work for the main program if you have set showUncaughtExceptions before rtl.run();
TJSHtmlButtonElement(Document.getElementById('btnhook')).OnClick:=@DoHook;
// These will not be caught (yet)
TJSHtmlButtonElement(Document.getElementById('btn')).OnClick:=@DoRaise;
// Uncomment this to set default exception handlers
// HookUncaughtExceptions;
// Uncomment these to set special exception handlers
// SetOnUnCaughtExceptionHandler(@DoPascalException);
// SetOnUnCaughtExceptionHandler(@DoJSException);
// Various ways to raise an exception.
// DoRaiseJS;
// DoRaiseJSError;
DoRaise(Nil);
end.

View File

@ -0,0 +1,20 @@
<!doctype html>
<html lang="en">
<head>
<meta http-equiv="Content-type" content="text/html; charset=utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>TestException</title>
<script src="errordemo.js"></script>
</head>
<body>
<button id="btn">Throw exception</button>
<button id="btnhook">Hook events</button>
<script>
// Uncomment to test setting hook.
// rtl.showUncaughtExceptions=true;
rtl.run();
</script>
</body>
</html>