paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 12:39:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: jsvalue is classoftype

Browse Source 
git-svn-id: trunk@38002 -
This commit is contained in:
Mattias Gaertner 2018-01-19 00:01:57 +00:00
parent a112eae49a
commit 1bdff08a98
2 changed files with 35 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/pastojs/src/fppas2js.pp
View File

@ -2785,6 +2785,8 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out
SetResolverValueExpr(ResolvedEl,BaseType,BaseTypes[BaseType],Bin,[rrfReadable]); SetResolverValueExpr(ResolvedEl,BaseType,BaseTypes[BaseType],Bin,[rrfReadable]);
end; end;
var
RightTypeEl: TPasType;
begin begin
if (LeftResolved.BaseType=btCustom) if (LeftResolved.BaseType=btCustom)
or (RightResolved.BaseType=btCustom) then or (RightResolved.BaseType=btCustom) then
@ -2800,6 +2802,14 @@ begin
SetBaseType(btBoolean); SetBaseType(btBoolean);
exit; exit;
end; end;
RightTypeEl:=ResolveAliasType(RightResolved.TypeEl);
if (RightTypeEl is TPasClassOfType) then
begin
// e.g. if aJSValue is TClass then ;
// or if aJSValue is ImageClass then ;
SetBaseType(btBoolean);
exit;
end;
end; end;
end; end;
@ -4487,10 +4497,12 @@ begin
// aJSValue is ... -> "rtl.isExt(A,B)" // aJSValue is ... -> "rtl.isExt(A,B)"
Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]); Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]);
Call.AddArg(B); B:=nil; Call.AddArg(B); B:=nil;
if TypeEl is TPasClassType then if RightTypeEl is TPasClassType then
Call.AddArg(CreateLiteralNumber(El.right,IsExtModePasClassInstance)) Call.AddArg(CreateLiteralNumber(El.right,IsExtModePasClassInstance))
else if TypeEl is TPasClassOfType then else if RightTypeEl is TPasClassOfType then
Call.AddArg(CreateLiteralNumber(El.right,IsExtModePasClass)); Call.AddArg(CreateLiteralNumber(El.right,IsExtModePasClass))
else
RaiseNotSupported(El,AContext,20180119005904);
end end
else if (RightTypeEl is TPasClassType) and TPasClassType(RightTypeEl).IsExternal then else if (RightTypeEl is TPasClassType) and TPasClassType(RightTypeEl).IsExternal then
begin begin

36
packages/pastojs/tests/tcmodules.pas
View File

@ -13232,22 +13232,25 @@ end;
procedure TTestModule.TestJSValue_ClassOf; procedure TTestModule.TestJSValue_ClassOf;
begin begin
StartProgram(false); StartProgram(false);
Add('type'); Add([
Add(' TClass = class of TObject;'); 'type',
Add(' TObject = class'); ' TClass = class of TObject;',
Add(' end;'); ' TObject = class',
Add(' TBirds = class of TBird;'); ' end;',
Add(' TBird = class(TObject) end;'); ' TBirds = class of TBird;',
Add('var'); ' TBird = class(TObject) end;',
Add(' v: jsvalue;'); 'var',
Add(' c: TClass;'); ' v: jsvalue;',
Add('begin'); ' c: TClass;',
Add(' v:=c;'); 'begin',
Add(' v:=TObject;'); ' v:=c;',
Add(' v:=TClass(c);'); ' v:=TObject;',
Add(' v:=TBirds(c);'); ' v:=TClass(c);',
Add(' c:=TClass(v);'); ' v:=TBirds(c);',
Add(' c:=TBirds(v);'); ' c:=TClass(v);',
' c:=TBirds(v);',
' if v is TClass then ;',
'']);
ConvertProgram; ConvertProgram;
CheckSource('TestJSValue_ClassOf', CheckSource('TestJSValue_ClassOf',
LinesToStr([ // statements LinesToStr([ // statements
@ -13269,6 +13272,7 @@ begin
'$mod.v = $mod.c;', '$mod.v = $mod.c;',
'$mod.c = rtl.getObject($mod.v);', '$mod.c = rtl.getObject($mod.v);',
'$mod.c = rtl.getObject($mod.v);', '$mod.c = rtl.getObject($mod.v);',
'if (rtl.isExt($mod.v, $mod.TObject, 2)) ;',
''])); '']));
end; end;