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

pastojs: fixed except-ExtClass-on

Browse Source
This commit is contained in:
mattias 2020-08-08 10:48:57 +00:00
parent 297699f601
commit 7a2a694685
2 changed files with 63 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -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

57
compiler/packages/pastojs/tests/tcmodules.pas
View File

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