paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-10 09:20:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed parsing case statement without semicolon before else, added comments

Browse Source 
git-svn-id: trunk@45432 -
This commit is contained in:
Mattias Gaertner 2020-05-19 12:42:25 +00:00
parent a2342c710e
commit 23e7ced100
4 changed files with 153 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -453,7 +453,7 @@ type
procedure ParseInitialization; procedure ParseInitialization;
procedure ParseFinalization; procedure ParseFinalization;
procedure ParseDeclarations(Declarations: TPasDeclarations); procedure ParseDeclarations(Declarations: TPasDeclarations);
procedure ParseStatement(Parent: TPasImplBlock; out NewImplElement: TPasImplElement); procedure ParseStatement(Parent: TPasImplBlock; out NewImplElement: TPasImplElement);
procedure ParseLabels(AParent: TPasElement); procedure ParseLabels(AParent: TPasElement);
procedure ParseProcBeginBlock(Parent: TProcedureBody); procedure ParseProcBeginBlock(Parent: TProcedureBody);
procedure ParseProcAsmBlock(Parent: TProcedureBody); procedure ParseProcAsmBlock(Parent: TProcedureBody);
@ -5809,7 +5809,7 @@ var
begin begin
if CurBlock=Parent then exit(true); if CurBlock=Parent then exit(true);
while CurBlock.CloseOnSemicolon while CurBlock.CloseOnSemicolon
or (CloseIfs and (CurBlock is TPasImplIfElse)) do or (CloseIfs and (CurBlock is TPasImplIfElse)) do
if CloseBlock then exit(true); if CloseBlock then exit(true);
Result:=false; Result:=false;
end; end;
@ -5821,19 +5821,20 @@ var
if NewImplElement=nil then NewImplElement:=CurBlock; if NewImplElement=nil then NewImplElement:=CurBlock;
end; end;
procedure CheckSemicolon; procedure CheckStatementCanStart;
var var
t: TToken; t: TToken;
begin begin
if (CurBlock.Elements.Count=0) then exit; if (CurBlock.Elements.Count=0) then
exit; // at start of block
t:=GetPrevToken; t:=GetPrevToken;
if t in [tkSemicolon,tkColon] then case t of
exit; tkSemicolon,tkColon,tkElse: exit;
if (CurBlock.ClassType=TPasImplIfElse) and (t=tkelse) then end;
exit;
{$IFDEF VerbosePasParser} {$IFDEF VerbosePasParser}
writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName); writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName);
{$ENDIF} {$ENDIF}
// last statement not complete -> semicolon is missing
ParseExcTokenError('Semicolon'); ParseExcTokenError('Semicolon');
end; end;
@ -5867,11 +5868,11 @@ begin
while True do while True do
begin begin
NextToken; NextToken;
//WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText); //WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText,' CurBlock=',CurBlock.ClassName);
case CurToken of case CurToken of
tkasm: tkasm:
begin begin
CheckSemicolon; CheckStatementCanStart;
El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock,CurTokenPos)); El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock,CurTokenPos));
ParseAsmBlock(TPasImplAsmStatement(El)); ParseAsmBlock(TPasImplAsmStatement(El));
CurBlock.AddElement(El); CurBlock.AddElement(El);
@ -5882,98 +5883,84 @@ begin
end; end;
tkbegin: tkbegin:
begin begin
CheckSemicolon; CheckStatementCanStart;
El:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock,CurTokenPos)); El:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock,CurTokenPos));
CreateBlock(TPasImplBeginBlock(El)); CreateBlock(TPasImplBeginBlock(El));
El:=nil; El:=nil;
end; end;
tkrepeat: tkrepeat:
begin begin
CheckSemicolon; CheckStatementCanStart;
El:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock,CurTokenPos)); El:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock,CurTokenPos));
CreateBlock(TPasImplRepeatUntil(El)); CreateBlock(TPasImplRepeatUntil(El));
El:=nil; El:=nil;
end; end;
tkIf: tkIf:
begin begin
CheckSemicolon; CheckStatementCanStart;
SrcPos:=CurTokenPos; SrcPos:=CurTokenPos;
NextToken; NextToken;
Left:=DoParseExpression(CurBlock); Left:=DoParseExpression(CurBlock);
UngetToken; UngetToken;
El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock,SrcPos)); El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock,SrcPos));
TPasImplIfElse(El).ConditionExpr:=Left; TPasImplIfElse(El).ConditionExpr:=Left;
Left.Parent:=El; Left.Parent:=El;
Left:=nil; Left:=nil;
//WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText); //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
CreateBlock(TPasImplIfElse(El)); CreateBlock(TPasImplIfElse(El));
El:=nil; El:=nil;
ExpectToken(tkthen); ExpectToken(tkthen);
end; end;
tkelse: tkelse:
if (CurBlock is TPasImplIfElse) then // ELSE can close multiple blocks, similar to semicolon
begin repeat
if TPasImplIfElse(CurBlock).IfBranch=nil then {$IFDEF VerbosePasParser}
begin writeln('TPasParser.ParseStatement CurBlock=',CurBlock.ClassName);
// empty then statement e.g. if condition then else {$ENDIF}
El:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock,CurTokenPos)); if CurBlock is TPasImplIfElse then
CurBlock.AddElement(El); begin
El:=nil; if TPasImplIfElse(CurBlock).IfBranch=nil then
end; begin
if TPasImplIfElse(CurBlock).ElseBranch<>nil then // empty THEN statement e.g. if condition then else
begin El:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock,CurTokenPos));
// this and the following 3 may solve TPasImplIfElse.AddElement BUG CurBlock.AddElement(El); // this sets TPasImplIfElse(CurBlock).IfBranch:=El
// ifs without begin end El:=nil;
// if .. then end;
// if .. then if TPasImplIfElse(CurBlock).ElseBranch=nil then
// else break; // add next statement as ElseBranch
// else end
else if CurBlock is TPasImplTryExcept then
begin
// close TryExcept handler and open an TryExceptElse handler
CloseBlock; CloseBlock;
CloseStatement(false); El:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock,CurTokenPos));
end; TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(El);
end else if (CurBlock is TPasImplCaseStatement) then CurBlock:=TPasImplTryExceptElse(El);
begin El:=nil;
// Case ... else without semicolon in front. break;
UngetToken; end
CloseStatement(False); else if (CurBlock is TPasImplCaseStatement) then
break; begin
end else if (CurBlock is TPasImplWhileDo) then UngetToken;
begin // Note: a TPasImplCaseStatement is parsed by a call of ParseStatement,
// so it must be the top level block
if CurBlock<>Parent then
CheckToken(tkSemicolon);
exit;
end
else if (CurBlock is TPasImplWhileDo)
or (CurBlock is TPasImplForLoop)
or (CurBlock is TPasImplWithDo)
or (CurBlock is TPasImplRaise) then
// simply close block
else
ParseExcSyntaxError;
CloseBlock; CloseBlock;
UngetToken; until false;
end else if (CurBlock is TPasImplForLoop) then
begin
//if .. then for .. do smt else ..
CloseBlock;
UngetToken;
end else if (CurBlock is TPasImplWithDo) then
begin
//if .. then with .. do smt else ..
CloseBlock;
UngetToken;
end else if (CurBlock is TPasImplRaise) then
begin
//if .. then Raise Exception else ..
CloseBlock;
UngetToken;
end else if (CurBlock is TPasImplAsmStatement) then
begin
//if .. then asm end else ..
CloseBlock;
UngetToken;
end else if (CurBlock is TPasImplTryExcept) then
begin
CloseBlock;
El:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock,CurTokenPos));
TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(El);
CurBlock:=TPasImplTryExceptElse(El);
El:=nil;
end else
ParseExcSyntaxError;
tkwhile: tkwhile:
begin begin
// while Condition do // while Condition do
CheckSemicolon; CheckStatementCanStart;
SrcPos:=CurTokenPos; SrcPos:=CurTokenPos;
NextToken; NextToken;
Left:=DoParseExpression(CurBlock); Left:=DoParseExpression(CurBlock);
@ -5989,7 +5976,7 @@ begin
end; end;
tkgoto: tkgoto:
begin begin
CheckSemicolon; CheckStatementCanStart;
NextToken; NextToken;
CurBlock.AddCommand('goto '+curtokenstring); CurBlock.AddCommand('goto '+curtokenstring);
// expecttoken(tkSemiColon); // expecttoken(tkSemiColon);
@ -5998,7 +5985,7 @@ begin
begin begin
// for VarName := StartValue to EndValue do // for VarName := StartValue to EndValue do
// for VarName in Expression do // for VarName in Expression do
CheckSemicolon; CheckStatementCanStart;
El:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock,CurTokenPos)); El:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock,CurTokenPos));
ExpectIdentifier; ExpectIdentifier;
Expr:=CreatePrimitiveExpr(El,pekIdent,CurTokenString); Expr:=CreatePrimitiveExpr(El,pekIdent,CurTokenString);
@ -6051,7 +6038,7 @@ begin
begin begin
// with Expr do // with Expr do
// with Expr, Expr do // with Expr, Expr do
CheckSemicolon; CheckStatementCanStart;
SrcPos:=CurTokenPos; SrcPos:=CurTokenPos;
NextToken; NextToken;
El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos)); El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
@ -6075,7 +6062,7 @@ begin
end; end;
tkcase: tkcase:
begin begin
CheckSemicolon; CheckStatementCanStart;
SrcPos:=CurTokenPos; SrcPos:=CurTokenPos;
NextToken; NextToken;
Left:=DoParseExpression(CurBlock); Left:=DoParseExpression(CurBlock);
@ -6144,15 +6131,14 @@ begin
until Curtoken=tkColon; until Curtoken=tkColon;
// read statement // read statement
ParseStatement(CurBlock,SubBlock); ParseStatement(CurBlock,SubBlock);
// CurToken is now at last token of case-statement
CloseBlock; CloseBlock;
if CurToken<>tkSemicolon then if CurToken<>tkSemicolon then
begin
NextToken; NextToken;
if not (CurToken in [tkSemicolon,tkelse,tkend]) then if not (CurToken in [tkSemicolon,tkelse,tkend]) then
ParseExcTokenError(TokenInfos[tkSemicolon]); ParseExcTokenError(TokenInfos[tkSemicolon]);
if CurToken<>tkSemicolon then if CurToken<>tkSemicolon then
UngetToken; UngetToken;
end;
end; end;
until false; until false;
if CurToken=tkend then if CurToken=tkend then
@ -6163,7 +6149,7 @@ begin
end; end;
tktry: tktry:
begin begin
CheckSemicolon; CheckStatementCanStart;
El:=TPasImplTry(CreateElement(TPasImplTry,'',CurBlock,CurTokenPos)); El:=TPasImplTry(CreateElement(TPasImplTry,'',CurBlock,CurTokenPos));
CreateBlock(TPasImplTry(El)); CreateBlock(TPasImplTry(El));
El:=nil; El:=nil;
@ -6203,7 +6189,7 @@ begin
end; end;
tkraise: tkraise:
begin begin
CheckSemicolon; CheckStatementCanStart;
ImplRaise:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock,CurTokenPos)); ImplRaise:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock,CurTokenPos));
CreateBlock(ImplRaise); CreateBlock(ImplRaise);
NextToken; NextToken;
@ -6223,13 +6209,17 @@ begin
end; end;
tkend: tkend:
begin begin
// Note: ParseStatement should return with CurToken at last token of the statement
if CloseStatement(true) then if CloseStatement(true) then
begin begin
// there was none requiring an END
UngetToken; UngetToken;
break; break;
end; end;
// still a block left
if CurBlock is TPasImplBeginBlock then if CurBlock is TPasImplBeginBlock then
begin begin
// close at END
if CloseBlock then break; // close end if CloseBlock then break; // close end
if CloseStatement(false) then break; if CloseStatement(false) then break;
end else if CurBlock is TPasImplCaseElse then end else if CurBlock is TPasImplCaseElse then
@ -6283,7 +6273,7 @@ begin
// Do not check this here: // Do not check this here:
// if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then // if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
// ParseExc; // ParseExc;
CheckSemicolon; CheckStatementCanStart;
// On is usable as an identifier // On is usable as an identifier
if lowerCase(CurTokenText)='on' then if lowerCase(CurTokenText)='on' then

