| Subject: | Test (and fails) of exotic characters in sub names |
The attached test raises 3 issues:
* S::N should probably check for \0 in the supplied string
* Is unicode allowed or not? See comment in-test, seems to work
* What is so special about q{'} that it breaks everything...?
My results:
t/exotic_names.t .. 1/517
# Failed test 'null-in-name throws correctly'
# at t/exotic_names.t line 22.
# Failed test 'Sub named properly when name contains \x{27}'
# at t/exotic_names.t line 38.
# got: 'test::E'
# expected: 'test::B'E'
# Failed test 'caller() works'
# at t/exotic_names.t line 46.
# got: '__ANON__::E'
# expected: 'test::B'E'
# Looks like you failed 3 tests of 517.
t/exotic_names.t .. Dubious, test returned 3 (wstat 768, 0x300)
Failed 3/517 subtests
Test Summary Report
-------------------
t/exotic_names.t (Wstat: 768 Tests: 517 Failed: 3)
Failed tests: 1, 78-79
Non-zero exit status: 3
Files=1, Tests=517, 0 wallclock secs ( 0.10 usr 0.03 sys + 0.15 cusr
0.02 csys = 0.30 CPU)
Result: FAIL
| Subject: | exotic_names.t |
#!/usr/bin/perl
use Sub::Name 'subname';
use B 'svref_2object';
use Test::More;
# ascii + some unicode
my @test_chars = ( 1 .. 255 );
# add unicode if the perl is capable
if ($] > 5.008) {
push @test_chars, 256, 338, 1176;
}
plan tests => @test_chars * 2 + 1;
# The GV-related strings are read until first \0, as such
# the code should sanity check and throw instead of effectively
# truncating the resulting name
eval { my $c = subname "B\x00E" => sub { 1 } };
ok ($@, 'null-in-name throws correctly');
for (@test_chars) {
my $expected = my $name = sprintf ('test::B%cE', $_);
# REVIEW - there is no unicode flag in the GV, so we will get
# back the raw bytes. Imho it is still benefitial to do high-char
# assignments, given that they will render properly on-screen and
# in logs
if ($_ > 255) {
# check for 5.008 sbove guarantees availability
utf8::encode($expected);
}
my $me;
my $c = subname $name => sub { $me = (caller(0))[3] };
is (
'test::' . svref_2object($c)->GV->NAME,
$expected,
sprintf ('Sub named properly when name contains \x{%X}', $_ )
);
$c->();
is (
$me,
$expected,
'caller() works',
);
}