paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 22:09:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: typecast function result

Browse Source 
git-svn-id: trunk@35810 -
This commit is contained in:
Mattias Gaertner 2017-04-16 19:31:09 +00:00
parent 9e57c2f5d2
commit a4ffecf988
2 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/fcl-passrc/src/pasresolver.pp
View File

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

11
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -311,6 +311,7 @@ type
Procedure TestProc_Varargs; Procedure TestProc_Varargs;
Procedure TestProc_ParameterExprAccess; Procedure TestProc_ParameterExprAccess;
Procedure TestProc_FunctionResult_DeclProc; Procedure TestProc_FunctionResult_DeclProc;
Procedure TestProc_TypeCastFunctionResult;
// ToDo: fail builtin functions in constant with non const param // ToDo: fail builtin functions in constant with non const param
// record // record
@ -4266,6 +4267,16 @@ begin
end; end;
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; procedure TTestResolver.TestRecord;
begin begin
StartProgram(false); StartProgram(false);