fcl-passrc: resolver: fixed implicit call of func(typecast(function))

git-svn-id: trunk@38996 -

packages/fcl-passrc/src/pasresolver.pp

@@ -7890,6 +7890,7 @@ procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
   var
     i: Integer;
   begin
+    if ParamAccess=rraParamToUnknownProc then exit;
     for i:=0 to length(Params.Params)-1 do
       FinishCallArgAccess(Params.Params[i],ParamAccess);
   end;
@@ -8533,7 +8534,7 @@ begin
     case Params.Kind of
     pekFuncParams:
       if IsTypeCast(Params) then
-        AccessExpr(Params.Params[0],Access)
+        FinishCallArgAccess(Params.Params[0],Access)
       else
         AccessExpr(Params.Value,Access);
     pekArrayParams:
@@ -14958,14 +14959,12 @@ var
   i, ParamCnt, ParamCompatibility: Integer;
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
-  IsVarArgs: Boolean;
   Flags: TPasResolverComputeFlags;
 begin
   Result:=cExact;
   ProcArgs:=ProcType.Args;
   // check args
   ParamCnt:=length(Params.Params);
-  IsVarArgs:=false;
   i:=0;
   while i<ParamCnt do
     begin
@@ -14982,8 +14981,7 @@ begin
       end
     else
       begin
-      IsVarArgs:=IsVarArgs or (ptmVarargs in ProcType.Modifiers);
-      if IsVarArgs then
+      if ptmVarargs in ProcType.Modifiers then
         begin
         if SetReferenceFlags then
           Flags:=[rcNoImplicitProcType,rcSetReferenceFlags]

packages/pastojs/tests/tcmodules.pas

@@ -298,6 +298,7 @@ type
     Procedure TestAssignFunctionResult;
     Procedure TestFunctionResultInCondition;
     Procedure TestFunctionResultInForLoop;
+    Procedure TestFunctionResultInTypeCast;
     Procedure TestExit;
     Procedure TestBreak;
     Procedure TestBreakAsVar;
@@ -493,6 +494,7 @@ type
     Procedure TestExternalClass_DuplicateVarFail;
     Procedure TestExternalClass_Method;
     Procedure TestExternalClass_ClassMethod;
+    Procedure TestExternalClass_FunctionResultInTypeCast;
     Procedure TestExternalClass_NonExternalOverride;
     Procedure TestExternalClass_OverloadHint;
     Procedure TestExternalClass_Property;
@@ -2933,6 +2935,29 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestFunctionResultInTypeCast;
+begin
+  StartProgram(false);
+  Add([
+  'function GetInt: longint;',
+  'begin',
+  'end;',
+  'begin',
+  '  if Byte(GetInt)=0 then ;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestFunctionResultInTypeCast',
+    LinesToStr([ // statements
+    'this.GetInt = function () {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    'if (($mod.GetInt() & 255) === 0) ;'
+    ]));
+end;
+
 procedure TTestModule.TestExit;
 begin
   StartProgram(false);
@@ -5435,6 +5460,9 @@ begin
   Add('  c:=^A;');
   Add('  c:=''"'';');
   Add('  c:=default(char);');
+  Add('  c:=#$00E4;'); // ä
+  Add('  c:=''ä'';');
+  Add('  c:=#$E4;'); // ä
   ConvertProgram;
   CheckSource('TestCharConst',
     LinesToStr([
@@ -5454,8 +5482,11 @@ begin
     '$mod.c="\x0B";',
     '$mod.c="\x01";',
     '$mod.c=''"'';',
-    '$mod.c="\x00";'
-    ]));
+    '$mod.c="\x00";',
+    '$mod.c = "ä";',
+    '$mod.c = "ä";',
+    '$mod.c = "ä";',
+    '']));
 end;
 
 procedure TTestModule.TestChar_Compare;
@@ -12182,6 +12213,51 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_FunctionResultInTypeCast;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TBird = class external name ''Array''',
+  '  end;',
+  'function GetPtr: Pointer;',
+  'begin',
+  'end;',
+  'procedure Write(const p);',
+  'begin',
+  'end;',
+  'procedure WriteLn; varargs;',
+  'begin',
+  'end;',
+  'begin',
+  '  if TBird(GetPtr)=nil then ;',
+  '  Write(GetPtr);',
+  '  WriteLn(GetPtr);',
+  '  Write(TBird(GetPtr));',
+  '  WriteLn(TBird(GetPtr));',
+  '']);
+  ConvertProgram;
+  CheckSource('TestFunctionResultInTypeCast',
+    LinesToStr([ // statements
+    'this.GetPtr = function () {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.Write = function (p) {',
+    '};',
+    'this.WriteLn = function () {',
+    '};',
+    '']),
+    LinesToStr([
+    'if ($mod.GetPtr() === null) ;',
+    '$mod.Write($mod.GetPtr());',
+    '$mod.WriteLn($mod.GetPtr());',
+    '$mod.Write($mod.GetPtr());',
+    '$mod.WriteLn($mod.GetPtr());',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_NonExternalOverride;
 begin
   StartProgram(false);