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