9
packages/pastojs/src/fppas2js.pp
View File

@ -1238,7 +1238,8 @@ const
po_AsmWhole, po_AsmWhole,
po_ResolveStandardTypes, po_ResolveStandardTypes,
po_ExtConstWithoutExpr, po_ExtConstWithoutExpr,
po_StopOnUnitInterface]; po_StopOnUnitInterface,
po_AsyncProcs];
btAllJSBaseTypes = [ btAllJSBaseTypes = [
btChar, btChar,
@ -4087,7 +4088,8 @@ begin
if (not (pm in [pmVirtual, pmAbstract, pmOverride, if (not (pm in [pmVirtual, pmAbstract, pmOverride,
pmOverload, pmMessage, pmReintroduce, pmOverload, pmMessage, pmReintroduce,
pmInline, pmAssembler, pmPublic, pmInline, pmAssembler, pmPublic,
pmExternal, pmForward])) then pmExternal, pmForward,
pmAsync])) then
RaiseNotYetImplemented(20170208142159,El,'modifier '+ModifierNames[pm]); RaiseNotYetImplemented(20170208142159,El,'modifier '+ModifierNames[pm]);
for ptm in Proc.ProcType.Modifiers do for ptm in Proc.ProcType.Modifiers do
if (not (ptm in [ptmOfObject,ptmVarargs,ptmStatic])) then if (not (ptm in [ptmOfObject,ptmVarargs,ptmStatic])) then
@ -4234,7 +4236,7 @@ begin
RaiseMsg(20170227095454,nMissingExternalName,sMissingExternalName, RaiseMsg(20170227095454,nMissingExternalName,sMissingExternalName,
['missing external name'],Proc); ['missing external name'],Proc);
for pm in [pmAssembler,pmForward,pmNoReturn,pmInline] do for pm in [pmAssembler,pmForward,pmNoReturn,pmInline,pmAsync] do
if pm in Proc.Modifiers then if pm in Proc.Modifiers then
RaiseMsg(20170323100842,nInvalidXModifierY,sInvalidXModifierY, RaiseMsg(20170323100842,nInvalidXModifierY,sInvalidXModifierY,
[Proc.ElementTypeName,ModifierNames[pm]],Proc); [Proc.ElementTypeName,ModifierNames[pm]],Proc);
@ -15052,6 +15054,7 @@ begin
FS:=CreateFunctionSt(ImplProc,ImplProc.Body<>nil); FS:=CreateFunctionSt(ImplProc,ImplProc.Body<>nil);
FD:=FS.AFunction; FD:=FS.AFunction;
FD.IsAsync:=El.IsAsync or ImplProc.IsAsync;
if AssignSt<>nil then if AssignSt<>nil then
AssignSt.Expr:=FS AssignSt.Expr:=FS
else else

6
packages/pastojs/src/pas2jsfiler.pp
View File

@ -132,7 +132,8 @@ const
'StopOnErrorDirective', 'StopOnErrorDirective',
'ExtClassConstWithoutExpr', 'ExtClassConstWithoutExpr',
'StopOnUnitInterface', 'StopOnUnitInterface',
'IgnoreUnknownResource'); 'IgnoreUnknownResource',
'AsyncProcs');
PCUDefaultModeSwitches: TModeSwitches = [ PCUDefaultModeSwitches: TModeSwitches = [
msObjfpc, msObjfpc,
@ -486,7 +487,8 @@ const
'DispId', 'DispId',
'NoReturn', 'NoReturn',
'Far', 'Far',
'Final' 'Final',
'Async'
); );
PCUProcedureModifiersImplProc = [pmInline,pmAssembler,pmCompilerProc,pmNoReturn]; PCUProcedureModifiersImplProc = [pmInline,pmAssembler,pmCompilerProc,pmNoReturn];

