Browse Source

pastojs: jsvalue is classoftype

git-svn-id: trunk@38002 -
Mattias Gaertner 7 years ago
parent
commit
1bdff08a98
2 changed files with 35 additions and 19 deletions
  1. 15 3
      packages/pastojs/src/fppas2js.pp
  2. 20 16
      packages/pastojs/tests/tcmodules.pas

+ 15 - 3
packages/pastojs/src/fppas2js.pp

@@ -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
-        Call.AddArg(CreateLiteralNumber(El.right,IsExtModePasClass));
+      else if RightTypeEl is TPasClassOfType then
+        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

+ 20 - 16
packages/pastojs/tests/tcmodules.pas

@@ -13232,22 +13232,25 @@ end;
 procedure TTestModule.TestJSValue_ClassOf;
 procedure TTestModule.TestJSValue_ClassOf;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
-  Add('type');
-  Add('  TClass = class of TObject;');
-  Add('  TObject = class');
-  Add('  end;');
-  Add('  TBirds = class of TBird;');
-  Add('  TBird = class(TObject) end;');
-  Add('var');
-  Add('  v: jsvalue;');
-  Add('  c: TClass;');
-  Add('begin');
-  Add('  v:=c;');
-  Add('  v:=TObject;');
-  Add('  v:=TClass(c);');
-  Add('  v:=TBirds(c);');
-  Add('  c:=TClass(v);');
-  Add('  c:=TBirds(v);');
+  Add([
+  'type',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '  end;',
+  '  TBirds = class of TBird;',
+  '  TBird = class(TObject) end;',
+  'var',
+  '  v: jsvalue;',
+  '  c: TClass;',
+  'begin',
+  '  v:=c;',
+  '  v:=TObject;',
+  '  v:=TClass(c);',
+  '  v:=TBirds(c);',
+  '  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;