X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstrictures.t;h=20ca87bdd0e5f3271b99f4c50ed7f00542643007;hb=09dcd779e42c0818abe4220b900b730fc67e1e7e;hp=cf09a9d6f12b025f8cef66fa9a60498be796e143;hpb=b4f4fcfc38987bc434d6a013de24d13d5c2082cc;p=p5sagit%2Fstrictures.git diff --git a/t/strictures.t b/t/strictures.t index cf09a9d..20ca87b 100644 --- a/t/strictures.t +++ b/t/strictures.t @@ -1,25 +1,29 @@ BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 } +sub _eval { eval $_[0] } + +use Test::More 0.88; + +use strict; +use warnings; +use Test::More; + sub capture_hints { my $code = shift; - my ($hints, $warning_bits); $code .= q{ ; - BEGIN { - # ignore lexicalized hints - $hints = $^H & ~ 0x20000; - $warning_bits = defined ${^WARNING_BITS} ? (unpack "H*", ${^WARNING_BITS}) : undef; - }; - 1; + my @h; + BEGIN { @h = ( $^H, ${^WARNING_BITS} ) } + @h; }; - eval $code or die $@; + my ($hints, $warning_bits) = _eval $code or die $@; + # ignore lexicalized hints + $hints &= ~ 0x20000; + $warning_bits = unpack "H*", $warning_bits + if defined $warning_bits; return ($hints, $warning_bits); } -use strict; -use warnings; -use Test::More qw(no_plan); - sub compare_hints { my ($code_want, $code_got, $name) = @_; my ($want_hints, $want_warnings) = capture_hints $code_want; @@ -54,7 +58,25 @@ my $v; eval { $v = strictures->VERSION; 1 } or diag $@; is $v, $strictures::VERSION, '->VERSION returns version correctly'; -eval q{ use strictures 3; }; +my $next = int $strictures::VERSION + 1; +eval qq{ use strictures $next; }; + +like $@, qr/strictures version $next required/, + "Can't use strictures $next (this is version $v)"; + +eval qq{ use strictures {version => $next}; }; + +like $@, qr/Major version specified as $next - not supported/, + "Can't use strictures version option $next (this is version $v)"; + +eval qq{ use strictures {version => undef}; }; + +like $@, qr/Major version specified as undef - not supported/, + "Can't use strictures version option undef"; + +eval qq{ use strictures $strictures::VERSION; }; + +is $@, '', + "Can use current strictures version"; -like $@, qr/strictures version 3 required/, - "Can't use strictures 3 (this is version 2)"; +done_testing;