pastojs: specialize try except on, issue #38795

git-svn-id: trunk@49253 -

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -157,6 +157,7 @@ type
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
     procedure TestGenProc_ParamSpecWithT;
+    // ToDo: TestGenProc_ParamSpecWithTNestedType function Fly<T>(a: TBird<T>.TEvent; aSender: T): Word;
     // ToDo: NestedResultAssign
 
     // generic function infer types

packages/pastojs/src/fppas2js.pp

@@ -4488,6 +4488,9 @@ begin
       AddElevatedLocal(El);
       end;
     end
+  else if ParentC=TPasImplExceptOn then
+    // except on var
+    RaiseVarModifierNotSupported(LocalVarModifiersAllowed)
   else if ParentC=TImplementationSection then
     // implementation var
     RaiseVarModifierNotSupported(ImplementationVarModifiersAllowed)
@@ -4499,7 +4502,7 @@ begin
   else
     begin
     {$IFDEF VerbosePas2JS}
-    writeln('TPas2JSResolver.FinishVariable ',GetObjName(El),' Parent=',GetObjName(El.Parent));
+    writeln('TPas2JSResolver.FinishVariable ',GetObjPath(El));
     {$ENDIF}
     RaiseNotYetImplemented(20170324151259,El);
     end;

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);