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->unimport(FATAL => @strictures::V2_NONFATAL);
  39     warnings->import(@strictures::V2_NONFATAL);
  40     warnings->unimport(@strictures::V2_DISABLE);
  41   }
  42   BEGIN { capture_hints }
  43 }
  44
  45 {
  46   use strictures 2;
  47   BEGIN { test_hints "version 2" }
  48 }
  49
  50 my $v;
  51 eval { $v = strictures->VERSION; 1 } or diag $@;
  52 is $v, $strictures::VERSION, '->VERSION returns version correctly';
  53
  54 eval q{ use strictures 3; };
  55
  56 like $@, qr/strictures version 3 required/,
  57   "Can't use strictures 3 (this is version 2)";