pastojs: fixed except-ExtClass-on

compiler/packages/pastojs/src/fppas2js.pp

@@ -22176,25 +22176,45 @@ function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn;
   AContext: TConvertContext): TJSElement;
 // convert "on T do ;" to "if(T.isPrototypeOf(exceptObject)){}"
 // convert "on E:T do ;" to "if(T.isPrototypeOf(exceptObject)){ var E=exceptObject; }"
+// convert "on TExternal do ;" to "if(rtl.isExt(exceptObject,TExternal)){}"
+
 Var
   IfSt : TJSIfStatement;
   ListFirst , ListLast: TJSStatementList;
   DotExpr: TJSDotMemberExpression;
   Call: TJSCallExpression;
   V: TJSVariableStatement;
+  aResolver: TPas2JSResolver;
+  aType: TPasType;
+  IsExternal: Boolean;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  aType:=aResolver.ResolveAliasType(El.TypeEl);
+  IsExternal:=(aType is TPasClassType) and TPasClassType(aType).IsExternal;
+
   // create "if()"
   IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
   try
-    // create "T.isPrototypeOf"
-    DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
-    DotExpr.MExpr:=CreateReferencePathExpr(El.TypeEl,AContext);
-    DotExpr.Name:='isPrototypeOf';
-    // create "T.isPrototypeOf(exceptObject)"
-    Call:=CreateCallExpression(El);
-    Call.Expr:=DotExpr;
-    Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnExceptObject),El));
+    if IsExternal then
+      begin
+      // create rtl.isExt(exceptObject,T)
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnIsExt)]);
+      Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnExceptObject),El));
+      Call.AddArg(CreateReferencePathExpr(El.TypeEl,AContext));
+      end
+    else
+      begin
+      // create "T.isPrototypeOf"
+      DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+      DotExpr.MExpr:=CreateReferencePathExpr(El.TypeEl,AContext);
+      DotExpr.Name:='isPrototypeOf';
+      // create "T.isPrototypeOf(exceptObject)"
+      Call:=CreateCallExpression(El);
+      Call.Expr:=DotExpr;
+      Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnExceptObject),El));
+      end;
     IfSt.Cond:=Call;
 
     if El.VarEl<>nil then

compiler/packages/pastojs/tests/tcmodules.pas

@@ -16296,28 +16296,35 @@ end;
 procedure TTestModule.TestExternalClass_Is;
 begin
   StartProgram(false);
-  Add('{$modeswitch externalclass}');
-  Add('type');
-  Add('  TExtA = class external name ''ExtA''');
-  Add('  end;');
-  Add('  TExtAClass = class of TExtA;');
-  Add('  TExtB = class external name ''ExtB'' (TExtA)');
-  Add('  end;');
-  Add('  TExtBClass = class of TExtB;');
-  Add('  TExtC = class (TExtB)');
-  Add('  end;');
-  Add('  TExtCClass = class of TExtC;');
-  Add('var');
-  Add('  A: texta; ClA: TExtAClass;');
-  Add('  B: textb; ClB: TExtBClass;');
-  Add('  C: textc; ClC: TExtCClass;');
-  Add('begin');
-  Add('  if a is textb then ;');
-  Add('  if a is textc then ;');
-  Add('  if b is textc then ;');
-  Add('  if cla is textb then ;');
-  Add('  if cla is textc then ;');
-  Add('  if clb is textc then ;');
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '  end;',
+  '  TExtAClass = class of TExtA;',
+  '  TExtB = class external name ''ExtB'' (TExtA)',
+  '  end;',
+  '  TExtBClass = class of TExtB;',
+  '  TExtC = class (TExtB)',
+  '  end;',
+  '  TExtCClass = class of TExtC;',
+  'var',
+  '  A: texta; ClA: TExtAClass;',
+  '  B: textb; ClB: TExtBClass;',
+  '  C: textc; ClC: TExtCClass;',
+  'begin',
+  '  if a is textb then ;',
+  '  if a is textc then ;',
+  '  if b is textc then ;',
+  '  if cla is textb then ;',
+  '  if cla is textc then ;',
+  '  if clb is textc then ;',
+  '  try',
+  '  except',
+  '  on TExtA do ;',
+  '  on e: TExtB do ;',
+  '  end;',
+  '']);
   ConvertProgram;
   CheckSource('TestExternalClass_Is',
     LinesToStr([ // statements
@@ -16341,6 +16348,12 @@ begin
     'if (rtl.isExt($mod.ClA, ExtB)) ;',
     'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
     'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
+    'try {} catch ($e) {',
+    '  if (rtl.isExt($e,ExtA)) {}',
+    '  else if (rtl.isExt($e,ExtB)) {',
+    '    var e = $e;',
+    '  } else throw $e',
+    '};',
     '']));
 end;