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

* Fix bug ID #31671

Browse Source 
git-svn-id: trunk@35884 -
This commit is contained in:
michael 2017-04-22 08:48:05 +00:00
parent 21f1fd04e1
commit 1f3e7442c1
2 changed files with 45 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -327,7 +327,9 @@ type
procedure NextToken; // read next non whitespace, non space
procedure UngetToken;
procedure CheckToken(tk: TToken);
procedure CheckTokens(tk: TTokens);
procedure ExpectToken(tk: TToken);
procedure ExpectTokens(tk: TTokens);
function ExpectIdentifier: String;
Function CurTokenIsIdentifier(Const S : String) : Boolean;
// Expression parsing
@ -895,6 +897,30 @@ begin
end;
end;
procedure TPasParser.CheckTokens(tk: TTokens);
Var
S : String;
T : TToken;
begin
if not (CurToken in tk) then
begin
{$IFDEF VerbosePasParser}
writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
{$ENDIF}
S:='';
For T in TToken do
if t in tk then
begin
if (S<>'') then
S:=S+' or ';
S:=S+TokenInfos[t];
end;
ParseExcTokenError(S);
end;
end;
procedure TPasParser.ExpectToken(tk: TToken);
begin
@ -902,6 +928,12 @@ begin
CheckToken(tk);
end;
procedure TPasParser.ExpectTokens(tk: TTokens);
begin
NextToken;
CheckTokens(tk);
end;
function TPasParser.ExpectIdentifier: String;
begin
ExpectToken(tkIdentifier);
@ -3743,9 +3775,10 @@ begin
ModCount:=0;
Repeat
inc(ModCount);
// Writeln(modcount, curtokentext);
LastToken:=CurToken;
NextToken;
if (ModCount=1) and (CurToken = tkEqual) then
if (ModCount in [1,2,3]) and (CurToken = tkEqual) then
begin
// for example: const p: procedure = nil;
UngetToken;
@ -3773,7 +3806,9 @@ begin
NextToken; // remove offset
end;
end;
ExpectToken(tkSemicolon);
ExpectTokens([tkSemicolon,tkEqual]);
if curtoken=tkEqual then
ungettoken;
end
else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
HandleProcedureModifier(Parent,PM)
@ -3823,6 +3858,7 @@ begin
// DumpCurToken('Done '+IntToStr(Ord(Done)));
UngetToken;
end;
// Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
Until Done;
if DoCheckHint then // deprecated,platform,experimental,library, unimplemented etc

7
packages/fcl-passrc/tests/tcvarparser.pas
View File

@ -34,6 +34,7 @@ Type
procedure TestSimpleVarInitializedDeprecated;
procedure TestSimpleVarInitializedPlatform;
Procedure TestVarProcedure;
Procedure TestVarFunctionINitialized;
Procedure TestVarProcedureDeprecated;
Procedure TestVarRecord;
Procedure TestVarRecordDeprecated;
@ -187,6 +188,12 @@ begin
AssertVariableType(TPasProcedureType);
end;
procedure TTestVarParser.TestVarFunctionINitialized;
begin
ParseVar('function (device: pointer): pointer; cdecl = nil','');
AssertVariableType(TPasFunctionType);
end;
procedure TTestVarParser.TestVarProcedureDeprecated;
begin
ParseVar('procedure','deprecated');