Browse Source

fcl-passrc: typecast function result

git-svn-id: trunk@35810 -
Mattias Gaertner 8 years ago
parent
commit
a4ffecf988
2 changed files with 14 additions and 3 deletions
  1. 3 3
      packages/fcl-passrc/src/pasresolver.pp
  2. 11 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 3 - 3
packages/fcl-passrc/src/pasresolver.pp

@@ -10207,8 +10207,8 @@ begin
     exit(cIncompatible);
     end;
   Param:=Params.Params[0];
-  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
-  ComputeElement(El,ResolvedEl,[rcNoImplicitProc]);
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
+  ComputeElement(El,ResolvedEl,[rcType]);
   Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
 end;
 
@@ -10444,7 +10444,7 @@ begin
   if Result=cIncompatible then
     begin
     {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.CheckTypeCastRes From=',GetResolverResultDesc(FromResolved),' To=',GetResolverResultDesc(ToResolved));
+    writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
     {$ENDIF}
     if RaiseOnError then
       RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,

+ 11 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -311,6 +311,7 @@ type
     Procedure TestProc_Varargs;
     Procedure TestProc_ParameterExprAccess;
     Procedure TestProc_FunctionResult_DeclProc;
+    Procedure TestProc_TypeCastFunctionResult;
     // ToDo: fail builtin functions in constant with non const param
 
     // record
@@ -4266,6 +4267,16 @@ begin
     end;
 end;
 
+procedure TTestResolver.TestProc_TypeCastFunctionResult;
+begin
+  StartProgram(false);
+  Add('function GetIt: longint; begin end;');
+  Add('var s: smallint;');
+  Add('begin');
+  Add('   s:=smallint(GetIt);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);