1BEGIN { 2 if ($ENV{'PERL_CORE'}){ 3 chdir 't'; 4 unshift @INC, '../lib'; 5 } 6 require Config; import Config; 7 if ($Config{'extensions'} !~ /\bEncode\b/) { 8 print "1..0 # Skip: Encode was not built\n"; 9 exit 0; 10 } 11 $| = 1; 12} 13 14use strict; 15use utf8; 16use Test::More tests => 777; 17use Encode; 18use Encode::GSM0338; 19 20my $chk = Encode::LEAVE_SRC(); 21 22# escapes 23# see https://www.3gpp.org/dynareport/23038.htm 24# see https://www.etsi.org/deliver/etsi_ts/123000_123099/123038/15.00.00_60/ts_123038v150000p.pdf (page 22) 25my %esc_seq = ( 26 "\x{20ac}" => "\x1b\x65", 27 "\x0c" => "\x1b\x0A", 28 "[" => "\x1b\x3C", 29 "\\" => "\x1b\x2F", 30 "]" => "\x1b\x3E", 31 "^" => "\x1b\x14", 32 "{" => "\x1b\x28", 33 "|" => "\x1b\x40", 34 "}" => "\x1b\x29", 35 "~" => "\x1b\x3D", 36); 37 38my %unesc_seq = reverse %esc_seq; 39 40 41sub eu{ 42 $_[0] =~ /[\x00-\x1f]/ ? 43 sprintf("\\x{%04X}", ord($_[0])) : encode_utf8($_[0]); 44 45} 46 47for my $c ( map { chr } 0 .. 127 ) { 48 next if $c eq "\x1B"; # escape character, start of multibyte sequence 49 my $u = $Encode::GSM0338::GSM2UNI{$c}; 50 51 # default character set 52 is decode( "gsm0338", $c, $chk ), $u, 53 sprintf( "decode \\x%02X", ord($c) ); 54 eval { decode( "gsm0338", $c . "\xff", $chk | Encode::FB_CROAK ) }; 55 ok( $@, $@ ); 56 is encode( "gsm0338", $u, $chk ), $c, sprintf( "encode %s", eu($u) ); 57 eval { encode( "gsm0338", $u . "\x{3000}", $chk | Encode::FB_CROAK ) }; 58 ok( $@, $@ ); 59 60 is decode( "gsm0338", "\x00" . $c ), '@' . decode( "gsm0338", $c ), 61 sprintf( '@: decode \x00+\x%02X', ord($c) ); 62 63 # escape seq. 64 my $ecs = "\x1b" . $c; 65 if ( $unesc_seq{$ecs} ) { 66 is decode( "gsm0338", $ecs, $chk ), $unesc_seq{$ecs}, 67 sprintf( "ESC: decode ESC+\\x%02X", ord($c) ); 68 is encode( "gsm0338", $unesc_seq{$ecs}, $chk ), $ecs, 69 sprintf( "ESC: encode %s ", eu( $unesc_seq{$ecs} ) ); 70 } 71 else { 72 is decode( "gsm0338", $ecs, $chk ), 73 "\x{FFFD}", 74 sprintf( "decode ESC+\\x%02X", ord($c) ); 75 } 76} 77 78# https://rt.cpan.org/Ticket/Display.html?id=75670 79is decode("gsm0338", "\x09") => chr(0xC7), 'RT75670: decode'; 80is encode("gsm0338", chr(0xC7)) => "\x09", 'RT75670: encode'; 81 82# https://rt.cpan.org/Public/Bug/Display.html?id=124571 83is decode("gsm0338", encode('gsm0338', '..@@..')), '..@@..'; 84is decode("gsm0338", encode('gsm0338', '..@���..')), '..@���..'; 85 86# special GSM sequence, ��� is at 1024 byte buffer boundary 87my $gsm = "\x41" . "\x1B\x65" x 1024; 88open my $fh, '<:encoding(gsm0338)', \$gsm or die; 89my $uni = <$fh>; 90close $fh; 91is $uni, "A" . "���" x 1024, 'PerlIO encoding(gsm0338) read works'; 92