From 25b57a7e3aeaed75d57ab52d2271a61cbb3f222a Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Fri, 4 Feb 2011 15:08:28 +0000 Subject: [PATCH] In B's OptreeCheck, inline diag_or_fail() into its only caller. $tc->{goterrs} is not referenced after this function, so no need to re-assign to it. --- ext/B/t/OptreeCheck.pm | 43 ++++++++++++++++++------------------------- 1 file changed, 18 insertions(+), 25 deletions(-) diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm index 164f561..09f6c4b 100644 --- a/ext/B/t/OptreeCheck.pm +++ b/ext/B/t/OptreeCheck.pm @@ -561,41 +561,34 @@ sub checkErrs { # check for agreement, by hash (order less important) my (%goterrs, @got); - $tc->{goterrs} ||= []; - @goterrs{@{$tc->{goterrs}}} = (1) x scalar @{$tc->{goterrs}}; - + @goterrs{@{$tc->{goterrs}}} = (1) x scalar @{$tc->{goterrs}} + if $tc->{goterrs}; + foreach my $k (keys %{$tc->{errs}}) { if (@got = grep /^$k$/, keys %goterrs) { delete $tc->{errs}{$k}; delete $goterrs{$_} foreach @got; } } - $tc->{goterrs} = \%goterrs; # relook at altered - if (%{$tc->{errs}} or %{$tc->{goterrs}}) { - $tc->diag_or_fail(); + if (%{$tc->{errs}} or %goterrs) { + my @lines; + push @lines, "got unexpected:", sort keys %goterrs if %goterrs; + push @lines, "missed expected:", sort keys %{$tc->{errs}} if %{$tc->{errs}}; + + if (@lines) { + unshift @lines, $tc->{name}; + my $report = join("\n", @lines); + + if ($gOpts{report} eq 'diag') { _diag ($report) } + elsif ($gOpts{report} eq 'fail') { fail ($report) } + else { print ($report) } + next unless $gOpts{errcont}; # skip block + } } - fail("FORCED: $tc->{name}:\n") if $gOpts{fail}; # silly ? -} -sub diag_or_fail { - # help checkErrs - my $tc = shift; - - my @lines; - push @lines, "got unexpected:", sort keys %{$tc->{goterrs}} if %{$tc->{goterrs}}; - push @lines, "missed expected:", sort keys %{$tc->{errs}} if %{$tc->{errs}}; - - if (@lines) { - unshift @lines, $tc->{name}; - my $report = join("\n", @lines); - - if ($gOpts{report} eq 'diag') { _diag ($report) } - elsif ($gOpts{report} eq 'fail') { fail ($report) } - else { print ($report) } - next unless $gOpts{errcont}; # skip block - } + fail("FORCED: $tc->{name}:\n") if $gOpts{fail}; # silly ? } =head1 mkCheckRex ($tc) -- 2.7.4