t/strictures.t

   1 BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 }
   2
   3 use Test::More qw(no_plan);
   4
   5 our ($hints, $warning_bits);
   6
   7 sub capture_hints {
   8   # ignore lexicalized hints
   9   $hints = $^H & ~ 0x20000;
  10   $warning_bits = defined ${^WARNING_BITS} ? (unpack "H*", ${^WARNING_BITS}) : undef;
  11 }
  12
  13 sub test_hints {
  14   my $name = shift;
  15   my $want_hints = $hints;
  16   my $want_bits = $warning_bits;
  17   capture_hints;
  18   is($hints,        $want_hints, "Hints ok for $name");
  19   is($warning_bits, $want_bits,  "Warnings ok for $name");
  20 }
  21
  22 {
  23   use strict;
  24   use warnings FATAL => 'all';
  25   BEGIN { capture_hints }
  26 }
  27
  28 {
  29   use strictures 1;
  30   BEGIN { test_hints "version 1" }
  31 }
  32
  33 my $v;
  34 eval { $v = strictures->VERSION; 1 } or diag $@;
  35 is $v, $strictures::VERSION, '->VERSION returns version correctly';
  36
  37 ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)");