summaryrefslogtreecommitdiff
path: root/packages/pastojs/tests/tcgenerics.pas
diff options
context:
space:
mode:
Diffstat (limited to 'packages/pastojs/tests/tcgenerics.pas')
-rw-r--r--packages/pastojs/tests/tcgenerics.pas72
1 files changed, 72 insertions, 0 deletions
diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas
index 8b1c961aa3..ff46fbe342 100644
--- a/packages/pastojs/tests/tcgenerics.pas
+++ b/packages/pastojs/tests/tcgenerics.pas
@@ -62,6 +62,7 @@ type
Procedure TestGen_CallUnitImplProc;
Procedure TestGen_IntAssignTemplVar;
Procedure TestGen_TypeCastDotField;
+ Procedure TestGen_Except;
// generic helper
procedure TestGen_HelperForArray;
@@ -1950,6 +1951,77 @@ begin
'']));
end;
+procedure TTestGenerics.TestGen_Except;
+begin
+ StartProgram(false);
+ Add([
+ 'type',
+ ' TObject = class end;',
+ ' generic TBird<T> = class',
+ ' Field: T;',
+ ' procedure Fly;',
+ ' end;',
+ ' Exception = class',
+ ' end;',
+ ' generic EBird<T> = class(Exception)',
+ ' Id: T;',
+ ' end;',
+ 'var',
+ ' b: specialize TBird<word>;',
+ 'procedure TBird.Fly;',
+ 'begin',
+ ' try',
+ ' except',
+ ' on E: Exception do Fly;',
+ ' on EBird: specialize EBird<word> do EBird.Id:=3;',
+ ' else',
+ ' Fly;',
+ ' end;',
+ 'end;',
+ 'begin',
+ '']);
+ ConvertProgram;
+ CheckSource('TestGen_Except',
+ LinesToStr([ // statements
+ 'rtl.createClass(this, "TObject", null, function () {',
+ ' this.$init = function () {',
+ ' };',
+ ' this.$final = function () {',
+ ' };',
+ '});',
+ 'rtl.createClass(this, "Exception", this.TObject, function () {',
+ '});',
+ 'rtl.createClass(this, "TBird$G1", this.TObject, function () {',
+ ' this.$init = function () {',
+ ' $mod.TObject.$init.call(this);',
+ ' this.Field = 0;',
+ ' };',
+ ' this.Fly = function () {',
+ ' try {} catch ($e) {',
+ ' if ($mod.Exception.isPrototypeOf($e)) {',
+ ' var E = $e;',
+ ' this.Fly();',
+ ' } else if ($mod.EBird$G1.isPrototypeOf($e)) {',
+ ' var EBird = $e;',
+ ' EBird.Id = 3;',
+ ' } else {',
+ ' this.Fly();',
+ ' }',
+ ' };',
+ ' };',
+ '}, "TBird<System.Word>");',
+ 'this.b = null;',
+ 'rtl.createClass(this, "EBird$G1", this.Exception, function () {',
+ ' this.$init = function () {',
+ ' $mod.Exception.$init.call(this);',
+ ' this.Id = 0;',
+ ' };',
+ '}, "EBird<System.Word>");',
+ '']),
+ LinesToStr([ // $mod.$main
+ '']));
+end;
+
procedure TTestGenerics.TestGen_HelperForArray;
begin
StartProgram(false);