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 => 56 * 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 = new->new;
  90 ####
  91 $obj = new->new; # new new
  92 ####
  93 $obj = new->newnew;
  94 ####
  95 $obj = newnew->new;
  96 ####
  97 $obj = Hlagh->$cb;
  98 ####
  99 $obj = Hlagh->$cb();
 100 ####
 101 $obj = Hlagh->$cb($pkg);
 102 ####
 103 $obj = Hlagh->$cb(sub { 'foo' },  bar => $obj);
 104 ####
 105 $obj = $pkg->new   ;
 106 ####
 107 $obj = $pkg  ->   new  (   );
 108 ####
 109 $obj = $pkg
 110            ->
 111         new ( $pkg );
 112 ####
 113 $obj =
 114          $pkg
 115 ->
 116 new        (     qr/foo/,
 117       foo => qr/bar/   );
 118 ####
 119 $obj
 120   =
 121 $pkg
 122 ->
 123 $cb
 124 ;
 125 ####
 126 $obj = $pkg    ->   ($cb)   ();
 127 ####
 128 $obj = $pkg->$cb( $obj  );
 129 ####
 130 $obj = $pkg->$cb(qw/foo bar baz/);
 131 ####
 132 $obj = new { $x };
 133 ####
 134 $obj = new
 135   {
 136      $x  }
 137   ();
 138 ####
 139 $obj = new {
 140   $x  } qq/foo/;
 141 ####
 142 $obj = new
 143    {
 144       $x
 145     }(qw/bar baz/);
 146 ####
 147 meh;
 148 ####
 149 meh $_;
 150 ####
 151 meh $x;
 152 ####
 153 meh $x, 1, 2;
 154 ####
 155 meh $y;
 156 ####
 157 meh $y, 1, 2;
 158 #### $] < 5.010 # use feature 'state'; state $z
 159 meh $z;
 160 #### $] < 5.010 # use feature 'state'; state $z
 161 meh $z, 1, 2;
 162 ####
 163 print;
 164 ####
 165 print $_;
 166 ####
 167 print $x;
 168 ####
 169 print $x "oh hai\n";
 170 ####
 171 print $y;
 172 ####
 173 print $y "dongs\n";
 174 #### $] < 5.010 # use feature 'state'; state $z
 175 print $z;
 176 #### $] < 5.010 # use feature 'state'; state $z
 177 print $z "hlagh\n";
 178 ####
 179 print STDOUT "bananananananana\n";
 180 ####
 181 $x->foo($pkg->$cb)
 182 ####
 183 $obj = "apple ${\(new Hlagh)} pear"
 184 ####
 185 $obj = "apple @{[new Hlagh]} pear"
 186 ####
 187 exec $x $x, @a;
 188 ####
 189 exec { $a[0] } @a;
 190 ####
 191 system $x $x, @a;
 192 ####
 193 system { $a[0] } @a;