Article: 4225 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:4225
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!agate!ames!olivea!apple.com!voder!berlioz.nsc.com!jedi!arielf
From: [email protected] (Ariel Faigon)
Subject: ckbal - check balanced tokens in C source (perl script)
Message-ID: <[email protected]>
Followup-To: comp.lang.perl
Keywords: Reiser-cpp tokens balance C-language-tool
Sender: [email protected] (UseNet News account)
Reply-To: [email protected]
Organization: National Semiconductor Corp.
Date: Wed, 14 Jul 1993 20:26:05 GMT
Lines: 345

Have you ever been frustrated by the Reiser-cpp or pcc insufficient data
in error messages? Have you ever got a message like "1073: missing #endif"
without a reference to the line where the opening #if appears. Have you ever
left out a closing comment and searched your source for the error in the wrong
place? If so, 'ckbal' can help you.
I wrote this about a year ago in an evening of such frustration, and just thought
it might be a good idea to post this for the benefit of all.

Sorry, the man page is not wrapped, and it doesn't handle C++ style comments.
yet it saved me and my colleagues many long hours in the past year or so. Enjoy.

#!/usr/local/bin/perl
# On Messy-DOS systems start with the following 3 line prologue:
@REM=(qq!
@perl  %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
@goto end !) if 0 ;

#
# ckbal - check balanced tokens in C source.
#
# Usage:
#       ckbal [-d] [-w] C-files...
#
#       checked token-pairs include
#               ( )
#               [ ]
#               { }
#               /* */
#               " "
#               ' '
#               #ifxxx [#els...] #endif
#
# Errors detected:
#       o EOF hit with unclosed token (opened on line X)
#       o Closing token on line X has no matching open token
#
# Options:
#       -w      Adds warnings about potential errors:
#               Unmatched token pairs within strings or comments
#               (e.g. Open comment within a comment)
#
#       -d      Adds debugging printouts
#
# States during parsing:
#       o In comment
#       o In string
#       o In char constant
#       o In code
#
# TODO:
#       o Make it simpler - more general, more table driven
#         but for a first shot it serves its purpose...
#       o Add C++, // style comments
# BUGS:
#       o A character (single quoted) string is arbitrary long
#       o There are cases where only '-w' will spot the problem
#
# Author: Ariel Faigon, ([email protected]), May 13, 1992
# Donated to the public domain - please leave author data intact. Enjoy.
#

# I use eval because it may not work on my DOS, your mileage may vary.
eval "require 'getopts.pl'";
unless ($@) {
       &Getopts('dw');
}

# -- Opening -> closing token mapping
%pairof = (
       '(', ')',
       '[', ']',
       '{', '}',
       '/*', '*/',
       '"', '"',
       "'", "'",
       '#if',     '#endif',
       '#ifdef',  '#endif',
       '#ifndef', '#endif',

);

# -- State transitions: state + token -> new-state
%next_state = ( "code$;/*", 'comment',
               "code$;\"", 'string',   # " close quote to keep 4dos happy
               "code$;'", 'char',
               "comment$;*/", 'code',
               "string$;\"", 'code',   # " close quote to keep 4dos happy
               "char$;'", 'code'
);

# -- single-char-codes -> real-tokens
# text is 'canonicalized' using single char codes for convenience + efficiency
%realtok_of = (
       "\201", '/*',
       "\202", '*/',

       "\211", '#if',
       "\212", '#ifdef',
       "\213", '#ifndef',
       "\214", '#else',
       "\215", '#elsif',
       "\216", '#endif'
);

