JCF2: committed a file, forgotten in r65340 #8644ddb16b, bug #39132

git-svn-id: trunk@65343 -

.gitattributes

@@ -2422,6 +2422,7 @@ components/jcf2/Process/Warnings/WarnAssignToFunctionName.pas svneol=native#text
 components/jcf2/Process/Warnings/WarnCaseNoElse.pas svneol=native#text/pascal
 components/jcf2/Process/Warnings/WarnDestroy.pas svneol=native#text/pascal
 components/jcf2/Process/Warnings/WarnEmptyBlock.pas svneol=native#text/pascal
+components/jcf2/Process/Warnings/WarnImbalancedComment.pas svneol=native#text/pascal
 components/jcf2/Process/Warnings/WarnRealType.pas svneol=native#text/pascal
 components/jcf2/Process/Warnings/WarnUnusedParam.pas svneol=native#text/pascal
 components/jcf2/Process/Warnings/Warning.pas svneol=native#text/pascal

components/jcf2/Process/Warnings/WarnImbalancedComment.pas

@@ -0,0 +1,206 @@
+unit WarnImbalancedComment;
+
+{(*}
+(*------------------------------------------------------------------------------
+ Delphi Code formatter source code 
+
+The Original Code is ImbalancedCommentAction, released Jun 2021.
+The Initial Developer of the Original Code is Udo Sommer.
+Portions created by Udo Sommer are Copyright (C) 2021 Udo Sommer.
+All Rights Reserved. 
+Contributor(s): Udo Sommer.
+
+The contents of this file are subject to the Mozilla Public License Version 1.1
+(the "License"). you may not use this file except in compliance with the License.
+You may obtain a copy of the License at http://www.mozilla.org/NPL/
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either express or implied.
+See the License for the specific language governing rights and limitations 
+under the License.
+
+Alternatively, the contents of this file may be used under the terms of
+the GNU General Public License Version 2 or later (the "GPL") 
+See http://www.gnu.org/licenses/gpl.html
+------------------------------------------------------------------------------*)
+{*)}
+
+{$I JcfGlobal.inc}
+
+interface
+
+uses
+  Warning, ConvertTypes;
+
+type
+  { TImbalancedCommentAction }
+
+  TWarnImbalancedComment = class(TWarning)
+  private
+    procedure SendWarning(const AError: TObject);
+  protected
+    function IsCurlyBreaketCommentBalanced(const pcNode: TObject): Boolean; virtual;
+    function IsBreaketStarCommentBalanced(const pcNode: TObject): Boolean; virtual;
+    procedure AssertCurlyBreaketCommentBalanced(const pcNode: TObject); virtual;
+    procedure AssertBreaketStarCommentBalanced(const pcNode: TObject); virtual;
+
+    function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override;
+  public
+    constructor Create; override;
+
+    function IsIncludedInSettings: boolean; override;
+
+    property OnWarning;
+  end;
+
+
+implementation
+
+uses
+  SysUtils,
+  //
+  SourceToken,
+  ParseError,
+  Tokens,
+  SetComments,
+  JcfSettings
+  //
+  ;
+
+
+constructor TWarnImbalancedComment.Create;
+begin
+  inherited;
+end;
+
+function TWarnImbalancedComment.IsCurlyBreaketCommentBalanced(const pcNode: TObject): Boolean;
+var
+  lcSourceToken: TSourceToken;
+  iBalance: Integer;
+  idx: Integer;
+  cnt: Integer;
+begin
+  Result := True;
+  lcSourceToken := pcNode as TSourceToken;
+
+  iBalance := 0;
+  cnt := Length(lcSourceToken.SourceCode);
+  for idx := 1 to cnt do
+  begin
+    if '{' = lcSourceToken.SourceCode[idx] then
+    begin
+      Inc(iBalance);
+    end else if '}' = lcSourceToken.SourceCode[idx] then
+    begin
+      Dec(iBalance);
+    end;
+  end;
+
+  Result := 0 = iBalance;
+end;
+
+function TWarnImbalancedComment.IsBreaketStarCommentBalanced(const pcNode: TObject): Boolean;
+var
+  lcSourceToken: TSourceToken;
+  iBalance: Integer;
+  idx: Integer;
+  cnt: Integer;
+begin
+  Result := True;
+  lcSourceToken := pcNode as TSourceToken;
+
+  iBalance := 0;
+  cnt := Pred(Length(lcSourceToken.SourceCode));
+  for idx := 1 to cnt do
+  begin
+    if ('(' = lcSourceToken.SourceCode[idx]) and ('*' = lcSourceToken.SourceCode[Succ(idx)]) then
+    begin
+      Inc(iBalance);
+    end else if ('*' = lcSourceToken.SourceCode[idx]) and (')' = lcSourceToken.SourceCode[Succ(idx)]) then
+    begin
+      Dec(iBalance);
+    end;
+  end;
+
+  Result := 0 = iBalance;
+end;
+
+procedure TWarnImbalancedComment.AssertCurlyBreaketCommentBalanced(const pcNode: TObject);
+begin
+  if not IsCurlyBreaketCommentBalanced(pcNode) then
+  begin
+    raise TEParseError.Create('Imbalanced curly breaket comment!', pcNode as TSourceToken);
+  end;
+end;
+
+procedure TWarnImbalancedComment.AssertBreaketStarCommentBalanced(const pcNode: TObject);
+begin
+  if not IsBreaketStarCommentBalanced(pcNode) then
+  begin
+    raise TEParseError.Create('Imbalanced breaket star comment!', pcNode as TSourceToken);
+  end;
+end;
+
+function TWarnImbalancedComment.EnabledVisitSourceToken(const pcNode: TObject): Boolean;
+var
+  lcSourceToken: TSourceToken;
+begin
+  Result := False;
+  lcSourceToken := TSourceToken(pcNode);
+
+  try
+    case lcSourceToken.CommentStyle of
+      eNotAComment, eDoubleSlash:
+      begin
+        // $ (US): 2021-06-28 10:51:06 $
+        //  Double slash comment can not be imbalanced...
+      end;
+      eCurlyBrace, eCompilerDirective:
+      begin
+        AssertCurlyBreaketCommentBalanced(pcNode);
+      end;
+      eBracketStar:
+      begin
+        AssertBreaketStarCommentBalanced(pcNode);
+      end;
+    else
+      begin
+        // should not be here
+        Assert(False);
+      end;
+    end;
+  except
+    on E: TEParseError do
+    begin
+      if TImbalancedCommentAction.Error = FormattingSettings.Comments.ImbalancedCommentAction then
+      begin
+        raise;
+      end else if TImbalancedCommentAction.Warn = FormattingSettings.Comments.ImbalancedCommentAction then
+      begin
+        SendWarning(E);
+      end;
+    end else
+    begin
+      raise;
+    end;
+  end;
+end;
+
+function TWarnImbalancedComment.IsIncludedInSettings: boolean;
+begin
+  Result := True;
+end;
+
+procedure TWarnImbalancedComment.SendWarning(const AError: TObject);
+var
+  LError: TEPArseError;
+begin
+  LError := AError as TEPArseError;
+  if not Assigned(OnWarning) then
+  begin
+    exit;
+  end;
+  OnWarning(LError.FileName, LError.Message, mtCodeWarning, LError.YPosition, LError.XPosition);
+end;
+
+end.