pasotjs: fixed implict call procttype arg

git-svn-id: trunk@38086 -

packages/pastojs/src/fppas2js.pp

@@ -4853,6 +4853,36 @@ function TPasToJSConverter.ConvertIdentifierExpr(El: TPasExpr;
     Result:=AContext.GetSelfContext<>nil;
   end;
 
+  procedure CallImplicit(Decl: TPasElement);
+  var
+    ProcType: TPasProcedureType;
+    ResolvedEl: TPasResolverResult;
+    Call: TJSCallExpression;
+  begin
+    // create a call with default parameters
+    ProcType:=nil;
+    if Decl is TPasProcedure then
+      ProcType:=TPasProcedure(Decl).ProcType
+    else
+      begin
+      AContext.Resolver.ComputeElement(El,ResolvedEl,[rcNoImplicitProc]);
+      if ResolvedEl.TypeEl is TPasProcedureType then
+        ProcType:=TPasProcedureType(ResolvedEl.TypeEl)
+      else
+        RaiseNotSupported(El,AContext,20170217005025);
+      end;
+
+    Call:=nil;
+    try
+      CreateProcedureCall(Call,nil,ProcType,AContext);
+      Call.Expr:=Result;
+      Result:=Call;
+    finally
+      if Result<>Call then
+        Call.Free;
+    end;
+  end;
+
 var
   Decl: TPasElement;
   Name: String;
@@ -4860,10 +4890,9 @@ var
   Call: TJSCallExpression;
   BuiltInProc: TResElDataBuiltInProc;
   Prop: TPasProperty;
-  ImplicitCall: Boolean;
+  IsImplicitCall: Boolean;
   AssignContext: TAssignContext;
-  ResolvedEl: TPasResolverResult;
-  ProcType, TargetProcType: TPasProcedureType;
+  TargetProcType: TPasProcedureType;
   ArrLit: TJSArrayLiteral;
   IndexExpr: TPasExpr;
   Func: TPasFunction;
@@ -4919,7 +4948,7 @@ begin
 
   Prop:=nil;
   AssignContext:=nil;
-  ImplicitCall:=rrfImplicitCallWithoutParams in Ref.Flags;
+  IsImplicitCall:=rrfImplicitCallWithoutParams in Ref.Flags;
 
   if Decl.ClassType=TPasProperty then
     begin
@@ -4960,7 +4989,7 @@ begin
         begin
         Result:=CreatePropertyGet(Prop,Ref,AContext,El);
         if Result is TJSCallExpression then exit;
-        if not ImplicitCall then exit;
+        if not IsImplicitCall then exit;
         end;
       else
         RaiseNotSupported(El,AContext,20170213212623);
@@ -4969,6 +4998,8 @@ begin
   else if Decl.ClassType=TPasArgument then
     begin
     Result:=CreateArgumentAccess(TPasArgument(Decl),AContext,El);
+    if IsImplicitCall then
+      CallImplicit(Decl);
     exit;
     end
   else if Decl.ClassType=TPasConst then
@@ -5001,10 +5032,8 @@ begin
     Call.AddArg(CreatePrimitiveDotExpr(TransformModuleName(Decl.GetModule,true,AContext),El));
     Call.AddArg(CreateLiteralString(El,TransformVariableName(Decl,AContext)));
     exit;
-    end;
-
-  //writeln('TPasToJSConverter.ConvertPrimitiveExpression pekIdent TResolvedReference ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData));
-  if Decl.CustomData is TResElDataBuiltInProc then
+    end
+  else if Decl.CustomData is TResElDataBuiltInProc then
     begin
     BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
     {$IFDEF VerbosePas2JS}
@@ -5063,31 +5092,8 @@ begin
   if Result=nil then
     Result:=CreatePrimitiveDotExpr(Name,El);
 
-  if ImplicitCall then
-    begin
-    // create a call with default parameters
-    ProcType:=nil;
-    if Decl is TPasProcedure then
-      ProcType:=TPasProcedure(Decl).ProcType
-    else
-      begin
-      AContext.Resolver.ComputeElement(El,ResolvedEl,[rcNoImplicitProc]);
-      if ResolvedEl.TypeEl is TPasProcedureType then
-        ProcType:=TPasProcedureType(ResolvedEl.TypeEl)
-      else
-        RaiseNotSupported(El,AContext,20170217005025);
-      end;
-
-    Call:=nil;
-    try
-      CreateProcedureCall(Call,nil,ProcType,AContext);
-      Call.Expr:=Result;
-      Result:=Call;
-    finally
-      if Result<>Call then
-        Call.Free;
-    end;
-    end;
+  if IsImplicitCall then
+    CallImplicit(Decl);
 end;
 
 function TPasToJSConverter.ConvertBoolConstExpression(El: TBoolConstExpr;

packages/pastojs/tests/tcmodules.pas

@@ -467,6 +467,7 @@ type
 
     // proc types
     Procedure TestProcType;
+    Procedure TestProcType_Arg;
     Procedure TestProcType_FunctionFPC;
     Procedure TestProcType_FunctionDelphi;
     Procedure TestProcType_ProcedureDelphi;
@@ -11799,32 +11800,33 @@ end;
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TProcInt = procedure(vI: longint = 1);');
-  Add('procedure DoIt(vJ: longint);');
-  Add('begin end;');
-  Add('var');
-  Add('  b: boolean;');
-  Add('  vP, vQ: tprocint;');
-  Add('begin');
-  Add('  vp:=nil;');
-  Add('  vp:=vp;');
-  Add('  vp:=@doit;');
-  Add('  vp;');
-  Add('  vp();');
-  Add('  vp(2);');
-  Add('  b:=vp=nil;');
-  Add('  b:=nil=vp;');
-  Add('  b:=vp=vq;');
-  Add('  b:=vp=@doit;');
-  Add('  b:=@doit=vp;');
-  Add('  b:=vp<>nil;');
-  Add('  b:=nil<>vp;');
-  Add('  b:=vp<>vq;');
-  Add('  b:=vp<>@doit;');
-  Add('  b:=@doit<>vp;');
-  Add('  b:=Assigned(vp);');
-  Add('  if Assigned(vp) then ;');
+  Add([
+  'type',
+  '  TProcInt = procedure(vI: longint = 1);',
+  'procedure DoIt(vJ: longint);',
+  'begin end;',
+  'var',
+  '  b: boolean;',
+  '  vP, vQ: tprocint;',
+  'begin',
+  '  vp:=nil;',
+  '  vp:=vp;',
+  '  vp:=@doit;',
+  '  vp;',
+  '  vp();',
+  '  vp(2);',
+  '  b:=vp=nil;',
+  '  b:=nil=vp;',
+  '  b:=vp=vq;',
+  '  b:=vp=@doit;',
+  '  b:=@doit=vp;',
+  '  b:=vp<>nil;',
+  '  b:=nil<>vp;',
+  '  b:=vp<>vq;',
+  '  b:=vp<>@doit;',
+  '  b:=@doit<>vp;',
+  '  b:=Assigned(vp);',
+  '  if Assigned(vp) then ;']);
   ConvertProgram;
   CheckSource('TestProcType',
     LinesToStr([ // statements
@@ -11856,6 +11858,70 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestProcType_Arg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProcInt = procedure(vI: longint = 1);',
+  'procedure DoIt(vJ: longint); begin end;',
+  'procedure DoSome(vP, vQ: TProcInt);',
+  'var',
+  '  b: boolean;',
+  'begin',
+  '  vp:=nil;',
+  '  vp:=vp;',
+  '  vp:=@doit;',
+  '  vp;',
+  '  vp();',
+  '  vp(2);',
+  '  b:=vp=nil;',
+  '  b:=nil=vp;',
+  '  b:=vp=vq;',
+  '  b:=vp=@doit;',
+  '  b:=@doit=vp;',
+  '  b:=vp<>nil;',
+  '  b:=nil<>vp;',
+  '  b:=vp<>vq;',
+  '  b:=vp<>@doit;',
+  '  b:=@doit<>vp;',
+  '  b:=Assigned(vp);',
+  '  if Assigned(vp) then ;',
+  'end;',
+  'begin',
+  '  DoSome(@DoIt,nil);']);
+  ConvertProgram;
+  CheckSource('TestProcType_Arg',
+    LinesToStr([ // statements
+    'this.DoIt = function(vJ) {',
+    '};',
+    'this.DoSome = function(vP, vQ) {',
+    '  var b = false;',
+    '  vP = null;',
+    '  vP = vP;',
+    '  vP = $mod.DoIt;',
+    '  vP(1);',
+    '  vP(1);',
+    '  vP(2);',
+    '  b = vP === null;',
+    '  b = null === vP;',
+    '  b = rtl.eqCallback(vP,vQ);',
+    '  b = rtl.eqCallback(vP, $mod.DoIt);',
+    '  b = rtl.eqCallback($mod.DoIt, vP);',
+    '  b = vP !== null;',
+    '  b = null !== vP;',
+    '  b = !rtl.eqCallback(vP, vQ);',
+    '  b = !rtl.eqCallback(vP, $mod.DoIt);',
+    '  b = !rtl.eqCallback($mod.DoIt, vP);',
+    '  b = vP != null;',
+    '  if (vP != null) ;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoSome($mod.DoIt,null);',
+    '']));
+end;
+
 procedure TTestModule.TestProcType_FunctionFPC;
 begin
   StartProgram(false);