use strict; use warnings; use Test::More tests => 2 * ( 2 + 6 + 6 ); use Carp qw( croak ); sub avoid_utf8 { my ($s) = @_; utf8::downgrade($s, 1) or croak("Input not a string of bytes"); return $s; } sub use_utf8 { my ($s) = @_; utf8::upgrade($s); return $s; } diag("Perl $]"); for ( [ "bj\x{f6}rk", 5, 'hibit' ], [ "b" x 1000, 1000, 'long' ], ) { my ($s, $length, $test_name) = @$_; # length my %length; $length{'0'} = length avoid_utf8 $s; $length{'1'} = length use_utf8 $s; for my $enc (qw( 0 1 )) { is($length{$enc}, $length, "length $test_name $enc"); } # pack 'V/a*' my $expected = pack('V', $length) . $s; my %packed; $packed{'?0'} = pack "V/a*", avoid_utf8 $s; $packed{'?1'} = pack "V/a*", use_utf8 $s; $packed{'00'} = avoid_utf8 pack "V/a*", avoid_utf8 $s; $packed{'01'} = avoid_utf8 pack "V/a*", use_utf8 $s; $packed{'10'} = use_utf8 pack "V/a*", avoid_utf8 $s; $packed{'11'} = use_utf8 pack "V/a*", use_utf8 $s; for my $enc (qw( ?0 ?1 00 01 10 11 )) { ok($packed{$enc} eq $expected, "pack $test_name $enc"); } # print for my $enc (qw( ?0 ?1 00 01 10 11 )) { my $buf = ''; { open(my $fh, '>', \$buf); binmode $fh; # No mucking with crlf print $fh $packed{$enc}; } ok($buf eq $expected, "print $test_name $enc"); } }