From: twisti <none@none>
Date: Thu, 3 May 2007 08:16:14 +0000 (+0000)
Subject: * contrib/check_dangerous_printf.pl: Removed this file in favor of
X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=commitdiff_plain;h=4730e8e8245f59b25b53deab200312e715843d1c;p=cacao.git

* contrib/check_dangerous_printf.pl: Removed this file in favor of
pscan.
---

diff --git a/contrib/check_dangerous_printf.pl b/contrib/check_dangerous_printf.pl
deleted file mode 100644
index 2a4d742d7..000000000
--- a/contrib/check_dangerous_printf.pl
+++ /dev/null
@@ -1,162 +0,0 @@
-#! perl -w
-
-# This scripts finds calls of printf and printf-like functions which
-# do not use a literal string as format. Such calls are potentially
-# dangerous as they could use formats which do not match their
-# argument lists.
-
-use strict;
-use File::Find;
-no warnings 'File::Find';
-
-my @FUNCTIONS =
-    (
-     # NAME ........ name of function
-     # FORMATPOS ... index of format string argument, first is 1
-     {NAME => 'printf'     ,FORMATPOS => 1},
-     {NAME => 'sprintf'    ,FORMATPOS => 2},
-     {NAME => 'fprintf'    ,FORMATPOS => 2},
-     {NAME => 'error'      ,FORMATPOS => 1},
-     {NAME => 'dolog'      ,FORMATPOS => 1},
-     {NAME => 'dolog_plain',FORMATPOS => 1},
-    );
-
-my $rxall;
-my %tests;
-my @tests;
-my @files;
-
-prepare();
-find(\&wanted,'.');
-process();
-
-sub prepare
-{
-    for my $f (@FUNCTIONS) {
-	my $name = $f->{NAME};
-	$rxall .= "|" if $rxall;
-	$rxall .= "\\b$name\\b";
-#	push @{$tests{$f->{FORMATPOS}}},$f;
-	$tests{$f->{NAME}} = $f;
-    }
-    $rxall = qr/($rxall)/;
-    study $rxall;
-}
-
-sub wanted
-{
-    push @files, $File::Find::name if /\.[ch]$/i;
-    push @files, $File::Find::name if /\.inc$/i;
-}
-
-sub get_args
-{
-    my ($coderef,$file,$line) = @_;
-    my $arg;
-    my $level = 0;
-    my @args;
-
- ARG:
-    while (1) {
-	unless ($$coderef =~ /\G(.*?)([,()"])/g) {
-	    return undef;
-	}
-	$arg .= $1;
-	my $d = $2;
-	if ($d eq ')') {
-	    if ($level-- == 0) {
-		push @args,$arg;
-		return \@args;
-	    }
-	}
-	elsif ($d eq ',') {
-	    if ($level == 0) {
-		push @args,$arg;
-		$arg = '';
-		next ARG;
-	    }
-	}
-	elsif ($d eq '(') {
-	    $level++;
-	}
-	elsif ($d eq '"') {
-	    unless($$coderef =~ /\G  (  ([^\\"]|\\.)*   "  )  /gx) {
-		return undef;
-	    }
-	    $d .= $1;
-	}
-	$arg .= $d;
-    }
-}
-
-sub process
-{
-    for my $file (@files) {
-#	print "$file\n";
-	open(FILE,"<$file") or die "Could not open $file: $!";
-	my $code;
-	my $pos = 0;
-	my @pos;
-	while (<FILE>) {
-	    s/\n/ /;
-	    s/[ \t]+/ /;
-	    $code .= $_;
-	    push @pos,$pos;
-	    $pos += length;
-	}
-	close(FILE);
-
-	my $line = 1;
-    OCC:
-	while ($code =~ /$rxall/g) {
-	    my $pos = pos($code);
-	    my $fname = $1;
-	    my $test = $tests{$fname};
-	    while (pos($code) > $pos[$line]) {$line++}
-#	    print "$1\n";
-	    unless ($code =~ /\G\s*\(/g) {
-		print STDERR "$file:$line: warning: could not find parenthesis\n";
-		pos($code) = $pos;
-		next OCC;
-	    }
-	
-	    my $index = 1;
-
-	    my $args = get_args(\$code,$file,$line);
-	    unless ($args) {
-		print STDERR "$file:$line:warning: could not parse arguments\n";
-		pos($code) = $pos;
-		next OCC;
-	    }
-
-	    if (@$args < $test->{FORMATPOS}) {
-		print STDERR "$file:$line: warning: could not find format of $fname\n";
-		next OCC;
-	    }
-
-	    my $fmt = $args->[$test->{FORMATPOS} - 1];
-
-	    if ($fmt =~ /^\s*$/) {
-		print "$file:$line: missing format: $fname(".join(',',@$args).")\n";
-		next OCC;
-	    }
-
-	    unless ($fmt =~ /^\s*"/) {
-		print "$file:$line: nonliteral format: $fname(".join(',',@$args).")\n";
-		next OCC;
-	    }
-
-	    if ($fmt =~ /^\s*"(.*)"\s*$/) {
-		my $f = $1;
-		$f =~ s/"\s+"//g;
-		my $pct = 0;
-		while ($f =~ /(%%?)/g) {$pct++ if length($1)==1};
-
-		if ($pct != @$args - $test->{FORMATPOS}) {
-		print "$file:$line: arguments?: $fname(".join(',',@$args).")\n";
-		}
-	    }
-	}
-    }
-}
-