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 {
  34   use strict;
  35   BEGIN {
  36     warnings->import('all');
  37     warnings->import(FATAL => @strictures::WARNING_CATEGORIES);
  38     warnings->import(NONFATAL => @strictures::V2_NONFATAL);
  39     warnings->unimport(@strictures::V2_DISABLE);
  40   }
  41   BEGIN { capture_hints }
  42 }
  43
  44 {
  45   use strictures 2;
  46   BEGIN { test_hints "version 2" }
  47 }
  48
  49 my $v;
  50 eval { $v = strictures->VERSION; 1 } or diag $@;
  51 is $v, $strictures::VERSION, '->VERSION returns version correctly';
  52
  53 ok(!eval q{use strictures 3; 1; }, "Can't use strictures 3 (this is version 2)");