diff options
| -rw-r--r-- | t/comp/require.t | 9 | ||||
| -rw-r--r-- | t/comp/utf.t | 18 | ||||
| -rw-r--r-- | t/porting/diag.t | 8 | ||||
| -rw-r--r-- | toke.c | 22 |
4 files changed, 36 insertions, 21 deletions
diff --git a/t/comp/require.t b/t/comp/require.t index baf48870a3..988a102103 100644 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -266,9 +266,9 @@ EOT if ($Is_EBCDIC || $Is_UTF8) { exit; } my %templates = ( - utf8 => 'C0U', - utf16be => 'n', - utf16le => 'v', + 'UTF-8' => 'C0U', + 'UTF-16BE' => 'n', + 'UTF-16LE' => 'v', ); sub bytes_to_utf { @@ -280,6 +280,9 @@ sub bytes_to_utf { foreach (sort keys %templates) { $i++; do_require(bytes_to_utf($_, qq(print "ok $i # $_\\n"; 1;\n), 1)); + if ($@ =~ /^(Unsupported script encoding \Q$_\E)/) { + print "ok $i # skip $1\n"; + } } END { diff --git a/t/comp/utf.t b/t/comp/utf.t index 1e0e68a0e4..f5190f9eeb 100644 --- a/t/comp/utf.t +++ b/t/comp/utf.t @@ -4,9 +4,9 @@ print "1..4016\n"; my $test = 0; my %templates = ( - utf8 => 'C0U', - utf16be => 'n', - utf16le => 'v', + 'UTF-8' => 'C0U', + 'UTF-16BE' => 'n', + 'UTF-16LE' => 'v', ); sub bytes_to_utf { @@ -14,7 +14,7 @@ sub bytes_to_utf { my $template = $templates{$enc}; die "Unsupported encoding $enc" unless $template; my @chars = unpack "U*", $content; - if ($enc ne 'utf8') { + if ($enc ne 'UTF-8') { # Make surrogate pairs my @remember_that_utf_16_is_variable_length; foreach my $ord (@chars) { @@ -41,7 +41,11 @@ sub test { my $got = do "./utf$$.pl"; $test = $test + 1; if (!defined $got) { - print "not ok $test # $enc $bom $nl $name; got undef\n"; + if ($@ =~ /^(Unsupported script encoding \Q$enc\E)/) { + print "ok $test # skip $1\n"; + } else { + print "not ok $test # $enc $bom $nl $name; got undef\n"; + } } elsif ($got ne $expect) { print "not ok $test # $enc $bom $nl $name; got '$got'\n"; } else { @@ -50,7 +54,7 @@ sub test { } for my $bom (0, 1) { - for my $enc (qw(utf16le utf16be utf8)) { + for my $enc (qw(UTF-16LE UTF-16BE UTF-8)) { for my $nl (1, 0) { for my $value (123, 1234, 12345) { test($enc, $value, $value, $bom, $nl, $value); @@ -58,7 +62,7 @@ for my $bom (0, 1) { # loop without the bug fix it corresponds to: test($enc, "($value)", $value, $bom, $nl, "($value)"); } - next if $enc eq 'utf8'; + next if $enc eq 'UTF-8'; # Arguably a bug that currently string literals from UTF-8 file # handles are not implicitly "use utf8", but don't FIXME that # right now, as here we're testing the input filter itself. diff --git a/t/porting/diag.t b/t/porting/diag.t index 66e5a21afa..14c2f848cb 100644 --- a/t/porting/diag.t +++ b/t/porting/diag.t @@ -358,10 +358,10 @@ Unknown PerlIO layer "scalar" Unknown Unicode option letter '%c' unrecognised control character '%c' Unstable directory path, current directory changed unexpectedly -Unsupported script encoding UTF16-BE -Unsupported script encoding UTF16-LE -Unsupported script encoding UTF32-BE -Unsupported script encoding UTF32-LE +Unsupported script encoding UTF-16BE +Unsupported script encoding UTF-16LE +Unsupported script encoding UTF-32BE +Unsupported script encoding UTF-32LE Unterminated compressed integer in unpack Usage: CODE(0x%x)(%s) Usage: %s(%s) @@ -13287,17 +13287,17 @@ S_swallow_bom(pTHX_ U8 *s) switch (s[0]) { case 0xFF: if (s[1] == 0xFE) { - /* UTF-16 little-endian? (or UTF32-LE?) */ + /* UTF-16 little-endian? (or UTF-32LE?) */ if (s[2] == 0 && s[3] == 0) /* UTF-32 little-endian */ - Perl_croak(aTHX_ "Unsupported script encoding UTF32-LE"); + Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE"); #ifndef PERL_NO_UTF16_FILTER - if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF16-LE script encoding (BOM)\n"); + if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n"); s += 2; if (PL_bufend > (char*)s) { s = add_utf16_textfilter(s, TRUE); } #else - Perl_croak(aTHX_ "Unsupported script encoding UTF16-LE"); + Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE"); #endif } break; @@ -13310,7 +13310,7 @@ S_swallow_bom(pTHX_ U8 *s) s = add_utf16_textfilter(s, FALSE); } #else - Perl_croak(aTHX_ "Unsupported script encoding UTF16-BE"); + Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE"); #endif } break; @@ -13325,15 +13325,19 @@ S_swallow_bom(pTHX_ U8 *s) if (s[1] == 0) { if (s[2] == 0xFE && s[3] == 0xFF) { /* UTF-32 big-endian */ - Perl_croak(aTHX_ "Unsupported script encoding UTF32-BE"); + Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE"); } } else if (s[2] == 0 && s[3] != 0) { /* Leading bytes * 00 xx 00 xx * are a good indicator of UTF-16BE. */ +#ifndef PERL_NO_UTF16_FILTER if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n"); - s = add_utf16_textfilter(s, FALSE); + s = add_utf16_textfilter(s, FALSE); +#else + Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE"); +#endif } } #ifdef EBCDIC @@ -13350,8 +13354,12 @@ S_swallow_bom(pTHX_ U8 *s) /* Leading bytes * xx 00 xx 00 * are a good indicator of UTF-16LE. */ +#ifndef PERL_NO_UTF16_FILTER if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n"); s = add_utf16_textfilter(s, TRUE); +#else + Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE"); +#endif } } return (char*)s; |