pastojs: helpers: external method apply to helped type

git-svn-id: trunk@41707 -

packages/fcl-passrc/src/pasresolver.pp

@@ -2024,7 +2024,7 @@ type
     function GetFunctionType(El: TPasElement): TPasFunctionType;
     function MethodIsStatic(El: TPasProcedure): boolean;
     function IsMethod(El: TPasProcedure): boolean;
-    function IsHelperMethod(El: TPasElement): boolean;
+    function IsHelperMethod(El: TPasElement): boolean; virtual;
     function IsHelper(El: TPasElement): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;

packages/pastojs/src/fppas2js.pp

@@ -1455,6 +1455,8 @@ type
     function IsForInExtArray(Loop: TPasImplForLoop; const VarResolved,
       InResolved: TPasResolverResult; out ArgResolved, LengthResolved,
       PropResultResolved: TPasResolverResult): boolean;
+    function IsHelperMethod(El: TPasElement): boolean; override;
+    function IsHelperForMember(El: TPasElement): boolean;
   end;
 
 //------------------------------------------------------------------------------
@@ -3987,19 +3989,25 @@ begin
                 RaiseMsg(20180329141108,nInvalidXModifierY,
                   sInvalidXModifierY,[Proc.ElementTypeName,ModifierNames[pm]],Proc);
             end;
-          okClassHelper:
+          okClassHelper,okRecordHelper,okTypeHelper:
             begin
             HelperForType:=ResolveAliasType(AClass.HelperForType);
-            if HelperForType.ClassType<>TPasClassType then
-              RaiseNotYetImplemented(20190201165157,El);
-            if TPasClassType(HelperForType).IsExternal then
+            if HelperForType.ClassType=TPasClassType then
               begin
-              // method of a class helper for external class
-              if IsClassMethod(El) and not (ptmStatic in El.Modifiers) then
-                RaiseMsg(20190201165259,nHelperClassMethodForExtClassMustBeStatic,
-                  sHelperClassMethodForExtClassMustBeStatic,[],El);
-              if El.ClassType=TPasConstructor then
-                RaiseNotYetImplemented(20190206153655,El);
+              if TPasClassType(HelperForType).IsExternal then
+                begin
+                // method of a class helper for external class
+                if IsClassMethod(El) and not (ptmStatic in El.Modifiers) then
+                  RaiseMsg(20190201165259,nHelperClassMethodForExtClassMustBeStatic,
+                    sHelperClassMethodForExtClassMustBeStatic,[],El);
+                if El.ClassType=TPasConstructor then
+                  RaiseNotYetImplemented(20190206153655,El);
+                end;
+              end;
+            if Proc.IsExternal then
+              begin
+              if not (HelperForType is TPasMembersType) then
+                RaiseMsg(20190314225457,nNotSupportedX,sNotSupportedX,['external method in type helper'],El);
               end;
             end;
           end;
@@ -5886,6 +5894,26 @@ begin
   CheckAssignResCompatibility(VarResolved,PropResultResolved,Loop.VariableName,true);
 end;
 
