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