瀏覽代碼

pastojs: allow typecast extclass to extclass in mode delphi

git-svn-id: trunk@41623 -
Mattias Gaertner 6 年之前
父節點
當前提交
614755f6da
共有 3 個文件被更改,包括 48 次插入2 次删除
  1. 8 0
      packages/pastojs/src/fppas2js.pp
  2. 38 0
      packages/pastojs/tests/tcmodules.pas
  3. 2 2
      utils/pas2js/docs/translation.html

+ 8 - 0
packages/pastojs/src/fppas2js.pp

@@ -5064,6 +5064,14 @@ begin
                   or IsExternalClass_Name(ToClass,'Object') then
                   or IsExternalClass_Name(ToClass,'Object') then
                 // TJSFunction(@Proc) or TJSFunction(ProcVar)
                 // TJSFunction(@Proc) or TJSFunction(ProcVar)
                 exit(cExact);
                 exit(cExact);
+              end
+            else if FromTypeEl.ClassType=TPasClassType then
+              begin
+              if TPasClassType(FromTypeEl).IsExternal
+                  and (msDelphi in CurrentParser.CurrentModeswitches)
+                  and not (bsObjectChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
+                // ExtClass(ExtClass)  -> allow in mode delphi and no objectchecks
+                exit(cAliasExact); // $mode delphi
               end;
               end;
             end;
             end;
           end;
           end;

+ 38 - 0
packages/pastojs/tests/tcmodules.pas

@@ -591,6 +591,7 @@ type
     Procedure TestExternalClass_TypeCastToJSObject;
     Procedure TestExternalClass_TypeCastToJSObject;
     Procedure TestExternalClass_TypeCastStringToExternalString;
     Procedure TestExternalClass_TypeCastStringToExternalString;
     Procedure TestExternalClass_TypeCastToJSFunction;
     Procedure TestExternalClass_TypeCastToJSFunction;
+    Procedure TestExternalClass_TypeCastDelphiUnrelated;
     Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
     Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
     Procedure TestExternalClass_BracketAccessor;
     Procedure TestExternalClass_BracketAccessor;
     Procedure TestExternalClass_BracketAccessor_Call;
     Procedure TestExternalClass_BracketAccessor_Call;
@@ -16591,6 +16592,43 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestExternalClass_TypeCastDelphiUnrelated;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object'' end;',
+  '  TJSWindow = class external name ''Window''(TJSObject)',
+  '    procedure Open;',
+  '  end;',
+  '  TJSEventTarget = class external name ''Event''(TJSObject)',
+  '    procedure Execute;',
+  '  end;',
+  'procedure Fly;',
+  'var',
+  '  w: TJSWindow;',
+  '  e: TJSEventTarget;',
+  'begin',
+  '  w:=TJSWindow(e);',
+  '  e:=TJSEventTarget(w);',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_TypeCastDelphiUnrelated',
+    LinesToStr([ // statements
+    'this.Fly = function () {',
+    '  var w = null;',
+    '  var e = null;',
+    '  w = e;',
+    '  e = w;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
 procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 2 - 2
utils/pas2js/docs/translation.html

@@ -2707,8 +2707,8 @@ End.
       <li>An external class can descend from another external class.</li>
       <li>An external class can descend from another external class.</li>
       <li>Since class types are JS objects it is possible to typecast a class type
       <li>Since class types are JS objects it is possible to typecast a class type
       to the JS Object, e.g. <i>TJSObject(TObject)</i>.
       to the JS Object, e.g. <i>TJSObject(TObject)</i>.
-      Note that you cannot typecast directly to a <i>TJSObject</i> descendant.
-      You can use <i>TJSWindow(TJSObject(aRecord))</i>.</li>
+      Note that you cannot typecast directly to a <i>TJSObject</i> descendant
+      in $mode objfpc. You can use <i>TJSWindow(TJSObject(ExtClassInstance))</i>.</li>
       <li>You can typecast function addresses and function references to JS
       <li>You can typecast function addresses and function references to JS
       function, e.g. <i>TJSFunction(@SomeProc)</i>, <i>TJSFunction(OnClick)</i>.
       function, e.g. <i>TJSFunction(@SomeProc)</i>, <i>TJSFunction(OnClick)</i>.
       Keep in mind that typecasting a method address creates a function wrapper
       Keep in mind that typecasting a method address creates a function wrapper