+function TPas2JSResolver.IsHelperMethod(El: TPasElement): boolean;
+begin
+  Result:=inherited IsHelperMethod(El);
+  if not Result then exit;
+  Result:=not TPasProcedure(El).IsExternal;
+end;
+
+function TPas2JSResolver.IsHelperForMember(El: TPasElement): boolean;
+begin
+  if (El=nil) or (El.Parent=nil) or (El.Parent.ClassType<>TPasClassType)
+      or (TPasClassType(El.Parent).HelperForType=nil) then
+    exit(false);
+  if El is TPasProcedure then
+    Result:=TPasProcedure(El).IsExternal
+  else if El is TPasVariable then
+    Result:=vmExternal in TPasVariable(El).VarModifiers
+  else
+    Result:=true;
+end;
+
 { TParamContext }
 
 constructor TParamContext.Create(PasEl: TPasElement; JSEl: TJSElement;
@@ -7896,7 +7924,8 @@ begin
   if aResolver.IsHelper(RightRefDecl.Parent) then
     begin
     // LeftJS.HelperMember
-    if RightRefDecl is TPasVariable then
+    if (RightRefDecl is TPasVariable)
+        and not (vmExternal in TPasVariable(RightRefDecl).VarModifiers) then
       begin
       // LeftJS.HelperField  -> HelperType.HelperField
       if Assigned(OnConvertRight) then
@@ -7907,7 +7936,10 @@ begin
       end
     else if RightRefDecl is TPasProcedure then
       begin
-      if rrfNoImplicitCallWithoutParams in RightRef.Flags then
+      Proc:=TPasProcedure(RightRefDecl);
+      if Proc.IsExternal then
+        // normal call
+      else if rrfNoImplicitCallWithoutParams in RightRef.Flags then
         begin
         Result:=CreateReferencePathExpr(RightRefDecl,AContext);
         exit;
@@ -7915,7 +7947,6 @@ begin
       else
         begin
         // call helper method
-        Proc:=TPasProcedure(RightRefDecl);
         Result:=CreateCallHelperMethod(Proc,El,AContext);
         exit;
         end;
@@ -8295,7 +8326,7 @@ begin
         Decl:=aResolver.GetPasPropertySetter(Prop);
         if Decl is TPasProcedure then
           begin
-          if aResolver.IsHelper(Decl.Parent) then
+          if aResolver.IsHelperMethod(Decl) then
             begin
             Result:=CreateCallHelperMethod(TPasProcedure(Decl),El,AContext);
             exit;
@@ -9768,7 +9799,7 @@ begin
       end
     else if C.InheritsFrom(TPasProcedure) then
       begin
-      if aResolver.IsHelper(Decl.Parent) then
+      if aResolver.IsHelperMethod(Decl) then
         begin
         // calling a helper method
         Result:=CreateCallHelperMethod(TPasProcedure(Decl),El.Value,AContext);
@@ -16187,7 +16218,7 @@ begin
     Result:=CreateReferencePathExpr(Proc,AContext);
     exit;
     end;
-  IsHelper:=aResolver.IsHelper(Proc.Parent);
+  IsHelper:=aResolver.IsHelperMethod(Proc);
   NeedClass:=aResolver.IsClassMethod(Proc) and not aResolver.MethodIsStatic(Proc);
 
   // an of-object method -> create "rtl.createCallback(Target,func)"
@@ -16599,7 +16630,7 @@ begin
   if Decl is TPasFunction then
     begin
     // call function
-    if aResolver.IsHelper(Decl.Parent) then
+    if aResolver.IsHelperMethod(Decl) then
       begin
       if (Expr=nil) then
         // implicit property read, e.g. enumerator property Current
@@ -21304,9 +21335,16 @@ var
   begin
     if (Ref=nil) or (Ref.WithExprScope=nil) then exit(false);
     Parent:=El.Parent;
-    if (Parent<>nil) and (Parent.ClassType=TPasClassType)
+    if (Parent.ClassType=TPasClassType)
         and (TPasClassType(Parent).HelperForType<>nil) then
-      exit(false);
+      begin
+      // e.g. with Obj do HelperMethod
+      if aResolver.IsHelperForMember(El) then
+        // e.g. with Obj do HelperExternalMethod  -> Obj.HelperCall
+      else
+        // e.g. with Obj do HelperMethod  -> THelper.HelperCall
+        exit(false);
+      end;
     Result:=true;
   end;
 
@@ -21403,6 +21441,8 @@ var
 begin
   Result:='';
   {$IFDEF VerbosePas2JS}
+  if SameText(El.Name,'Fly') then
+    writeln('AAA1 TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
   //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
   //AContext.WriteStack;
   {$ENDIF}
@@ -21484,6 +21524,7 @@ begin
   else
     begin
     // need full path
+      writeln('AAA2 TPasToJSConverter.CreateReferencePath ');
     if El.Parent=nil then
       RaiseNotSupported(El,AContext,20170201172141,GetObjName(El));
     El:=ImplToDecl(El);
@@ -21493,38 +21534,26 @@ begin
       begin
       ParentEl:=ImplToDecl(ParentEl);
 
+      IsClassRec:=(ParentEl.ClassType=TPasClassType)
+               or (ParentEl.ClassType=TPasRecordType);
+
       // check if ParentEl has a JS var
       ShortName:=AContext.GetLocalName(ParentEl);
       //writeln('TPasToJSConverter.CreateReferencePath El=',GetObjName(El),' ParentEl=',GetObjName(ParentEl),' ShortName=',ShortName);
 
-      IsClassRec:=(ParentEl.ClassType=TPasClassType)
-               or (ParentEl.ClassType=TPasRecordType);
-
-      if (ShortName<>'') and not IsClassRec then
-        begin
-        Prepend(Result,ShortName);
-        break;
-        end
-      else if ParentEl.ClassType=TImplementationSection then
-        begin
-        // element is in an implementation section (not program/library section)
-        // in other unit -> use pas.unitname.$impl
-        FoundModule:=El.GetModule;
-        if FoundModule=nil then
-          RaiseInconsistency(20161024192755,El);
-        Prepend(Result,TransformModuleName(FoundModule,true,AContext)
-           +'.'+GetBIName(pbivnImplementation));
-        break;
-        end
-      else if ParentEl is TPasModule then
-        begin
-        // element is in an unit interface or program/library section
-        Prepend(Result,TransformModuleName(TPasModule(ParentEl),true,AContext));
-        break;
-        end
-      else if IsClassRec then
+      if IsClassRec then
         begin
         // parent is a class or record declaration
+          writeln('AAA3 TPasToJSConverter.CreateReferencePath ',GetObjName(ParentEl));
+        if (ParentEl.ClassType=TPasClassType)
+            and (TPasClassType(ParentEl).HelperForType<>nil)
+            and aResolver.IsHelperForMember(El) then
+          begin
+          // redirect to helper-for-type
+          ParentEl:=aResolver.ResolveAliasType(TPasClassType(ParentEl).HelperForType);
+          ShortName:=AContext.GetLocalName(ParentEl);
+          end;
+
         if Full then
           Prepend(Result,ParentEl.Name)
         else
@@ -21541,8 +21570,10 @@ begin
             Prepend(Result,ParentEl.Name)
           else if (ParentEl.ClassType=TPasClassType)
               and (TPasClassType(ParentEl).HelperForType<>nil) then
+            begin
             // helpers have no self
-            Prepend(Result,ParentEl.Name)
+            Prepend(Result,ParentEl.Name);
+            end
           else if (SelfContext<>nil)
               and IsA(TPasType(SelfContext.ThisPas),TPasMembersType(ParentEl)) then
             begin
@@ -21575,6 +21606,28 @@ begin
             break;
           end;
         end
+      else if (ShortName<>'') then
+        begin
+        Prepend(Result,ShortName);
+        break;
+        end
+      else if ParentEl.ClassType=TImplementationSection then
+        begin
+        // element is in an implementation section (not program/library section)
+        // in other unit -> use pas.unitname.$impl
+        FoundModule:=El.GetModule;
+        if FoundModule=nil then
+          RaiseInconsistency(20161024192755,El);
+        Prepend(Result,TransformModuleName(FoundModule,true,AContext)
+           +'.'+GetBIName(pbivnImplementation));
+        break;
+        end
+      else if ParentEl is TPasModule then
+        begin
+        // element is in an unit interface or program/library section
+        Prepend(Result,TransformModuleName(TPasModule(ParentEl),true,AContext));
+        break;
+        end
       else if ParentEl.ClassType=TPasEnumType then
         begin
         if (ShortName<>'') and not Full then

packages/pastojs/tests/tcmodules.pas

@@ -680,6 +680,7 @@ type
     Procedure TestTypeHelper_ClassProperty;
     Procedure TestTypeHelper_ClassProperty_Array;
     Procedure TestTypeHelper_ClassMethod;
+    Procedure TestTypeHelper_ExtClassMethodFail;
     Procedure TestTypeHelper_Constructor;
     Procedure TestTypeHelper_Word;
     Procedure TestTypeHelper_Double;
@@ -21197,12 +21198,15 @@ begin
   Add([
   '{$modeswitch externalclass}',
   'type',
+  '  TFly = function(w: word): word of object;',
   '  TExtA = class external name ''ExtObj''',
   '    procedure Run(w: word = 10);',
   '  end;',
   '  THelper = class helper for TExtA',
   '    function Foo(w: word = 1): word;',
+  '    function Fly(w: word = 2): word; external name ''Fly'';',
   '  end;',
+  'var p: TFly;',
   'function THelper.foo(w: word): word;',
   'begin',
   '  Run;',
@@ -21214,22 +21218,32 @@ begin
   '  Self.Foo;',
   '  Self.Foo();',
   '  Self.Foo(13);',
+  '  Fly;',
+  '  Fly();',
   '  with Self do begin',
   '    Foo;',
   '    Foo();',
   '    Foo(14);',
+  '    Fly;',
+  '    Fly();',
   '  end;',
+  '  p:=@Fly;',
   'end;',
   'var Obj: TExtA;',
   'begin',
   '  obj.Foo;',
   '  obj.Foo();',
   '  obj.Foo(21);',
+  '  obj.Fly;',
+  '  obj.Fly();',
   '  with obj do begin',
   '    Foo;',
   '    Foo();',
   '    Foo(22);',
+  '    Fly;',
+  '    Fly();',
   '  end;',
+  '  p:[email protected];',
   '']);
   ConvertProgram;
   CheckSource('TestExtClassHelper_Method_Call',
@@ -21246,22 +21260,33 @@ begin
     '    $mod.THelper.Foo.call(this, 1);',
     '    $mod.THelper.Foo.call(this, 1);',
     '    $mod.THelper.Foo.call(this, 13);',
+    '    this.Fly(2);',
+    '    this.Fly(2);',
     '    $mod.THelper.Foo.call(this, 1);',
     '    $mod.THelper.Foo.call(this, 1);',
     '    $mod.THelper.Foo.call(this, 14);',
+    '    this.Fly(2);',
+    '    this.Fly(2);',
+    '    $mod.p = rtl.createCallback(this, "Fly");',
     '    return Result;',
     '  };',
     '});',
+    'this.p = null;',
     'this.Obj = null;',
     '']),
     LinesToStr([ // $mod.$main
     '$mod.THelper.Foo.call($mod.Obj, 1);',
     '$mod.THelper.Foo.call($mod.Obj, 1);',
     '$mod.THelper.Foo.call($mod.Obj, 21);',
+    '$mod.Obj.Fly(2);',
+    '$mod.Obj.Fly(2);',
     'var $with1 = $mod.Obj;',
     '$mod.THelper.Foo.call($with1, 1);',
     '$mod.THelper.Foo.call($with1, 1);',
     '$mod.THelper.Foo.call($with1, 22);',
+    '$with1.Fly(2);',
+    '$with1.Fly(2);',
+    '$mod.p = rtl.createCallback($mod.Obj, "Fly");',
     '']));
 end;
 
