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