#!/perl -w
# NAME: chkmain.pl - library
# AIM: Read a C/C++ file and check for main()
# 2010-07-07 - Some tidying when used in makesrcs.pl
# 20090911 - version 2 with output indicator
# 20090828 - check for quotes "...", and only WARN if could have been in quotes
# 21/11/2007 - geoff mclane - http://geoffair.net/mperl
# check_for_main - check for main()

sub chkmain2($$) {
	my ($out,$fil) = @_;
	my $fndm = 0;
	my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment);
	my ($lncomm, $wascomm, $hadquotes, $quoted, $wd, $minq, $lnn, $intest);
   my @ifstack = ();
   my @includes = ();
	if (open INF, "<$fil") {
		my @clines = <INF>;
		close INF;
		$ccnt = scalar @clines;
		$pline = '';
		$incomm = 0;
		$tag = '';
		$comment = '';
		$lncomm = 0;
      $hadquotes = 0;
      $lnn = 0;
		###prt( "\nProcessing $ccnt lines of $fil ...\n" );
		for ($k = 0; $k < $ccnt; $k++) {
			$cline = $clines[$k];
         $lnn++;
			$k2 = $k + 1;
			chomp $cline;
			$tline = $cline;	# trim_all($cline);
			$ll = length($tline);
			$tag = '';
			$fnd1 = 0;
         $intest = 0;
			if (($tline =~ /\s+main(\s|\()+/)||
				($tline =~ /^main(\s|\()+/)){
				$fnd1 = 1;
            if (@ifstack) {
               $wd = $ifstack[-1];  # get LAST
               if ($wd =~ /TEST/i) {
                  $intest = 1;
               }
            }
			}
			if ( !$incomm && ($tline =~ /^\s*#\s*include\s+(.+)/)) {
            push(@includes, $1);
				next;	# skip '#include <main/main.h>' like INCLUDE lines
			}
         if ($cline =~ /^\s*#\s*if\w*\s+(.+)/) {
            push(@ifstack,$1);
         } elsif ($cline =~ /^\s*#\s*endif/) {
            if (@ifstack) {
               pop @ifstack;
            } else {
               prtw( "WARNING:$fil:$lnn: line [$cline] ENDIF without stack!\n" );
            }
         }
			$comment .= "\n" if length($comment);
			$lncomm = 0;
			$pch = '';
         $hadquotes = 0;
         $minq = 0;
			for ($j = 0; $j < $ll; $j++) {
				$ch = substr($tline,$j,1);
				if ($incomm) {
					# only looking for CLOSE comment */
					$comment .= $ch;
					if (($ch eq '/') && ($pch eq '*')) {
						$incomm = 0;
					}
				} else {
					if ($ch eq '"') {
						# start of QUOTE
						$j++;	# to next char
						$pch = $ch;
                  $quoted = $ch;
                  $wd = '';
						for ( ; $j < $ll; $j++) {
							$ch = substr($tline,$j,1);
                     $quoted .= $ch;
							if (($ch eq '"')&&($pch ne "\\")) {
								last;	# out of here
							}
							$pch = $ch;
                     if ($ch =~ /\w/) {
                        $wd .= $ch;
                     } elsif (length($wd)) {
                        $minq = 1 if ($wd eq 'main');
                        $wd = '';
                     }
						}
                  $hadquotes++;
					} elsif (($ch eq '*') && ($pch eq '/')) {
						# comment start /* until */
						$incomm = 1;
						$wascomm = 1;
						$comment = $pch.$ch;
					} elsif (($ch eq '/') && ($pch eq '/')) {
						$j = $ll;	# skip rest of line
						$lncomm = 1;
					} else {
						if ($ch =~ /\w+/) { #if ($ch =~ /[main]/) {
							$tag .= $ch;
						} else {
							# NOT alphanumeric
							if ($tag eq 'main') {
								#prt( "Found a main ...\n" );
								#prt( "$tline\n" );
								#push(@mains, $tline);
                        if ($intest) {
                           prtw("WARNING:$fil:$lnn: line[$cline] NOT counted, since in 'TEST' switch - BUT CHECK!\n" );
                        } else {
                           $fndm++;
                        }
							}
							$tag = '';
						}
					}
				}
				$pch = $ch;
			}
			###prt( "line $k2:[$tline]$ll ($incomm:$lncomm) $fnd1 $fndm\n" );
			#if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm)
			if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm && !$intest) {
            if ($hadquotes) {
               if ($minq) {
                  if ($out & 1) {
                     prtw( "WARNING:$fil:$lnn: 'main' in quotes! CHECK no other!\n" );
                  } else {
                     prt("NOTE: found 'main' but appears to be in 'quotes' - skipped\n" );
                  }
               } else {
                  prtw( "\nWARNING:$fil:$lnn: MISSED main! But maybe in QUOTES! CHECK!\n" );
               }
            } else {
               prtw( "\nERROR:$fil:$lnn: MISSED main! WHY???\n" );
            }
            if ($out & 1) {
               prtw( "WARNING: LINE[$tline]\n" );
            } else {
               prt( "line=[".trim_all($tline)."]\n" );
            }
			}
			$wascomm = $incomm;
			$pline = $cline;
		}
	} else {
		prtw( "WARNING: Unable to open [$fil] file ... $! ...\n" );
	}
   if (@ifstack) {
      $cline = "WARNING:$fil:$lnn: Still ".scalar @ifstack." items in IF stack!\n";
      foreach $pline (@ifstack) {
         $cline .= "$pline ";
      }
      prtw( "$cline\n" );
   }
	return $fndm;
}

sub chkmain {
	my ($fil) = shift;
   return chkmain2(-1,$fil);
}

sub chk_main {
	my ($fil,$rarr) = @_;
	my $fndm = 0;
	my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment);
	my ($lncomm, $wascomm, $iftxt, $msg, $bch, $main, $ml, $mi, $cond);
	my @ifopen = ();
	my @conditional_stack = ();
	if (open INF, "<$fil") {
		my @clines = <INF>;
		close INF;
		$ccnt = scalar @clines;
		$pline = '';
		$incomm = 0;
		$tag = '';
		$comment = '';
		$lncomm = 0;
		$iftxt = '';
		$msg = '';
		###prt( "\nProcessing $ccnt lines of $fil ...\n" );
		for ($k = 0; $k < $ccnt; $k++) {
			$cline = $clines[$k];
			$k2 = $k + 1;
			chomp $cline;
			$tline = trim_all($cline);
			$ll = length($tline);
			$tag = '';
			$fnd1 = 0;
			if ( !$incomm) {
				if ( $tline =~ /^\s*#\s*include\s+/ ) {
					next;	# skip '#include <main/main.h>' like INCLUDE lines
				} elsif ($tline =~ /^\s*#\s*if(.*)/ ) {
					$iftxt = $1;
					if ($iftxt =~ /^def\s+(.*)/ ) {
						$msg = "Got ifdef [$1] ... TRUE";
			            push (@conditional_stack, "\@" . $1 . "_TRUE\@");
					} elsif ($iftxt =~ /^\s+(.*)/ ) {
						$msg = "Got if [$1] ... TRUE";
			            push (@conditional_stack, "\@" . $1 . "_TRUE\@");
					} else {
						$msg = "CHECK ME: What is this? [$tline]\n";
					}
					###prt( "$msg\n" );
					next;
				} elsif ($tline =~ /^\s*#\s*else(.*)/ ) {
					$msg = "Got else ...";
		            if (! @conditional_stack) {
		                $msg .= "ERROR: else without if";
					} elsif ($conditional_stack[$#conditional_stack] =~ /_FALSE\@$/) {
						$msg .= "ERROR: else after else";
					} else {
						$msg .= "tog ".$conditional_stack[$#conditional_stack];
						$conditional_stack[$#conditional_stack] =~ s/_TRUE\@$/_FALSE\@/;
						$msg .= " to ".$conditional_stack[$#conditional_stack];
					}
					###prt( "$msg\n" );
					next;
				} elsif ($tline =~ /^\s*#\s*endif(.*)/ ) {
					$msg = "Got endif ...";
					if (! @conditional_stack) {
						$msg .= "ERROR: endif without if";
					} else {
						$msg = "pop ". pop @conditional_stack;
					}
					###prt( "$msg\n" );
					next;
				}
			}
			$pline = '';
			$comment .= "\n" if length($comment);
			$lncomm = 0;
			$pch = '';
			$bch = ' ';
			for ($j = 0; $j < $ll; $j++) {
				$ch = substr($tline,$j,1);
				if ($incomm) {
					# only looking for CLOSE comment */
					$comment .= $ch;
					if (($ch eq '/') && ($pch eq '*')) {
						$incomm = 0;
						$tline = substr($tline,$j);
						$ll = length($tline);
						$j = 0;
						$ch = '';
						$bch = ' ';
					}
					$pch = $ch;
					next;
				} else {
					if ($ch eq '"') {
						# start of QUOTE
						$j++;	# to next char
						$pch = $ch;
						for ( ; $j < $ll; $j++) {
							$ch = substr($tline,$j,1);
							if (($ch eq '"')&&($pch ne "\\")) {
								last;	# out of here
							}
							$pch = $ch;
						}
					} elsif (($ch eq '*') && ($pch eq '/')) {
						# comment start /* until */
						$incomm = 1;
						$wascomm = 1;
						$comment = $pch.$ch;
					} elsif (($ch eq '/') && ($pch eq '/')) {
						$j = $ll;	# skip rest of line
						$lncomm = 1;
					} else {
						if ($ch =~ /\w+/) { #if ($ch =~ /[main]/) {
							$tag .= $ch;
						} else {
							# NOT alphanumeric
							if (($tag eq 'main')&&($bch eq ' ')&&(($ch =~ /\s/)||($ch eq '('))) {
								$mi = $j + 1;
								for ($mi = $j + 1; $mi < $ll; $mi++) {
									if (substr($tline,$mi,1) eq ')') {
										$mi++;
										last;
									}
								}
								$main = substr($tline,0,$mi);
								$main = substr($main,1) if ($main =~ /^\//);
								#prt( "Found a main ... [$main]\n" );
								$msg = '';
								if (@conditional_stack) {
									foreach $cond (@conditional_stack) {
										$msg .= " && " if (length($msg));
										$msg .= $cond;
									}
								}
								$fndm++;
								push(@{$rarr}, [$fndm, $main, $msg]);
								###prt( "$fndm: Found main [$main] cond [$msg]\n" );
							}
							$tag = '';
							$bch = $ch;
						}
					}
				}
				$pch = $ch;
				$pline .= $ch;
			}
			if (($pline =~ /\s+main(\s|\()+/)||
				($pline =~ /^main(\s|\()+/)){
				$fnd1 = 1;
			}
			###prt( "line $k2:[$tline]$ll ($incomm:$lncomm) $fnd1 $fndm\n" );
			if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm) {
				prt( "\nERROR: MISSED main! WHY??? [$fil]\n" );
				prt( "CHECK ME [$pline]\n" );
			}
			$wascomm = $incomm;
		}
	} else {
		prt( "WARNING: Unable to open [$fil] file ... $! ...\n" );
	}
	return $fndm;
}


1;

# eof - chkmain.pl