@@ -23022,6 +23047,23 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestTypeHelper_ExtClassMethodFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  THelper = type helper for word',
+  '    procedure Run; external name ''Run'';',
+  '  end;',
+  'var w: word;',
+  'begin',
+  '  w.Run;',
+  '']);
+  SetExpectedPasResolverError('Not supported: external method in type helper',nNotSupportedX);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestTypeHelper_Constructor;
 begin
   StartProgram(false);

utils/pas2js/docs/translation.html

@@ -1867,8 +1867,9 @@ function(){
       <li>A <b>record helper</b> can "extend" a record type. In $mode delphi a
         record helper can extend other types as well, see <i>type helper</i></li>
       <li>A <b>type helper</b> can extend all base types like integer, string,
-        char, boolean, double, currency, and some user types like enumeration,
-        set, range and array types. It cannot extend interfaces or helpers.<br>
+        char, boolean, double, currency, and user types like enumeration,
+        set, range, array, class, record and interface types.
+        It cannot extend helpers and procedural types.<br>
         Type helpers are enabled by default in <i>$mode delphi</i> and disabled in <i>$mode objfpc</i>.
         You can enable them with <b>{$modeswitch typehelpers}</b>.
         </li>
@@ -1929,6 +1930,8 @@ function(){
         <li><i>with value do ;</i> : uses a temporary variable. Delphi/FPC do not support it.</li>
         </ul>
       </li>
+      <li>A method with <i>external name</i> modifier is treated as an external
+        method of the helped type.</li>
     </ul>
     </div>