14 use open qw( :utf8 :std );
18 #These come from op/my_stash.t
20 use constant Myクラス => 'ꕽ::Ʉ::ꔬz::ꢨᙇ';
27 for (qw(ꕽ ꕽ:: Myクラス __PACKAGE__)) {
28 eval "sub { my $_ \$obj = shift; }";
29 ok ! $@, "op/my_stash.t test, $_";
32 use constant NòClàss => '노pӬ::ꕽ::Ꜻ::BӢz::ʙࡆ';
34 for (qw(노pӬ 노pӬ:: NòClàss)) {
35 eval "sub { my $_ \$obj = shift; }";
36 ok $@, "op/my_stash.t test";
43 $본go::ଶfʦbᚒƴ::scalar = 1;
47 # now tests with strictures
51 ok( !exists $piƓ::{bodine}, q(referencing a non-existent stash element doesn't produce stricture errors) );
55 eval { require B; 1 } or skip "no B", 28;
57 *b = \&B::svref_2object;
58 my $CVf_ANON = B::CVf_ANON();
67 object_ok( $gv, "B::GV", "deleted stash entry leaves CV with valid GV");
68 is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
69 is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
70 is( eval { $gv->STASH->NAME }, "온ꪵ", "...but leaves stash intact");
79 object_ok( $gv, "B::GV", "cleared stash leaves CV with valid GV");
80 is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
81 is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
82 is( eval { $gv->STASH->NAME }, "tꖿ", "...but leaves stash intact");
91 object_ok( $gv, "B::GV", "undefed stash leaves CV with valid GV");
92 is( b($sub)->CvFLAGS & $CVf_ANON, $CVf_ANON, "...and CVf_ANON set");
93 is( eval { $gv->NAME }, "__ANON__", "...and an __ANON__ name");
94 is( eval { $gv->STASH->NAME }, "__ANON__", "...and an __ANON__ stash");
102 my $gv = B::svref_2object($sub)->GV;
103 ok($gv->isa(q/B::GV/), "cleared stash leaves anon CV with valid GV");
105 my $st = eval { $gv->STASH->NAME };
106 is($st, q/ꃖᚢ/, "...but leaves the stash intact");
114 $gv = B::svref_2object($sub)->GV;
115 ok($gv->isa(q/B::GV/), "undefed stash leaves anon CV with valid GV");
117 $st = eval { $gv->STASH->NAME };
119 { local $TODO = 'STASHES not anonymized';
120 is($st, q/__ANON__/, "...and an __ANON__ stash");
127 my $stash_glob = delete $::{"sӥㄒ::"};
128 # Now free the GV while the stash still exists (though detached)
129 delete $$stash_glob{"sӥㄒ"};
130 $gv = B::svref_2object($sub)->GV;
131 ok($gv->isa(q/B::GV/),
132 'anonymised CV whose stash is detached still has a GV');
133 #fails because mro_gather_and_rename isn't clean
134 is $gv->STASH->NAME, '__ANON__',
135 'CV anonymised when its stash is detached becomes __ANON__::__ANON__';
137 # CvSTASH should be null on a named sub if the stash has been deleted
144 my $cv = B::svref_2object($rfoo);
145 # (is there a better way of testing for NULL ?)
146 my $stash = $cv->STASH;
147 like($stash, qr/B::SPECIAL/, "NULL CvSTASH on named sub");
150 # on glob reassignment, orphaned CV should have anon CvGV
161 my $cv = B::svref_2object($r);
163 ok($gv->isa(q/B::GV/), "orphaned CV has valid GV");
164 is($gv->NAME, '__ANON__', "orphaned CV has anon GV");
167 # deleting __ANON__ glob shouldn't break things
173 my $남えㄉ = eval q[\&남えㄉ];
175 delete $FŌŌ3::{남えㄉ}; # make named anonymous
177 delete $FŌŌ3::{__ANON__}; # whoops!
179 $cv = B::svref_2object($남えㄉ);
181 ok($gv->isa(q/B::GV/), "ex-named CV has valid GV");
182 is($gv->NAME, '__ANON__', "ex-named CV has anon GV");
184 $cv = B::svref_2object($anon);
186 ok($gv->isa(q/B::GV/), "anon CV has valid GV");
187 is($gv->NAME, '__ANON__', "anon CV has anon GV");
200 my $br = B::svref_2object($r);
201 is ($br->STASH->NAME, 'bᓙṗ',
202 'stub records the package it was compiled in');
204 # We need to take this reference "late", after the subroutine is
206 $br = B::svref_2object(eval 'sub Ẃⱒcᴷ {}; \&Ẃⱒcᴷ');
209 is ($br->STASH->NAME, 'main',
210 'definition overrides the package it was compiled in');
211 like ($br->FILE, qr/eval/,
212 'definition overrides the file it was compiled in');
216 # make sure having a sub called __ANON__ doesn't confuse perl.
221 sub __ANON__ { $c = (caller(0))[3]; }
225 ::like($@, qr/^Undefined subroutine &クラス::ok/);
228 ::is ($c, 'クラス::__ANON__', '__ANON__ sub called ok');
231 # Stashes that are effectively renamed
240 # effectively rename a stash
241 *slìn:: = *rìle::; *rìle:: = *zòr::;
243 ::is *$globref, "*rìle::tàt",
244 'globs stringify the same way when stashes are moved';
245 ::is ref $obj, "rìle",
246 'ref() returns the same thing when an object’s stash is moved';
247 ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z",
248 'objects stringify the same way when their stashes are moved';
249 ::is eval '__PACKAGE__', 'rìle',
250 '__PACKAGE__ returns the same when the current stash is moved';
252 # Now detach it completely from the symtab, making it effect-
254 my $life_raft = \%slìn::;
257 ::is *$globref, "*rìle::tàt",
258 'globs stringify the same way when stashes are detached';
259 ::is ref $obj, "rìle",
260 'ref() returns the same thing when an object’s stash is detached';
261 ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z",
262 'objects stringify the same way when their stashes are detached';
263 ::is eval '__PACKAGE__', 'rìle',
264 '__PACKAGE__ returns the same when the current stash is detached';
267 # Setting the name during undef %stash:: should have no effect.
269 my $glob = \*Phòò::glòb;
270 sub ò::DESTROY { eval '++$Phòò::bòr' }
272 ${"Phòò::thòng1"} = bless [], "ò";
274 is "$$glob", "*__ANON__::glòb",
275 "setting stash name during undef has no effect";
278 # [perl #88134] incorrect package structure
283 ok eval { Bèàr::::bàz() },
284 'packages ending with :: are self-consistent';
287 # [perl #88138] ' not equivalent to :: before a null
289 is ${"à::\0b"}, "c", "' is equivalent to :: before a null";