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