From: Graham Knop Date: Thu, 16 Jan 2014 18:36:10 +0000 (-0500) Subject: refactor hints testing for better naming and flexibility X-Git-Tag: v1.999_001~1^2~15 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Fstrictures.git;a=commitdiff_plain;h=967e00d7d5e8094ad88b79db3c0ae7db9b55d473 refactor hints testing for better naming and flexibility --- diff --git a/t/strictures.t b/t/strictures.t index d2c6ad6..41d39a5 100644 --- a/t/strictures.t +++ b/t/strictures.t @@ -1,34 +1,33 @@ -BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} } +BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 } use Test::More qw(no_plan); -our (@us, @expect); +our ($hints, $warning_bits); -sub capture_stuff { [ $^H, ${^WARNING_BITS} ] } - -sub capture_us { push @us, capture_stuff } -sub capture_expect { push @expect, capture_stuff } +sub capture_hints { + # ignore lexicalized hints + $hints = $^H & ~ 0x20000; + $warning_bits = defined ${^WARNING_BITS} ? (unpack "H*", ${^WARNING_BITS}) : undef; +} -{ - BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 } - use strictures 1; - BEGIN { capture_us } - BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} } +sub test_hints { + my $name = shift; + my $want_hints = $hints; + my $want_bits = $warning_bits; + capture_hints; + is($hints, $want_hints, "Hints ok for $name"); + is($warning_bits, $want_bits, "Warnings ok for $name"); } { use strict; use warnings FATAL => 'all'; - BEGIN { capture_expect } + BEGIN { capture_hints } } -# I'm assuming here we'll have more cases later. maybe not. eh. - -foreach my $idx (0 .. $#us) { - # ignore lexicalized hints - $us[$idx][0] &= ~ 0x20000; - is($us[$idx][0], $expect[$idx][0], 'Hints ok for case '.($idx+1)); - is($us[$idx][1], $expect[$idx][1], 'Warnings ok for case '.($idx+1)); +{ + use strictures 1; + BEGIN { test_hints "version 1" } } my $v;