Avoid using ++, op= and anon hash constructors in the testing code.
Nicholas Clark [Fri, 9 Oct 2009 20:03:17 +0000 (22:03 +0200)]
{} could be misparsed, ++ has a lot of internal implementation "magic" that we
don't need, but don't want to trip us up if it isn't working, and op= isn't
necessary when we already rely on the more general $a = $b op $c working.

t/TEST
t/test.pl

diff --git a/t/TEST b/t/TEST
index 35b59f7..56441a2 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -177,7 +177,7 @@ sub _scan_test {
     if ($type eq 'deparse') {
         # Look for #line directives which change the filename
         while (<$script>) {
-            $file_opts .= ",-f$3$4"
+            $file_opts = $file_opts . ",-f$3$4"
               if /^#\s*line\s+(\d+)\s+((\w+)|"([^"]+)")/;
         }
     }
@@ -320,7 +320,7 @@ sub _quote_args {
        # In VMS protect with doublequotes because otherwise
        # DCL will lowercase -- unless already doublequoted.
        $_ = q(").$_.q(") if ($^O eq 'VMS') && !/^\"/ && length($_) > 0;
-       $argstring .= ' ' . $_;
+       $argstring = $argstring . ' ' . $_;
     }
     return $argstring;
 }
@@ -337,7 +337,7 @@ sub _tests_from_manifest {
     my %known_extensions = _populate_hash($known_extensions);
 
     foreach (keys %known_extensions) {
-       $skip{$_}++ unless $extensions{$_};
+       $skip{$_} = 1 unless $extensions{$_};
     }
 
     my @results;
@@ -537,8 +537,8 @@ EOT
                    }
                    $max = $1;
                    %todo = map { $_ => 1 } split / /, $3 if $3;
-                   $totmax += $max;
-                   $tested_files++;
+                   $totmax = $totmax + $max;
+                   $tested_files = $tested_files + 1;
                    if ($seen_ok) {
                        # 1..n appears at end of file
                        $trailing_leader = 1;
@@ -560,7 +560,7 @@ EOT
                            }
                        }
                        $seen_ok = 1;
-                       $next++;
+                       $next = $next + 1;
                        my($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
                        $num = $next unless $num;
 
@@ -613,7 +613,7 @@ EOT
            }
            if ($ENV{VG_OPTS} =~ /cachegrind/) {
                if (rename $Valgrind_Log, "$test.valgrind") {
-                   $valgrind++;
+                   $valgrind = $valgrind + 1;
                } else {
                    warn "$0: Failed to create '$test.valgrind': $!\n";
                }
@@ -624,19 +624,19 @@ EOT
                for my $i (0..$#valgrind) {
                    local $_ = $valgrind[$i];
                    if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
-                       $errors += $1;   # there may be multiple error summaries
+                       $errors = $errors + $1;   # there may be multiple error summaries
                    } elsif (/^==\d+== LEAK SUMMARY:/) {
                        for my $off (1 .. 4) {
                            if ($valgrind[$i+$off] =~
                                /(?:lost|reachable):\s+\d+ bytes in (\d+) blocks/) {
-                               $leaks += $1;
+                               $leaks = $leaks + $1;
                            }
                        }
                    }
                }
                if ($errors or $leaks) {
                    if (rename $Valgrind_Log, "$test.valgrind") {
-                       $valgrind++;
+                       $valgrind = $valgrind + 1;
                    } else {
                        warn "$0: Failed to create '$test.valgrind': $!\n";
                    }
@@ -672,11 +672,11 @@ EOT
 
        if (defined $failure) {
            print "${te}$failure\n";
-           $::bad_files++;
+           $::bad_files = $::bad_files + 1;
            if ($test =~ /^base/) {
                die "Failed a basic test ($test) -- cannot continue.\n";
            }
-           ++$failed_tests{$test};
+           $failed_tests{$test} = 1;
        }
        else {
            if ($max) {
@@ -688,11 +688,11 @@ EOT
                    $elapsed = "";
                }
                print "${te}ok$elapsed\n";
-               $good_files++;
+               $good_files = $good_files + 1;
            }
            else {
                print "${te}skipped\n";
-               $tested_files -= 1;
+               $tested_files = $tested_files - 1;
            }
        }
     } # while tests
index 8302236..ca63a76 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -99,7 +99,7 @@ sub _ok {
        $out = $pass ? "ok $test" : "not ok $test";
     }
 
