t/20-good.t

   1 #!perl -T
   2
   3 package Dongs;
   4
   5 sub new;
   6
   7 package main;
   8
   9 use strict;
  10 use warnings;
  11
  12 use Test::More tests => 52 * 4;
  13
  14 my ($obj, $pkg, $cb, $x, @a);
  15 our $y;
  16 sub meh;
  17
  18 {
  19  local $/ = "####";
  20  while (<DATA>) {
  21   chomp;
  22   s/\s*$//;
  23   s/(.*?)$//m;
  24   my ($skip, $prefix) = split /#+/, $1;
  25   $skip   = 0  unless defined $skip;
  26   $prefix = '' unless defined $prefix;
  27   s/\s*//;
  28
  29 SKIP:
  30   {
  31    skip "$_: $skip" => 4 if eval $skip;
  32
  33    local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) };
  34
  35    eval "die qq{ok\\n}; $prefix; use indirect; $_";
  36    is($@, "ok\n", "use indirect: $_");
  37
  38    eval "die qq{ok\n}; $prefix; no indirect; $_";
  39    is($@, "ok\n", "no indirect: $_");
  40
  41    s/Hlagh/Dongs/g;
  42
  43    eval "die qq{ok\\n}; $prefix; use indirect; $_";
  44    is($@, "ok\n", "use indirect, defined: $_");
  45
  46    eval "die qq{ok\\n}; $prefix; no indirect; $_";
  47    is($@, "ok\n", "no indirect, defined: $_");
  48   }
  49  }
  50 }
  51
  52 __DATA__
  53
  54 $obj = Hlagh->new;
  55 ####
  56 $obj = Hlagh->new();
  57 ####
  58 $obj = Hlagh->new(1);
  59 ####
  60 $obj = Hlagh->new(q{foo}, bar => $obj);
  61 ####
  62 $obj = Hlagh   ->   new   ;
  63 ####
  64 $obj = Hlagh   ->   new   (   )   ;
  65 ####
  66 $obj = Hlagh   ->   new   (   1   )   ;
  67 ####
  68 $obj = Hlagh   ->   new   (   'foo'   ,   bar =>   $obj   );
  69 ####
  70 $obj = Hlagh
  71             ->
  72                           new   ;
  73 ####
  74 $obj = Hlagh
  75
  76       ->
  77 new   (
  78  )   ;
  79 ####
  80 $obj = Hlagh
  81                                        ->   new   (
  82                1   )   ;
  83 ####
  84 $obj = Hlagh   ->
  85                               new   (   "foo"
  86   ,    bar
  87                =>        $obj       );
  88 ####
  89 $obj = Hlagh->$cb;
  90 ####
  91 $obj = Hlagh->$cb();
  92 ####
  93 $obj = Hlagh->$cb($pkg);
  94 ####
  95 $obj = Hlagh->$cb(sub { 'foo' },  bar => $obj);
  96 ####
  97 $obj = $pkg->new   ;
  98 ####
  99 $obj = $pkg  ->   new  (   );
 100 ####
 101 $obj = $pkg
 102            ->
 103         new ( $pkg );
 104 ####
 105 $obj =
 106          $pkg
 107 ->
 108 new        (     qr/foo/,
 109       foo => qr/bar/   );
 110 ####
 111 $obj
 112   =
 113 $pkg
 114 ->
 115 $cb
 116 ;
 117 ####
 118 $obj = $pkg    ->   ($cb)   ();
 119 ####
 120 $obj = $pkg->$cb( $obj  );
 121 ####
 122 $obj = $pkg->$cb(qw/foo bar baz/);
 123 ####
 124 $obj = new { $x };
 125 ####
 126 $obj = new
 127   {
 128      $x  }
 129   ();
 130 ####
 131 $obj = new {
 132   $x  } qq/foo/;
 133 ####
 134 $obj = new
 135    {
 136       $x
 137     }(qw/bar baz/);
 138 ####
 139 meh;
 140 ####
 141 meh $_;
 142 ####
 143 meh $x;
 144 ####
 145 meh $x, 1, 2;
 146 ####
 147 meh $y;
 148 ####
 149 meh $y, 1, 2;
 150 #### $] < 5.010 # use feature 'state'; state $z
 151 meh $z;
 152 #### $] < 5.010 # use feature 'state'; state $z
 153 meh $z, 1, 2;
 154 ####
 155 print;
 156 ####
 157 print $_;
 158 ####
 159 print $x;
 160 ####
 161 print $x "oh hai\n";
 162 ####
 163 print $y;
 164 ####
 165 print $y "dongs\n";
 166 #### $] < 5.010 # use feature 'state'; state $z
 167 print $z;
 168 #### $] < 5.010 # use feature 'state'; state $z
 169 print $z "hlagh\n";
 170 ####
 171 print STDOUT "bananananananana\n";
 172 ####
 173 $x->foo($pkg->$cb)
 174 ####
 175 $obj = "apple ${\(new Hlagh)} pear"
 176 ####
 177 $obj = "apple @{[new Hlagh]} pear"
 178 ####
 179 exec $x $x, @a;
 180 ####
 181 exec { $a[0] } @a;
 182 ####
 183 system $x $x, @a;
 184 ####
 185 system { $a[0] } @a;