undo

git-svn-id: trunk@45433 -

packages/fcl-passrc/src/pparser.pp

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

packages/pastojs/src/fppas2js.pp

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

packages/pastojs/src/pas2jsfiler.pp

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

packages/pastojs/tests/tcmodules.pas

@@ -340,7 +340,6 @@ type
     Procedure TestProc_LocalVarInit;
     Procedure TestProc_ReservedWords;
     Procedure TestProc_ConstRefWord;
-    Procedure TestProc_Async;
 
     // anonymous functions
     Procedure TestAnonymousProc_Assign_ObjFPC;
@@ -353,7 +352,6 @@ type
     Procedure TestAnonymousProc_NestedAssignResult;
     Procedure TestAnonymousProc_Class;
     Procedure TestAnonymousProc_ForLoop;
-    Procedure TestAnonymousProc_Async;
 
     // enums, sets
     Procedure TestEnum_Name;
@@ -4606,32 +4604,6 @@ begin
     ]));
 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;
 begin
   StartProgram(false);
@@ -5111,35 +5083,6 @@ begin
     ]));
 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;
 begin
   StartProgram(false);