Fix format issue in t/op/taint.t and add strict/warnings

Format was using '<'*5 instead of '<'x5 in multiple locations
also enforce strict & warnings to detect similar issues in the
future.

diff --git a/t/op/taint.t b/t/op/taint.t
index a7b11bc..81a17d4 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -15,9 +15,10 @@ BEGIN {
 }
 
 use strict;
+use warnings;
 use Config;
 
-plan tests => 1052;
+plan tests => 1054;
 
 $| = 1;
 
@@ -94,14 +95,14 @@ my $TAINT0;
 
 # This taints each argument passed. All must be lvalues.
 # Side effect: It also stringifies them. :-(
-sub taint_these (@) {
+sub taint_these :prototype(@) {
     for (@_) { $_ .= $TAINT }
 }
 
 # How to identify taint when you see it
-sub tainted ($) {
+sub tainted :prototype($) {
     local $@;   # Don't pollute caller's value.
-    not eval { join("",@_), kill 0; 1 };
+    not eval { no warnings; join("", @_), kill 0; 1 };
 }
 
 sub is_tainted {
@@ -1183,7 +1184,7 @@ SKIP: {
     my $arg = tempfile();
     open $fh, '>', $arg or die "Can't create $arg: $!";
     print $fh q{
-       eval { join('', @ARGV), kill 0 };
+       eval { my $x = join('', @ARGV), kill 0 };
        exit 0 if $@ =~ /^Insecure dependency/;
        print "# Oops: \$@ was [$@]\n";
        exit 1;
@@ -1506,6 +1507,7 @@ violates_taint(sub { link $TAINT, '' }, 'link');
 
 # test bitwise ops (regression bug)
 {
+    no warnings 'numeric';
     my $why = "y";
     my $j = "x" | $why;
     isnt_tainted($j);
@@ -1655,7 +1657,7 @@ SKIP: {
 
     our $has_fcntl;
     BEGIN {
-       eval { require Fcntl; import Fcntl; };
+       eval { require Fcntl; Fcntl->import; };
        unless ($@) {
            $has_fcntl = 1;
        }
@@ -1751,11 +1753,11 @@ SKIP: {
     while (my ($k, $v) = each %ENV) {
        if (!tainted($v) &&
            # These we have explicitly untainted or set earlier.
-           $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|PERL_CORE|TEMP|TERM|TMP)$/) {
+           $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|PERL_CORE|TEMP|TERM|TMP|PERL5LIB)$/) {
            push @untainted, "# '$k' = '$v'\n";
        }
     }
-    is("@untainted", "");
+    is("@untainted", "", "untainted");
 }
 
 
@@ -2072,14 +2074,15 @@ SKIP:
                   q/sprintf doesn't like tainted formats/);
     violates_taint(sub { sprintf($TAINT . "# %s\n", "foo") }, 'sprintf',
                   q/sprintf doesn't like tainted format expressions/);
-    eval { sprintf("# %s\n", $TAINT . "foo") };
+    eval { my $str = sprintf("# %s\n", $TAINT . "foo") };
     is($@, '', q/sprintf accepts other tainted args/);
 }
 
 {
     # 40708
     my $n  = 7e9;
-    8e9 - $n;
+    my $sub = 8e9 - $n;
+    is ( $sub, 1000000000, '8e9 - 7e9' );
 
     my $val = $n;
     is ($val, '7000000000', 'Assignment to untainted variable');
@@ -2100,6 +2103,7 @@ SKIP:
     seek $fh, 0, 2 or die $!;
     $tainted = <$fh>;
 
+    no warnings 'uninitialized';
     eval 'eval $tainted';
     like ($@, qr/^Insecure dependency in eval/);
 }
@@ -2137,7 +2141,7 @@ foreach my $ord (78, 163, 256) {
           my $x = crypt($_[0], $alg . $_[1]);
           $x
       }
-      sub co { my $x = ~$_[0]; $x }
+      sub co { no warnings 'numeric'; my $x = ~$_[0]; $x }
       my ($a, $b);
       $a = cr('hello', 'foo' . $TAINT);
       $b = cr('hello', 'foo');
@@ -2167,7 +2171,7 @@ foreach my $ord (78, 163, 256) {
 
     is_tainted($string, "still tainted data");
 
-    my @got = split /[!,]/, $string;
+    @got = split /[!,]/, $string;
 
     # each @got would be useful here, but I want the test for earlier perls
     for my $i (0 .. $#data) {
@@ -2177,7 +2181,7 @@ foreach my $ord (78, 163, 256) {
 
     is_tainted($string, "still tainted data");
 
-    my @got = split /!/, $string;
+    @got = split /!/, $string;
 
     # each @got would be useful here, but I want the test for earlier perls
     for my $i (0 .. $#data) {
@@ -2249,6 +2253,7 @@ foreach my $ord (78, 163, 256) {
 {
     for my $var1 ($TAINT, "123") {
        for my $var2 ($TAINT0, "456") {
+        no warnings q(redundant);
            is( tainted(sprintf '%s', $var1, $var2), tainted($var1),
                "sprintf '%s', '$var1', '$var2'" );
            is( tainted(sprintf ' %s', $var1, $var2), tainted($var1),
@@ -2266,7 +2271,7 @@ foreach my $ord (78, 163, 256) {
 
 {
     use re 'taint';
-    "abc".$TAINT =~ /(.*)/; # make $1 tainted
+    my $x = "abc".$TAINT =~ /(.*)/; # make $1 tainted
     is_tainted($1, '$1 should be tainted');
 
     my $untainted = "abcdef";
@@ -2300,17 +2305,17 @@ end
     is_tainted($^A, "tainted formline argument makes a tainted accumulator");
     $^A = "";
     isnt_tainted($^A, "accumulator can be explicitly untainted");
-    formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
+    formline('@' .('<'x5) . ' | @*', 'hallo', 'welt');
     isnt_tainted($^A, "accumulator still untainted");
     $^A = "" . $TAINT;
     is_tainted($^A, "accumulator can be explicitly tainted");
-    formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
+    formline('@' .('<'x5) . ' | @*', 'hallo', 'welt');
     is_tainted($^A, "accumulator still tainted");
     $^A = "";
     isnt_tainted($^A, "accumulator untainted again");
-    formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
+    formline('@' .('<'x5) . ' | @*', 'hallo', 'welt');
     isnt_tainted($^A, "accumulator still untainted");
-    formline('@' .('<'*(5+$TAINT0)) . ' | @*', 'hallo', 'welt');
+    formline('@' .('<'x(5+$TAINT0)) . ' | @*', 'hallo', 'welt');
     is_tainted($^A, "the accumulator should be tainted already");
     is_tainted($^A, "tainted formline picture makes a tainted accumulator");
 }
@@ -2448,7 +2453,9 @@ EOF
     BEGIN { no strict 'refs'; my $v = $old_env_path; *{"::C"} = sub () { $v }; }
     ok(tainted C, "constant is tainted properly");
     ok(!tainted "", "tainting not broken yet");
-    index(undef, C);
+    no warnings 'uninitialized';
+    my $ix = index(undef, C);
+    is( $ix, -1, q[index(undef, C)] );
     ok(!tainted "", "tainting still works after index() of the constant");
 }
 
@@ -2509,7 +2516,7 @@ SKIP: {
 # reset() and tainted undef (?!)
 $::x = "foo";
 $_ = "$TAINT".reset "x";
-is eval { eval $::x.1 }, 1, 'reset does not taint undef';
+is eval { no warnings; eval $::x.1 }, 1, 'reset does not taint undef';
 
 # [perl #122669]
 {