program match;
{non-distructive check for matching () etc.}
{ written by Russell Whitaker, Dec 15, 2004.
  released under the G.P.L.  }
uses GPC;

var
  Srcfile      : text;
  error        : integer;
  LineBuf      : string [ 512 ];
  LineNo       : integer;
  ColumnNo     : integer;

  BraceCount,
  BracketCount,
  CommentACount,
  ParenCount,
  BraceLine,
  BraceCol,
  CommentALine,
  CommentACol,
  BracketLine,
  BracketCol,
  DoubleQLine,
  DoubleQCol,
  SingleQLine,
  SingleQCol,
  ParenLine,
  ParenCol,
  i,j          : integer;
  CommentAFlag : boolean;
  CommentBFlag : boolean;
  LitteralFlag : boolean;
  DoubleQFlag  : boolean;
  SingleQFlag  : boolean;
{----------------------------Litteral section-------------------------}
procedure DoubleQuote;
begin
  if not SingleQflag then
  begin
    DoubleQFlag := not DoubleQFlag;
    LitteralFlag := DoubleQFlag;
    DoubleQLine := LineNo;
    DoubleQCol := i;
  end;
end;

procedure SingleQuote;
begin
  if not DoubleQflag then
  begin
    SingleQFlag := not SingleQFlag;
    LitteralFlag := SingleQFlag;
    SingleQLine := LineNo;
    SingleQCol := i;
  end;
end;

{-----------------------------Comment section-------------------------}

procedure OpenBrace;
begin
  if not CommentAFlag then
  begin
    inc( BraceCount );
    BraceLine := LineNo;
    BraceCol := i;
    CommentBFlag := true;
  end;
end;

procedure CloseBrace;
begin
  if not CommentAFlag then
  begin
    dec( BraceCount );
    if( BraceCount = 0 ) then
       CommentBFlag := false;
    if( BraceCount < 0 ) then
    begin
      writeln('line ', LineNo, ' col ', i, ' unmatched "', '}','"');
      BraceCount := 0;
    end;
  end;
end;

