fcl-passrc: error if semicolon is missing between block statements, fixed parsing finalization

git-svn-id: trunk@37114 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1325,6 +1325,8 @@ type
     function CheckAssignCompatibility(const LHS, RHS: TPasElement;
       RaiseOnIncompatible: boolean = true): integer;
     procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
+    procedure CheckAssignExprRangeToCustom(const LeftResolved: TPasResolverResult;
+      RValue: TResEvalValue; RHS: TPasExpr); virtual;
     function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
       ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
     function CheckEqualElCompatibility(Left, Right: TPasElement;
@@ -10939,7 +10941,9 @@ begin
   {$ENDIF}
   RangeValue:=nil;
   try
-    if LeftResolved.BaseType=btSet then
+    if LeftResolved.BaseType=btCustom then
+      CheckAssignExprRangeToCustom(LeftResolved,RValue,RHS)
+    else if LeftResolved.BaseType=btSet then
       begin
       // assign to a set
       C:=LeftResolved.TypeEl.ClassType;
@@ -11011,7 +11015,9 @@ begin
           end
         else
           begin
-          writeln('AAA1 TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<MaxPrecFloat(low(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>MaxPrecFloat(high(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(MaxPrecInt));
+          {$IFDEF VerbosePasResEval}
+          writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<MaxPrecFloat(low(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>MaxPrecFloat(high(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(MaxPrecInt));
+          {$ENDIF}
           RaiseRangeCheck(20170802133750,RHS);
           end;
       else
@@ -11082,6 +11088,14 @@ begin
   end;
 end;
 
+procedure TPasResolver.CheckAssignExprRangeToCustom(
+  const LeftResolved: TPasResolverResult; RValue: TResEvalValue; RHS: TPasExpr);
+begin
+  if LeftResolved.BaseType<>btCustom then exit;
+  if RValue=nil then exit;
+  if RHS=nil then ;
+end;
+
 function TPasResolver.CheckAssignResCompatibility(const LHS,
   RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
   ): integer;

packages/fcl-passrc/src/pparser.pp

@@ -350,6 +350,7 @@ type
     procedure CheckTokens(tk: TTokens);
     procedure ExpectToken(tk: TToken);
     procedure ExpectTokens(tk:  TTokens);
+    function GetPrevToken: TToken;
     function ExpectIdentifier: String;
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
     // Expression parsing
@@ -1047,6 +1048,22 @@ begin
   CheckTokens(tk);
 end;
 
+function TPasParser.GetPrevToken: TToken;
+var
+  i: Integer;
+  P: PTokenRec;
+begin
+  if FTokenRingStart = FTokenRingEnd then
+    Result:=tkEOF;
+  i:=FTokenRingCur;
+  if i>0 then
+    dec(i)
+  else
+    i:=High(FTokenRing);
+  P:=@FTokenRing[i];
+  Result := P^.Token;
+end;
+
 function TPasParser.ExpectIdentifier: String;
 begin
   ExpectToken(tkIdentifier);
@@ -1058,7 +1075,6 @@ begin
   Result:=(Curtoken=tkIdentifier) and (CompareText(S,CurtokenText)=0);
 end;
 
-
 function TPasParser.IsCurTokenHint(out AHint: TPasMemberHint): Boolean;
 begin
   Result:=CurToken=tklibrary;
@@ -2811,7 +2827,6 @@ begin
         ExpectToken(tkend);
     end;
   until false;
-  UngetToken;
 end;
 
 function TPasParser.GetProcTypeFromToken(tk: TToken; IsClass: Boolean
@@ -4742,9 +4757,28 @@ var
     if NewImplElement=nil then NewImplElement:=CurBlock;
   end;
 
+  procedure CheckSemicolon;
+  begin
+    if (CurBlock.Elements.Count>0) and not (GetPrevToken in [tkSemicolon,tkColon])
+        and (CurBlock.ClassType<>TPasImplIfElse) then
+      begin
+      writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName);
+      ParseExcTokenError('Semicolon');
+      end;
+  end;
+
 var
-  SubBlock: TPasImplElement;
   CmdElem: TPasImplElement;
+
+  procedure AddStatement(El: TPasImplElement);
+  begin
+    CurBlock.AddElement(El);
+    CmdElem:=El;
+    UngetToken;
+  end;
+
+var
+  SubBlock: TPasImplElement;
   left, right: TPasExpr;
   El : TPasImplElement;
   ak : TAssignKind;
@@ -4764,6 +4798,7 @@ begin
     case CurToken of
     tkasm:
       begin
+      CheckSemicolon;
       El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
       ParseAsmBlock(TPasImplAsmStatement(El));
       CurBlock.AddElement(El);
@@ -4773,16 +4808,19 @@ begin
       end;
     tkbegin:
       begin
+      CheckSemicolon;
       El:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock));
       CreateBlock(TPasImplBeginBlock(El));
       end;
     tkrepeat:
       begin
+      CheckSemicolon;
       El:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock));
       CreateBlock(TPasImplRepeatUntil(El));
       end;
     tkIf:
       begin
+        CheckSemicolon;
         NextToken;
         Left:=DoParseExpression(CurBlock);
         UngetToken;
@@ -4853,6 +4891,7 @@ begin
     tkwhile:
       begin
         // while Condition do
+        CheckSemicolon;
         NextToken;
         left:=DoParseExpression(CurBlock);
         UngetToken;
@@ -4864,14 +4903,16 @@ begin
       end;
     tkgoto:
       begin
-        NextToken;
-        curblock.AddCommand('goto '+curtokenstring);
-        // expecttoken(tkSemiColon);
+      CheckSemicolon;
+      NextToken;
+      CurBlock.AddCommand('goto '+curtokenstring);
+      // expecttoken(tkSemiColon);
       end;
     tkfor:
       begin
         // for VarName := StartValue to EndValue do
         // for VarName in Expression do
+        CheckSemicolon;
         El:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
         ok:=false;
         Try
@@ -4928,6 +4969,7 @@ begin
       begin
         // with Expr do
         // with Expr, Expr do
+        CheckSemicolon;
         SrcPos:=CurSourcePos;
         NextToken;
         Left:=DoParseExpression(CurBlock);
@@ -4948,6 +4990,7 @@ begin
       end;
     tkcase:
       begin
+        CheckSemicolon;
         NextToken;
         Left:=DoParseExpression(CurBlock);
         UngetToken;
@@ -5025,6 +5068,7 @@ begin
       end;
     tktry:
       begin
+      CheckSemicolon;
       El:=TPasImplTry(CreateElement(TPasImplTry,'',CurBlock));
       CreateBlock(TPasImplTry(El));
       end;
@@ -5061,6 +5105,7 @@ begin
       end;
     tkraise:
       begin
+      CheckSemicolon;
       El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
       CreateBlock(TPasImplRaise(El));
       NextToken;
@@ -5105,7 +5150,11 @@ begin
     tkSemiColon:
       if CloseStatement(true) then break;
     tkFinalization:
-      if CloseStatement(true) then break;
+      if CloseStatement(true) then
+        begin
+        UngetToken;
+        break;
+        end;
     tkuntil:
       begin
         if CloseStatement(true) then
@@ -5131,6 +5180,7 @@ begin
       // Do not check this here:
       //      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
       //        ParseExc;
+      CheckSemicolon;
 
       // On is usable as an identifier
       if lowerCase(CurTokenText)='on' then
@@ -5189,9 +5239,7 @@ begin
             TPasImplAssign(El).left:=Left;
             TPasImplAssign(El).right:=Right;
             TPasImplAssign(El).Kind:=ak;
-            CurBlock.AddElement(El);
-            CmdElem:=TPasImplAssign(El);
-            UngetToken;
+            AddStatement(El);
           end;
           tkColon:
           begin
@@ -5208,9 +5256,7 @@ begin
           // simple statement (function call)
           El:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
           TPasImplSimple(El).expr:=Left;
-          CurBlock.AddElement(El);
-          CmdElem:=TPasImplSimple(El);
-          UngetToken;
+          AddStatement(El);
         end;
 
         if not (CmdElem is TPasImplLabelMark) then

packages/fcl-passrc/tests/tcresolver.pas

@@ -3783,13 +3783,13 @@ begin
   Add('    {@v1}v1:={@e1}e;');
   Add('  finally');
   Add('    {@v1}v1:={@e1}e;');
-  Add('  end');
+  Add('  end;');
   Add('  try');
   Add('    {@v1}v1:={@e1}e;');
   Add('  except');
   Add('    {@v1}v1:={@e1}e;');
   Add('    raise;');
-  Add('  end');
+  Add('  end;');
   Add('  try');
   Add('    {@v1}v1:={@e1}e;');
   Add('  except');
@@ -3799,7 +3799,7 @@ begin
   Add('      raise {@e3}e;');
   Add('    else');
   Add('      {@v1}v1:={@e1}e;');
-  Add('  end');
+  Add('  end;');
   ParseProgram;
 end;
 
@@ -4665,8 +4665,8 @@ begin
   Add('  {#A}{=TA}A: TClassA;');
   Add('  {#B}{=TB}B: TClassB;');
   Add('begin');
-  Add('  {@DoA}DoIt({@A}A)');
-  Add('  {@DoB}DoIt({@B}B)');
+  Add('  {@DoA}DoIt({@A}A);');
+  Add('  {@DoB}DoIt({@B}B);');
   ParseProgram;
 end;
 
@@ -4689,9 +4689,9 @@ begin
   Add('  {#B}{=TB}B: TClassB;');
   Add('  {#C}{=TC}C: TClassC;');
   Add('begin');
-  Add('  {@DoA}DoIt({@A}A)');
-  Add('  {@DoB}DoIt({@B}B)');
-  Add('  {@DoB}DoIt({@C}C)');
+  Add('  {@DoA}DoIt({@A}A);');
+  Add('  {@DoB}DoIt({@B}B);');
+  Add('  {@DoB}DoIt({@C}C);');
   ParseProgram;
 end;
 
@@ -4714,9 +4714,9 @@ begin
   Add('  {#B}{=TB}B: TClassB;');
   Add('  {#C}{=TC}C: TClassC;');
   Add('begin');
-  Add('  {@DoA}DoIt({@A}A)');
-  Add('  {@DoA}DoIt({@B}B)');
-  Add('  {@DoC}DoIt({@C}C)');
+  Add('  {@DoA}DoIt({@A}A);');
+  Add('  {@DoA}DoIt({@B}B);');
+  Add('  {@DoC}DoIt({@C}C);');
   ParseProgram;
 end;
 
@@ -9077,7 +9077,7 @@ begin
   Add('end;');
   Add('var o: TObject;');
   Add('begin');
-  Add('  o.OnClick:[email protected]');
+  Add('  o.OnClick:[email protected];');
   Add('  o.OnClick(nil);');
   Add('  o.OnClick(o);');
   Add('  o.SetOnClick(@o.Notify);');
@@ -9804,7 +9804,7 @@ begin
   Add('procedure TControl.Click(Sender: TObject);');
   Add('begin');
   Add('  if Assigned(OnClick) then ;');
-  Add('  OnClick:=@Click');
+  Add('  OnClick:=@Click;');
   Add('  OnClick(Sender);');
   Add('  Self.OnClick(Sender);');
   Add('  with Self do OnClick(Sender);');
@@ -9956,7 +9956,7 @@ begin
   Add('  p:=a;');
   Add('  p:=Pointer(f);');
   Add('  p:=@DoIt;');
-  Add('  p:=Pointer(@DoIt)');
+  Add('  p:=Pointer(@DoIt);');
   Add('  obj:=TObject(p);');
   Add('  cl:=TClass(p);');
   Add('  a:=TArrInt(p);');

packages/fcl-passrc/tests/tcstatements.pas

@@ -44,6 +44,7 @@ Type
     Procedure TestAssignmentMinus;
     Procedure TestAssignmentMul;
     Procedure TestAssignmentDivision;
+    Procedure TestAssignmentMissingSemicolonError;
     Procedure TestCall;
     Procedure TestCallComment;
     Procedure TestCallQualified;
@@ -119,9 +120,9 @@ Type
     procedure AssignToAddress;
     procedure FinalizationNoSemicolon;
     procedure MacroComment;
-    Procedure PLatformIdentifier;
-    Procedure PLatformIdentifier2;
-    Procedure Onidentifier;
+    Procedure PlatformIdentifier;
+    Procedure PlatformIdentifier2;
+    Procedure OnIdentifier;
   end;
 
 
@@ -353,6 +354,12 @@ begin
   AssertExpression('Left side is variable',A.Left,pekIdent,'a');
 end;
 
+procedure TTestStatementParser.TestAssignmentMissingSemicolonError;
+begin
+  DeclareVar('integer');
+  ExpectParserError('Semicolon expected, but "a" found',['a:=1','a:=2']);
+end;
+
 procedure TTestStatementParser.TestCall;
 
 Var
@@ -1702,7 +1709,7 @@ begin
   ParseModule;
 end;
 
-Procedure TTestStatementParser.AssignToAddress;
+procedure TTestStatementParser.AssignToAddress;
 
 begin
   AddStatements(['@Proc:=Nil']);
@@ -1718,7 +1725,7 @@ begin
   Source.Add('initialization');
   Source.Add('  writeln(''qqq'')');
   Source.Add('finalization');
-  Source.Add('  writeln(''qqq'')');
+  Source.Add('  write(''rrr'')');
   ParseModule;
 end;
 
@@ -1733,19 +1740,19 @@ begin
   ParseModule;
 end;
 
-procedure TTestStatementParser.PLatformIdentifier;
+procedure TTestStatementParser.PlatformIdentifier;
 begin
   AddStatements(['write(platform);']);
   ParseModule;
 end;
 
-procedure TTestStatementParser.PLatformIdentifier2;
+procedure TTestStatementParser.PlatformIdentifier2;
 begin
   AddStatements(['write(libs+platform);']);
   ParseModule;
 end;
 
-procedure TTestStatementParser.Onidentifier;
+procedure TTestStatementParser.OnIdentifier;
 begin
   Source.Add('function TryOn(const on: boolean): boolean;');
   Source.Add('  begin');
@@ -1755,7 +1762,7 @@ begin
   ParseModule;
 end;
 
-Procedure TTestStatementParser.TestGotoInIfThen;
+procedure TTestStatementParser.TestGotoInIfThen;
 
 begin
   AddStatements(['if expr then',

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -580,7 +580,7 @@ begin
   Add('  {#i_used}i: TArrayInt;');
   Add('begin');
   Add('  a[b]:=c[d];');
-  Add('  SetLength(e,f)');
+  Add('  SetLength(e,f);');
   Add('  if low(g)=high(h)+length(i) then');
   Add('end;');
   Add('begin');