57
packages/pastojs/tests/tcmodules.pas
View File

@ -340,6 +340,7 @@ type
Procedure TestProc_LocalVarInit; Procedure TestProc_LocalVarInit;
Procedure TestProc_ReservedWords; Procedure TestProc_ReservedWords;
Procedure TestProc_ConstRefWord; Procedure TestProc_ConstRefWord;
Procedure TestProc_Async;
// anonymous functions // anonymous functions
Procedure TestAnonymousProc_Assign_ObjFPC; Procedure TestAnonymousProc_Assign_ObjFPC;
@ -352,6 +353,7 @@ type
Procedure TestAnonymousProc_NestedAssignResult; Procedure TestAnonymousProc_NestedAssignResult;
Procedure TestAnonymousProc_Class; Procedure TestAnonymousProc_Class;
Procedure TestAnonymousProc_ForLoop; Procedure TestAnonymousProc_ForLoop;
Procedure TestAnonymousProc_Async;
// enums, sets // enums, sets
Procedure TestEnum_Name; Procedure TestEnum_Name;
@ -4604,6 +4606,32 @@ begin
])); ]));
end; end;
procedure TTestModule.TestProc_Async;
begin
StartProgram(false);
Add([
'procedure Fly(w: word); async; forward;',
'procedure Run(w: word); async;',
'begin',
'end;',
'procedure Fly(w: word); ',
'begin',
'end;',
'begin',
' Run(1);']);
ConvertProgram;
CheckSource('TestProc_Async',
LinesToStr([ // statements
'this.Run = async function (w) {',
'};',
'this.Fly = async function (w) {',
'};',
'']),
LinesToStr([
'$mod.Run(1);'
]));
end;
procedure TTestModule.TestAnonymousProc_Assign_ObjFPC; procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
begin begin
StartProgram(false); StartProgram(false);
@ -5083,6 +5111,35 @@ begin
])); ]));
end; end;
procedure TTestModule.TestAnonymousProc_Async;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TFunc = reference to function(x: word): word;',
'var Func: TFunc;',
'begin',
' Func:=function(c:word):word async begin',
' end;',
' Func:=function(c:word):word async assembler asm',
' end;',
' ']);
ConvertProgram;
CheckSource('TestAnonymousProc_Async',
LinesToStr([ // statements
'this.Func = null;',
'']),
LinesToStr([
'$mod.Func = async function (c) {',
' var Result = 0;',
' return Result;',
'};',
'$mod.Func = async function (c) {',
'};',
'']));
end;
procedure TTestModule.TestEnum_Name; procedure TTestModule.TestEnum_Name;
begin begin
StartProgram(false); StartProgram(false);