]> git.vpit.fr Git - perl/modules/indirect.git/blob - 20-good.t
4a7c3a0fa0fa6e7860787e759ac4e0725860e5de
[perl/modules/indirect.git] / 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; };