set filehandle encodings in a shorter way
[p5sagit/Sub-Name.git] / t / exotic_names.t
index eb7c4a6..d5f87f2 100644 (file)
@@ -12,12 +12,7 @@ BEGIN { $^P |= 0x210 }
 # a heuristic with ambiguous eval and looking for octets in the stash
 use if "$]" >= 5.016, feature => 'unicode_eval';
 
-if ("$]" >= 5.008) {
-    my $builder = Test::More->builder;
-    binmode $builder->output,         ":encoding(utf8)";
-    binmode $builder->failure_output, ":encoding(utf8)";
-    binmode $builder->todo_output,    ":encoding(utf8)";
-}
+use if "$]" >= 5.008, open => ':std', ':encoding(UTF-8)'; # force stdin, stdout, stderr into utf8
 
 sub compile_named_sub {
     my ( $fullname, $body ) = @_;
@@ -54,7 +49,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 +100,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;
 }