From 7a55c7b0a177af27ecbe958852d86eff727c0239 Mon Sep 17 00:00:00 2001
From: Mattias Gaertner <nc-gaertnma@netcologne.de>
Date: Fri, 19 Jan 2018 00:54:14 +0000
Subject: [PATCH] pastojs: check object type casts

git-svn-id: trunk@38004 -
---
 packages/pastojs/src/fppas2js.pp     | 45 ++++++++++++++++++++--------
 packages/pastojs/tests/tcmodules.pas | 21 ++++++++++++-
 2 files changed, 52 insertions(+), 14 deletions(-)

diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index 6de58fc7be..79340d3a9b 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -3883,6 +3883,8 @@ begin
   try
     // add "var $mod = this;"
     IntfContext.ThisPas:=El;
+    if El.CustomData is TPasModuleScope then
+      IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).ScannerBoolSwitches;
     ModVarName:=FBuiltInNames[pbivnModule];
     IntfContext.AddLocalVar(ModVarName,El);
     AddToSourceElements(Src,CreateVarStatement(ModVarName,
@@ -4494,7 +4496,7 @@ begin
       end;
     if (LeftResolved.BaseType=btCustom) then
       begin
-      // aJSValue is ... -> "rtl.isExt(A,B)"
+      // aJSValue is ... -> "rtl.isExt(A,B,mode)"
       Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]);
       Call.AddArg(B); B:=nil;
       if RightTypeEl is TPasClassType then
@@ -5880,6 +5882,8 @@ var
   Param: TPasExpr;
   JSBaseType: TPas2jsBaseType;
   C: TClass;
+  aName: String;
+  aClassTypeEl: TPasClassType;
 begin
   Result:=nil;
   if El.Kind<>pekFuncParams then
@@ -5976,7 +5980,31 @@ begin
       AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
 
       Result:=ConvertElement(Param,AContext);
-      if (ParamResolved.BaseType=btCustom)
+
+      if bsMethodCallChecks in AContext.ScannerBoolSwitches then
+        begin
+        if (C=TPasClassType)
+           or (C=TPasClassOfType) then
+          begin
+          // TObject(value) -> rtl.asExt(value,type,mode)
+          if C=TPasClassOfType then
+            aClassTypeEl:=AContext.Resolver.ResolveAliasType(TPasClassOfType(Decl).DestType) as TPasClassType
+          else
+            aClassTypeEl:=TPasClassType(Decl);
+          aName:=CreateReferencePath(aClassTypeEl,AContext,rpkPathAndName);
+          Call:=CreateCallExpression(El);
+          Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnAsExt]]);
+          Call.AddArg(Result);
+          Call.AddArg(CreatePrimitiveDotExpr(aName,El.Value));
+          if aClassTypeEl.IsExternal then
+          else if C=TPasClassOfType then
+            Call.AddArg(CreateLiteralNumber(El.Value,IsExtModePasClass))
+          else
+            Call.AddArg(CreateLiteralNumber(El.Value,IsExtModePasClassInstance));
+          Result:=Call;
+          end;
+        end
+      else if (ParamResolved.BaseType=btCustom)
           and (ParamResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
         begin
         JSBaseType:=TResElDataPas2JSBaseType(ParamResolved.TypeEl.CustomData).JSBaseType;
@@ -5995,15 +6023,6 @@ begin
           end;
         end;
 
-      if bsMethodCallChecks in AContext.ScannerBoolSwitches then
-        begin
-        if (C=TPasClassType)
-          or (C=TPasClassOfType) then
-          begin
-
-          end;
-        end;
-
       exit;
       end
     else if C.InheritsFrom(TPasVariable) then
@@ -12470,8 +12489,8 @@ var
 begin
   Result:='';
   {$IFDEF VerbosePas2JS}
-  writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
-  AContext.WriteStack;
+  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
+  //AContext.WriteStack;
   {$ENDIF}
   if (El is TPasType) and (AContext<>nil) then
     El:=AContext.Resolver.ResolveAliasType(TPasType(El));
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
index d40a1a0a1d..8412ab2e92 100644
--- a/packages/pastojs/tests/tcmodules.pas
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -15925,12 +15925,23 @@ begin
   '  TObject = class',
   '    procedure DoIt;',
   '  end;',
+  '  TClass = class of tobject;',
+  '  TBird = class',
+  '  end;',
+  '  TBirdClass = class of TBird;',
+  'var',
+  '  o : TObject;',
+  '  c: TClass;',
+  '  b: TBird;',
+  '  bc: TBirdClass;',
   'procedure TObject.DoIt;',
   'begin',
+  '  b:=TBird(o);',
   'end;',
-  'var o : TObject;',
   'begin',
   '  o.DoIt;',
+  '  b:=TBird(o);',
+  '  bc:=TBirdClass(c);',
   '']);
   ConvertProgram;
   CheckSource('TestCheckMethodCall',
@@ -15942,12 +15953,20 @@ begin
     '  };',
     '  this.DoIt = function () {',
     '    rtl.checkMethodCall(this,$mod.TObject);',
+    '    $mod.b = rtl.asExt($mod.o, $mod.TBird, 1);',
     '  };',
     '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '});',
     'this.o = null;',
+    'this.c = null;',
+    'this.b = null;',
+    'this.bc = null;',
     '']),
     LinesToStr([ // $mod.$main
     '$mod.o.DoIt();',
+    '$mod.b = rtl.asExt($mod.o,$mod.TBird, 1);',
+    '$mod.bc = rtl.asExt($mod.c, $mod.TBird, 2);',
     '']));
 end;