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