paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 18:39:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: writestr

Browse Source 
git-svn-id: trunk@39124 -
This commit is contained in:
Mattias Gaertner 2018-05-27 22:00:48 +00:00
parent f077c7d950
commit 164587d798
3 changed files with 72 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -439,6 +439,7 @@ type
bfSucc,
bfStrProc,
bfStrFunc,
bfWriteStr,
bfConcatArray,
bfCopyArray,
bfInsertArray,
@ -471,6 +472,7 @@ const
'Succ',
'Str',
'Str',
'WriteStr',
'Concat',
'Copy',
'Insert',
@ -1466,6 +1468,10 @@ type
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
procedure BI_StrFunc_OnEval({%H-}Proc: TResElDataBuiltInProc;
Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
function BI_WriteStrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
Params: TParamsExpr); virtual;
function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
@ -12635,6 +12641,55 @@ begin
Evaluated:=fExprEvaluator.EvalStrFunc(Params,Flags);
end;
function TPasResolver.BI_WriteStrProc_OnGetCallCompatibility(
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
// check params of built-in procedure 'Str'
var
Params: TParamsExpr;
Param: TPasExpr;
ParamResolved: TPasResolverResult;
i: Integer;
begin
if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
exit(cIncompatible);
Params:=TParamsExpr(Expr);
// first parameter: string variable
Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[]);
Result:=cIncompatible;
if ResolvedElCanBeVarParam(ParamResolved,Expr) then
begin
if ParamResolved.BaseType in btAllStrings then
Result:=cExact;
end;
if Result=cIncompatible then
exit(CheckRaiseTypeArgNo(20180527190304,1,Param,ParamResolved,'string variable',RaiseOnError));
// other parameters: boolean, integer, enum, class instance
for i:=1 to length(Params.Params)-1 do
begin
Param:=Params.Params[i];
ComputeElement(Param,ParamResolved,[]);
Result:=BI_Str_CheckParam(false,Param,ParamResolved,i,RaiseOnError);
if Result=cIncompatible then
exit;
end;
end;
procedure TPasResolver.BI_WriteStrProc_OnFinishParamsExpr(
Proc: TResElDataBuiltInProc; Params: TParamsExpr);
var
P: TPasExprArray;
i: Integer;
begin
if Proc=nil then ;
P:=Params.Params;
FinishCallArgAccess(P[0],rraOutParam);
for i:=0 to length(Params.Params)-1 do
FinishCallArgAccess(P[i],rraRead);
end;
function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
var
@ -14310,6 +14365,10 @@ begin
AddBuiltInProc('Str','function Str(const var): String',
@BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
@BI_StrFunc_OnEval,nil,bfStrFunc);
if bfWriteStr in TheBaseProcs then
AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
@BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
@BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
if bfConcatArray in TheBaseProcs then
AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
@BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,

2
packages/fcl-passrc/src/pparser.pp
View File

@ -2019,7 +2019,7 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
begin
N:=LowerCase(TPrimitiveExpr(P).Value);
// We should actually resolve this to system.NNN
Result:=(N='write') or (N='str') or (N='writeln');
Result:=(N='write') or (N='str') or (N='writeln') or (N='writestr');
end;
end;

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

@ -3537,16 +3537,18 @@ end;
procedure TTestResolver.TestEnum_Str;
begin
StartProgram(false);
Add('type');
Add(' TFlag = (red, green, blue);');
Add('var');
Add(' f: TFlag;');
Add(' i: longint;');
Add(' aString: string;');
Add('begin');
Add(' aString:=str(f);');
Add(' aString:=str(f:3);');
Add(' str(f,aString);');
Add([
'type',
' TFlag = (red, green, blue);',
'var',
' f: TFlag;',
' i: longint;',
' aString: string;',
'begin',
' aString:=str(f);',
' aString:=str(f:3);',
' str(f,aString);',
' writestr(astring,f,i);']);
ParseProgram;
end;