Browse Source

pas2js: fixed type helper nested procedure Self

git-svn-id: trunk@45123 -
Mattias Gaertner 5 years ago
parent
commit
2f1fba51cc
2 changed files with 59 additions and 23 deletions
  1. 20 23
      packages/pastojs/src/fppas2js.pp
  2. 39 0
      packages/pastojs/tests/tcmodules.pas

+ 20 - 23
packages/pastojs/src/fppas2js.pp

@@ -15106,42 +15106,39 @@ begin
             ClassPath:=CreateReferencePath(ProcScope.ClassRecScope.Element,AContext,rpkPathAndName);
             ClassPath:=CreateReferencePath(ProcScope.ClassRecScope.Element,AContext,rpkPathAndName);
             Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
             Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
             end;
             end;
-          if (ImplProc.Body.Functions.Count>0)
-              or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
-            begin
-            // has nested procs -> add "var self = this;"
-            FuncContext.AddLocalVar(GetBIName(pbivnSelf),ThisPas);
-            SelfSt:=CreateVarStatement(GetBIName(pbivnSelf),
-                              CreatePrimitiveDotExpr('this',ImplProc),ImplProc);
-            AddBodyStatement(SelfSt,PosEl);
-            if ImplProcScope.SelfArg<>nil then
-              begin
-              // redirect Pascal-Self to JS-Self
-              FuncContext.AddLocalVar(GetBIName(pbivnSelf),ImplProcScope.SelfArg);
-              end;
-            end
-          else if ImplProcScope.SelfArg<>nil then
-            begin
-            // no nested procs ->  redirect Pascal-Self to JS-this
-            FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
-            end;
           end
           end
         else
         else
           begin
           begin
-          // no "this"
+          // "this" has no direct Pascal element
           if ProcScope.ClassRecScope<>nil then
           if ProcScope.ClassRecScope<>nil then
             begin
             begin
-            // static method -> hide local
+            // static method
             ClassOrRec:=ProcScope.ClassRecScope.Element;
             ClassOrRec:=ProcScope.ClassRecScope.Element;
             LocalVar:=FuncContext.FindLocalIdentifier(ClassOrRec);
             LocalVar:=FuncContext.FindLocalIdentifier(ClassOrRec);
             if (LocalVar<>nil) and (LocalVar.Name='this') then
             if (LocalVar<>nil) and (LocalVar.Name='this') then
+              // "this" is not the class -> hide it (absolute path will be used)
               FuncContext.AddLocalVar(LocalVarHide,ClassOrRec);
               FuncContext.AddLocalVar(LocalVarHide,ClassOrRec);
             end;
             end;
+          end;
+        if (ImplProc.Body.Functions.Count>0)
+            or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
+          begin
+          // has nested procs -> add "var $Self = this;"
+          if ThisPas<>nil then
+            FuncContext.AddLocalVar(GetBIName(pbivnSelf),ThisPas);
+          SelfSt:=CreateVarStatement(GetBIName(pbivnSelf),
+                            CreatePrimitiveDotExpr('this',ImplProc),ImplProc);
+          AddBodyStatement(SelfSt,PosEl);
           if ImplProcScope.SelfArg<>nil then
           if ImplProcScope.SelfArg<>nil then
             begin
             begin
-            // no nested procs ->  redirect Pascal-Self to JS-this
-            FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
+            // redirect Pascal-Self to JS-Self
+            FuncContext.AddLocalVar(GetBIName(pbivnSelf),ImplProcScope.SelfArg);
             end;
             end;
+          end
+        else if ImplProcScope.SelfArg<>nil then
+          begin
+          // no nested procs ->  redirect Pascal-Self to JS-this
+          FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
           end;
           end;
         end;
         end;
       {$IFDEF VerbosePas2JS}
       {$IFDEF VerbosePas2JS}

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

@@ -709,6 +709,7 @@ type
     Procedure TestTypeHelper_EnumType;
     Procedure TestTypeHelper_EnumType;
     Procedure TestTypeHelper_SetType;
     Procedure TestTypeHelper_SetType;
     Procedure TestTypeHelper_InterfaceType;
     Procedure TestTypeHelper_InterfaceType;
+    Procedure TestTypeHelper_NestedSelf;
 
 
     // proc types
     // proc types
     Procedure TestProcType;
     Procedure TestProcType;
@@ -24691,6 +24692,44 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestTypeHelper_NestedSelf;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  THelper = type helper for string',
+  '    procedure Run(Value: string);',
+  '  end;',
+  'procedure THelper.Run(Value: string);',
+  '  function Sub(i: nativeint): boolean;',
+  '  begin',
+  '    Result:=Self[i+1]=Value[i];',
+  '  end;',
+  'begin',
+  '  if Self[3]=Value[4] then ;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_NestedSelf',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.Run = function (Value) {',
+    '    var $Self = this;',
+    '    function Sub(i) {',
+    '      var Result = false;',
+    '      Result = $Self.get().charAt((i + 1) - 1) === Value.charAt(i - 1);',
+    '      return Result;',
+    '    };',
+    '    if ($Self.get().charAt(2) === Value.charAt(3)) ;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 procedure TTestModule.TestProcType;
 begin
 begin
   StartProgram(false);
   StartProgram(false);