procedure ckStartComment;
begin
  if not CommentBFlag then
  begin
    if( i < length( LineBuf )) and ( LineBuf[ i+1 ] = '*') then
    begin    {it's a start of a comment}
      inc( CommentACount );
      CommentALine := LineNo;
      CommentACol := i;
      CommentAFlag := true;
      inc( i );
    end
    else
    begin    {it's an open paren}
      if not litteralflag then
      begin
        inc( ParenCount );
        ParenLine := LineNo;
        ParenCol := i;
      end;
    end;
  end;
end;

procedure ckEndComment;
begin                                   {1}
  if not CommentBFlag then
  begin                                 {2}
    if( i > 1 ) and then ( LineBuf[ i-1 ] = '*') then
    begin   {it's an end of a comment}  {3}
      dec( CommentACount );
      if( CommentACount = 0 ) then
         CommentAFlag := false;
      if( CommentACount < 0 ) then
      begin                             {4}
        writeln('line ', LineNo, ' col ', i, ' unmatched "*)"');
        CommentACount := 0;
      end;                              {4}
    end                                 {3}
    else
    begin  {it's a close paren}         {3}
      if( not CommentAFlag ) and ( not CommentBFlag ) then
      begin                             {4}
        if litteralflag and ( ParenCount > 0 ) then
        begin                           {5}
          if DoubleQFlag then
          begin                         {6}
            writeln('line ', DoubleQLine,' inside ( ) unmatched ', '"');
            DoubleQFlag := false;
            litteralflag := false;
          end;                          {6}
          if SingleQFlag then
          begin                         {6}
            writeln('line ', SingleQLine,' inside ( ) unmatched "', "'", '"');
            SingleQFlag := false;
            litteralflag := false;
          end;                          {6}
        end;                            {5}
        if not litteralflag then
        begin                           {5}
          dec( ParenCount );
          if( ParenCount < 0 ) then
          begin                         {6}
            writeln('line ', LineNo, ' col ', i, ' unmatched ")"');
            ParenCount := 0;
          end;                          {6}
        end;                            {5}
      end;                              {4}
    end;                                {3}
  end;                                  {2}
end;                                    {1}

{------------------------------Misc section---------------------------}
procedure OpenBracket;
begin
  if not litteralflag then
  begin
    inc( BracketCount );
    BracketLine := LineNo;
    BracketCol := i;
  end;
end;

procedure CloseBracket;
begin
  if not litteralflag then
    dec( BracketCount );
  if( BracketCount < 0 ) then
  begin
    writeln('line ', LineNo, ' col ', i, ' unmatched "]"');
    BracketCount := 0;
  end;
end;

procedure Cleanup;
begin
  if( BracketCount > 0 ) then
  begin
    writeln('line ', BracketLine, ' col ', BracketCol,
            ' unmatched "[" count = ', BracketCount );
    BracketCount := 0;
  end;
  if( ParenCount > 0 ) then
  begin
    writeln('line ', ParenLine, ' col ', ParenCol,
            ' unmatched "(" count = ', ParenCount );
    ParenCount := 0;
  end;
end;

procedure Wrapup;
begin
  writeln("Scan completed");
  if( BraceCount > 0 ) then
    writeln('line ', BraceLine, ' col ', BraceCol,
            ' unmatched "{" count = ', BraceCount );
  if( CommentACount > 0 ) then
    writeln('line ', CommentALine, ' col ', CommentACol,
            ' unmatched "(*" count = ', CommentACount );
  if( BracketCount > 0 ) then
    writeln('line ', BracketLine, ' col ', BracketCol,
            ' unmatched "[" count = ', CommentACount );
  if( ParenCount > 0 ) then
    writeln('line ', ParenLine, ' col ', ParenCol,
            ' unmatched "(" count = ', ParenCount );
  if DoubleQFlag then
    writeln('line ', DoubleQLine, ' col ', DoubleQCol, ' Open DoubleQuote' );
  if SingleQFlag then
    writeln('line ', SingleQLine, ' col ', SingleQCol, ' Open SingleQuote' );
end;
 
{-----------------------------main------------------------------------}

begin                                   {0}
  if paramcount = 0 then
  begin                                 {1}
    writeln("  Useage: match <filename>");
    writeln("  Checks file for match (* *), { }, [ ], ( ), ", '"', ", and '.");
  end                                   {1}
  else
  begin                                 {1}
    assign( SrcFile, paramstr( 1 ));
    {$I-}
    reset( SrcFile );
    {$I+}
    error := ioresult;
    if error <> 0 then
      writeln("Unable to open source file")
    else
    begin                               {2}
      while( not eof( SrcFile )) do
      begin                             {3}
        readln( SrcFile, LineBuf );
        if( ParenCount > 0 ) then
        begin                           {4}
          if DoubleQFlag then
          begin                         {5}
            writeln("line ", LineNo, " Caution: maybe missing Double Quote ");
            DoubleQFlag := false;
          end;                          {5}
          if SingleQFlag then
          begin                         {5}
            writeln("line ", LineNo, " Caution maybe missing Single Quote ");
            SingleQFlag := false;
          end;                          {5}
        end;                            {4}
        inc( LineNo );
        if( length( LineBuf ) > 0 ) then
        begin                           {4}
          i := 0;
          while i < length( LineBuf ) do
          begin                         {5}
            inc( i );
            case LineBuf[ i ] of
              '{' : OpenBrace;          {commentB}
              '}' : CloseBrace;
              '(' : ckStartComment;     {commentA or open paren}
              ')' : ckEndComment;
            end;
            if( not CommentAFlag ) or ( not CommentBFlag ) then
              case LineBuf[ i ] of
                '"' : DoubleQuote;
                "'" : SingleQuote;
                '[' : OpenBracket;
                ']' : CloseBracket;
              end;
              j := posfrom( "end;", LineBuf, 1 );
              if( j = 1 ) then Cleanup;
              if(( j > 1) and isspace( LineBuf[ j - 1 ] )) then Cleanup;
          end;                          {5}
        end;                            {4}
      end;                              {3}
      close( SrcFile );
      Wrapup;
    end;                                {2}
  end;                                  {1}
end.                                    {0}