# Given current state and token, determine if a token is "opening"
# Should probably be another assoc table...
sub opening {
   local($state, $tok) = @_;
   ($tok =~ m,[\[({]|/\*, || $state eq 'code' && $tok =~ /["']/ ||
    $tok =~ /^#if/)
           ? 1 : 0;
}

# Given current state and token determine if a token is "closing"
# Should probably be another assoc table...
sub closing {
   local($state, $tok) = @_;
   ($tok =~ m,[])}]|\*/, || $tok eq "'" && $state eq 'char' ||
    $tok eq '"' && $state eq 'string' || $tok eq '#endif')
       ? 1 : 0;
}

# -- pop and cleanup all remaining 'unclosed' tokens from stack
sub cleanup_pop {
   local(*stack) = @_;
   local($tok, $line, $prefix);

   $prefix = '';
   unless ($state eq 'code' || $at_eof) {
       $prefix = "warning (in $state): ";
   }
   while (@stack) {
       $tok = pop(@stack);
       $line = pop(@stack);
       if ($opt_w || !$prefix) {
           print STDERR "$0: $prefix$file, $line: '$tok': open without close\n";
       }
   }
}

$0 =~ s,.*/,,;                  # Trim pathname for error messages
unless (@ARGV) {
   print STDERR "ckbal: check balanced tokens in C source

Usage:
       ckbal [-d] [-w] C-files...

Checked token-pairs include:
               ( ), [ ], { }, /* */, \" \", ' '
               #ifxxx [#els...] #endif
Options:
       -w      Adds warnings about potential errors:
               Unmatched token pairs within strings or comments
               (e.g. Open comment within a comment)

       -d      Adds debugging printouts
";
       exit(1);
}

# -- main program
foreach $file (@ARGV) {
   &dofile;
}

# -- process one file
sub dofile {
   local(*stack);

   &canonicalize($file);
   if ($opt_d) {
       print "after canonicalize: '@tokens'\n";
   }


   $line = 1;
   $state = 'code';
   $at_eof = 0;
   while ($tok = shift(@tokens)) {
       if ($tok eq "\n") {
           $line++;
           next;
       }
       # Move to a new state if a transition is needed
       if ($next_state{$state, $tok}) {
           $new_state = $next_state{$state, $tok};
       } else {
           $new_state = $state;                        # default - no change
       }
       if (&opening($state, $tok)) {
           # --- 'opening' tokens
           # special case warning:
           if ($opt_w && $state eq 'comment' && $tok eq '/*') {
              print STDERR "$0: warning: $file, $line: open-comment in comment\n";
           }
           $state = $new_state;
           *stack = $state;
           $realstack = $state;
           if ($tok =~ /^#/) {
               push(@cpp, ($line, $tok));
               $realstack = 'cpp';
           } else {
               push(@stack, ($line, $tok));
           }
           if ($opt_d) {
               print STDERR "$0: line $line: pushed $tok on $realstack stack\n";
           }
       } elsif (&closing($state, $tok)) {
           # --- 'closing' tokens
           if ($tok =~ /^#/) {
               if (@cpp) {
                   $pop = pop(@cpp);
                   pop(@cpp);          # get rid of line-no too
                   if ($opt_d) {
                   print STDERR "$0: line $line: popped $pop from cpp stack\n";
                   }
               } else {
                   print STDERR "$0: $file, $line: '$tok': close without open\n";
               }
               next;
           }

           $prev_tok = $stack[$#stack];
           $prev_line = $stack[$#stack-1];
           if ($pairof{$prev_tok} ne $tok) {
               if ($state eq 'string' && $tok eq '"' ||
                   $state eq 'char' && $tok eq "'" ||
                   $state eq 'comment' && $tok eq '*/') {
                   shift(@stack); shift(@stack);       # get rid of opening
                   &cleanup_pop(*stack, $state);
                   $state = $new_state;
                   *stack = $state;
                   next;
               } elsif ($state eq 'code') {
                   print STDERR "$0: $file, $line: '$tok': close without open\n";
                   @string = ();
                   @char = ();
                   @comment = ();
               } else {                # not in code: comment, string or char
                   $prefix = "warning (in $state): ";
                   if ($opt_w) {
                       print STDERR "$0: $prefix$file, $line: '$tok': close without open\n";
                   }
                   if ($state eq 'string' && $tok eq '"') {
                       @string = ();
                   } elsif ($state eq 'comment' && $tok eq '*/') {
                       @comment = ();
                   } elsif ($state eq 'char' && $tok eq "'") {
                       @char = ();
                   }
               }
           } else {     # match found: pop matching token (and line) from stack
               pop(@stack);
               pop(@stack);
               if ($opt_d) {
                   print STDERR "$0: line $line: popped $tok from $state stack\n";
               }
               $state = $new_state;
               *stack = $state;
           }                           # found matching open to close token
       }                       # open or close token
       elsif ($tok =~ /#els/) {
           unless (@cpp) {
               print STDERR "$0: $file, $line: '#if' less '$tok'\n";
           }
       }
   }                   # while tokens in input
   $at_eof = 1;
   $eof_header = 0;
   for $st ('code', 'comment', 'string', 'char', 'cpp') {
       eval "*stack = *$st";
       if (@stack) {
           unless ($eof_header) {
               print STDERR "$0: $file", ': EOF with unclosed tokens:',"\n";
               $eof_header = 1;
           }
           &cleanup_pop(*stack, $st);
       }
   }
}

#
# canonicalize:
#       Convert input file to a list of tokens while stripping all
#       "uninteresting" tokens from input.
#
#       o Delete every \x to ease string and char constant parsing.
#       o Replace every two-chars interesting tokens (like /* and */)
#         by a single-char code
#       o Leave paired-tokens (like {}[]) and newlines (to count lines)
#         deleting all the rest
#
sub canonicalize {
   local($file) = @_;
   local($_, $tok) = ('', '');

#    undef $/;                # read all input into one long string
#    $* = 1;                # Allow multi-line pattern matching

   @tokens = ();
   open(FH, $file) || die "$0: cannot open '$file' - $!\n";

   while (<FH>) {
       @Ltokens = ();
       s/\\[^\n]//g; # Get rid of escape-sequences to simplify string parsing

       # normalize to one-char tokens to simplify parsing
       s,/\*,\201,g;
       s,\*/,\202,g;

       s,^\s*#\s*if,\211,;
       s,^\s*#\s*ifdef,\212,;
       s,^\s*#\s*ifndef,\213,;
       s,^\s*#\s*else,\214,;
       s,^\s*#\s*elsif,\215,;
       s,^\s*#\s*endif,\216,;

       # Get rid of all chars except 'interesting' chars
       y/()[]{}"'\n\201-\230//cd;

       @Ltokens = split(//, $_);       # convert line to list of tokens
       while ($tok = shift(@Ltokens)) {# translate back to real-tokens
           if ($realtok_of{$tok}) {
               push(@tokens, $realtok_of{$tok});
           } else {
               push(@tokens, $tok);
           }
       }
   }
   close(FH);
   # @tokens;          # return interesting list of tokens for whole file
}

#
# Messy-DOS epilogue:
#
@REM=(qq!
:end !) if 0 ;



---
Peace, Ariel
[email protected]

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.