X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fexotic_names.t;h=06d64842dec47eabb16f0725b8fc7c63767a414e;hb=f0c9441e86875712754fd4cc816aff82e8e51a2c;hp=eb7c4a6cf0d142aeebf319a3f588c1b566dd4b90;hpb=67415d50e56340a222b0ceaedb48fe0bea2730a8;p=p5sagit%2FSub-Name.git diff --git a/t/exotic_names.t b/t/exotic_names.t index eb7c4a6..06d6484 100644 --- a/t/exotic_names.t +++ b/t/exotic_names.t @@ -54,7 +54,13 @@ sub caller3_ok { is $stash_name, $expected, "stash name for $type is correct $for_what"; is $sub->(), $expected, "caller() in $type returns correct name $for_what"; - ok $DB::sub{$expected}, "%DB::sub entry for $type is correct $for_what"; + SKIP: { + skip '%DB::sub not populated when enabled at runtime', 1 + unless keys %DB::sub; + my ($prefix) = $expected =~ /^(.*?test::[^:]+::)/; + my ($db_found) = grep /^$prefix/, keys %DB::sub; + is $db_found, $expected, "%DB::sub entry for $type is correct $for_what"; + } } ####################################################################### @@ -99,9 +105,18 @@ for my $ord (@ordinal) { $sub = compile_named_sub $expected => '(caller(0))[3]'; } else { # not a legal identifier but at least test the package name by aliasing - $expected = "${pkg}::foo"; - { no strict 'refs'; *palatable:: = *{"${pkg}::"} } # now palatable:: literally means ${pkg}:: - $sub = compile_named_sub 'palatable::foo' => '(caller(0))[3]'; + $expected = "aliased::native::$fullname"; + { + no strict 'refs'; + *palatable:: = *{"aliased::native::${pkg}::"}; + # now palatable:: literally means aliased::native::${pkg}:: + my $encoded_sub = $subname; + utf8::encode($encoded_sub) if "$]" < 5.016 and $ord > 255; + ${"palatable::$encoded_sub"} = 1; + ${"palatable::"}{"sub"} = ${"palatable::"}{$encoded_sub}; + # and palatable::sub means aliased::native::${pkg}::${subname} + } + $sub = compile_named_sub 'palatable::sub' => '(caller(0))[3]'; } caller3_ok $sub, $expected, 'natively compiled sub', $ord; }