t/20-bad.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 30 * 2 + 2;
   7
   8 my ($obj, $x);
   9
  10 {
  11  local $/ = "####\n";
  12  while (<DATA>) {
  13   chomp;
  14   {
  15    use indirect;
  16    local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) };
  17    eval "die qq{ok\\n}; $_";
  18   }
  19   is($@, "ok\n", $_);
  20   {
  21    no indirect;
  22    local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) };
  23    eval "die qq{the code compiled but it shouldn't have\n}; $_";
  24   }
  25   like($@, qr/^warn:Indirect\s+call\s+of\s+method\s+"(?:new|meh|HlaghHlagh)"\s+on\s+object\s+"(?:Hlagh|newnew|\$x|\$_)"/, $_);
  26  }
  27 }
  28
  29 eval {
  30  no indirect 'hlagh';
  31  my $warn;
  32  local $SIG{__WARN__} = sub { $warn = join ' ', @_ };
  33  eval "die qq{the code compiled but it shouldn't have\n}; \$obj = new Hlagh1;";
  34  like($warn, qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"Hlagh1"/, 'no indirect "hlagh" enables the pragma');
  35  eval "die qq{the code compiled but it shouldn't have\n}; \$obj = new Hlagh2;";
  36  like($warn, qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"Hlagh2"/, 'no indirect "hlagh" doesn\'t croak');
  37 }
  38
  39 __DATA__
  40 $obj = new Hlagh;
  41 ####
  42 $obj = new Hlagh();
  43 ####
  44 $obj = new Hlagh(1);
  45 ####
  46 $obj = new Hlagh(1, 2);
  47 ####
  48 $obj = new        Hlagh            ;
  49 ####
  50 $obj = new        Hlagh     (      )      ;
  51 ####
  52 $obj = new        Hlagh     (      1        )     ;
  53 ####
  54 $obj = new        Hlagh     (      1        ,       2        )     ;
  55 ####
  56 $obj = new
  57                       Hlagh
  58         ;
  59 ####
  60 $obj = new
  61                                        Hlagh     (
  62                   )      ;
  63 ####
  64 $obj =
  65               new
  66     Hlagh     (      1
  67             )     ;
  68 ####
  69 $obj =
  70 new
  71 Hlagh
  72                    (      1        ,
  73                 2        )     ;
  74 ####
  75 $obj = new $x;
  76 ####
  77 $obj = new $x();
  78 ####
  79 $obj = new $x('foo');
  80 ####
  81 $obj = new $x qq{foo}, 1;
  82 ####
  83 $obj = new $x qr{foo\s+bar}, 1 .. 1;
  84 ####
  85 $obj = new $x(qw/bar baz/);
  86 ####
  87 $obj = new
  88           $_;
  89 ####
  90 $obj = new
  91              $_     (        );
  92 ####
  93 $obj = new $_      qr/foo/  ;
  94 ####
  95 $obj = new $_     qq(bar baz);
  96 ####
  97 meh $x;
  98 ####
  99 meh $x, 1, 2;
 100 ####
 101 $obj = HlaghHlagh Hlagh;
 102 ####
 103 $obj = HlaghHlagh Hlagh; # HlaghHlagh Hlagh
 104 ####
 105 $obj = new newnew;
 106 ####
 107 $obj = new newnew; # new newnew
 108 ####
 109 new Hlagh (meh $x)
 110 ####
 111 Hlagh->new(meh $x)