-    $out .= " # TODO $TODO" if $TODO;
+    $out = $out . " # TODO $TODO" if $TODO;
     _print "$out\n";
 
     unless ($pass) {
@@ -153,13 +153,13 @@ sub display {
             my $y = '';
             foreach my $c (unpack("U*", $x)) {
                 if ($c > 255) {
-                    $y .= sprintf "\\x{%x}", $c;
+                    $y = $y . sprintf "\\x{%x}", $c;
                 } elsif ($backslash_escape{$c}) {
-                    $y .= $backslash_escape{$c};
+                    $y = $y . $backslash_escape{$c};
                 } else {
                     my $z = chr $c; # Maybe we can get away with a literal...
                     $z = sprintf "\\%03o", $c if $z =~ /[[:^print:]]/;
-                    $y .= $z;
+                    $y = $y . $z;
                 }
             }
             $x = $y;
@@ -415,7 +415,7 @@ sub _quote_args {
        # In VMS protect with doublequotes because otherwise
        # DCL will lowercase -- unless already doublequoted.
        $_ = q(").$_.q(") if $is_vms && !/^\"/ && length($_) > 0;
-       $$runperl .= ' ' . $_;
+       $$runperl = $$runperl . ' ' . $_;
     }
 }
 
@@ -430,7 +430,7 @@ sub _create_runperl { # Create the string to qx in runperl().
        $runperl = "$ENV{PERL_RUNPERL_DEBUG} $runperl";
     }
     unless ($args{nolib}) {
-       $runperl .= ' "-I../lib"'; # doublequotes because of VMS
+       $runperl = $runperl . ' "-I../lib"'; # doublequotes because of VMS
     }
     if ($args{switches}) {
        local $Level = 2;
@@ -448,14 +448,14 @@ sub _create_runperl { # Create the string to qx in runperl().
            unless ref $args{progs} eq "ARRAY";
         foreach my $prog (@{$args{progs}}) {
             if ($is_mswin || $is_netware || $is_vms) {
-                $runperl .= qq ( -e "$prog" );
+                $runperl = $runperl . qq ( -e "$prog" );
             }
             else {
-                $runperl .= qq ( -e '$prog' );
+                $runperl = $runperl . qq ( -e '$prog' );
             }
         }
     } elsif (defined $args{progfile}) {
-       $runperl .= qq( "$args{progfile}");
+       $runperl = $runperl . qq( "$args{progfile}");
     } else {
        # You probaby didn't want to be sucking in from the upstream stdin
        die "test.pl:runperl(): none of prog, progs, progfile, args, "
@@ -481,7 +481,7 @@ sub _create_runperl { # Create the string to qx in runperl().
     if (defined $args{args}) {
        _quote_args(\$runperl, $args{args});
     }
-    $runperl .= ' 2>&1' if $args{stderr};
+    $runperl = $runperl . ' 2>&1' if $args{stderr};
     if ($args{verbose}) {
        my $runperldisplay = $runperl;
        $runperldisplay =~ s/\n/\n\#/g;
@@ -521,7 +521,7 @@ sub runperl {
            join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
                ($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
                    split quotemeta ($sep), $1;
-       $ENV{PATH} .= "$sep/bin" if $is_cygwin;  # Must have /bin under Cygwin
+       $ENV{PATH} = $ENV{PATH} . "$sep/bin" if $is_cygwin;  # Must have /bin under Cygwin
 
        $runperl =~ /(.*)/s;
        $runperl = $1;
@@ -576,7 +576,7 @@ sub which_perl {
        # the command.
 
        if ($Perl !~ /\Q$exe\E$/i) {
-           $Perl .= $exe;
+           $Perl = $Perl . $exe;
        }
 
        warn "which_perl: cannot find $Perl from $^X" unless -f $Perl;
@@ -608,14 +608,14 @@ sub tempfile {
        my $temp = $count;
        my $try = "tmp$$";
        do {
-           $try .= $letters[$temp % 26];
+           $try = $try . $letters[$temp % 26];
            $temp = int ($temp / 26);
        } while $temp;
        # Need to note all the file names we allocated, as a second request may
        # come before the first is created.
        if (!-e $try && !$tmpfiles{$try}) {
            # We have a winner
-           $tmpfiles{$try}++;
+           $tmpfiles{$try} = 1;
            return $try;
        }
        $count = $count + 1;
@@ -637,7 +637,14 @@ my $tmpfile = tempfile();
 sub _fresh_perl {
     my($prog, $resolve, $runperl_args, $name) = @_;
 
-    $runperl_args ||= {};
+    # Given the choice of the mis-parsable {}
+    # (we want an anon hash, but a borked lexer might think that it's a block)
+    # or relying on taking a reference to a lexical
+    # (\ might be mis-parsed, and the reference counting on the pad may go
+    #  awry)
+    # it feels like the least-worse thing is to assume that auto-vivification
+    # works. At least, this is only going to be a run-time failure, so won't
+    # affect tests using this file but not this function.
     $runperl_args->{progfile} = $tmpfile;
     $runperl_args->{stderr} = 1;
 
@@ -686,7 +693,7 @@ sub _fresh_perl {
     # Use the first line of the program as a name if none was given
     unless( $name ) {
         ($first_line, $name) = $prog =~ /^((.{1,50}).*)/;
-        $name .= '...' if length $first_line > length $name;
+        $name = $name . '...' if length $first_line > length $name;
     }
 
     _ok($pass, _where(), "fresh_perl - $name");
@@ -891,7 +898,7 @@ sub watchdog ($)
                 # Execute the timeout
                 my $time_left = $timeout;
                 do {
-                    $time_left -= sleep($time_left);
+                    $time_left = $time_left - sleep($time_left);
                 } while ($time_left > 0);
 
                 # Kill the parent (and ourself)