From: Nicholas Clark Date: Fri, 9 Oct 2009 20:03:17 +0000 (+0200) Subject: Avoid using ++, op= and anon hash constructors in the testing code. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11ea18f245d08781afc82a7ba337926fd25b4c39;p=p5sagit%2Fp5-mst-13.2.git Avoid using ++, op= and anon hash constructors in the testing code. {} 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. --- diff --git a/t/TEST b/t/TEST index 35b59f7..56441a2 100755 --- 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 diff --git a/t/test.pl b/t/test.pl index 8302236..ca63a76 100644 --- 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)