In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/d5b98071c9e3e7e1d15e5358ad2316f3928fb05d?hp=237050634b19905cdd9e8e25c2a43d0b24eb59f2>
- Log -----------------------------------------------------------------
commit d5b98071c9e3e7e1d15e5358ad2316f3928fb05d
Author: Karl Williamson <pub...@khwilliamson.com>
Date: Wed Mar 27 18:17:28 2013 -0600
Add test that to/from native character set works
For non-ASCII systems, there are character set translation tables. This
makes sure the two accessible ones are inverses of each other. If not,
nothing can be expected to work right.
M MANIFEST
A t/base/translate.t
commit 0505367018ffb2b76ed4195671cb41f05d198990
Author: Karl Williamson <k...@cpan.org>
Date: Fri Nov 21 13:55:13 2014 -0700
t/run/locale.t: Don't operate on iffy locales
This takes advantage of the previous commit to exclude locales that we
can determine don't work fully with Perl.
M t/run/locale.t
commit f079f9b78e4b36172c6e2f9f4bd9ac0267f77c8e
Author: Karl Williamson <k...@cpan.org>
Date: Fri Nov 21 13:43:23 2014 -0700
t/loc_tools.pl: Add optional parameter to find_locales()
This allows the caller to specify that they do not want to get back any
locales that aren't fully compatible with Perl.
M t/loc_tools.pl
commit b2d1ac42bedd37f33bf51560cc326f6c2c1b0202
Author: Karl Williamson <k...@cpan.org>
Date: Wed Nov 26 11:41:18 2014 -0700
PerlIO::encoding:fallback.t: properly skip tests
My moving the 'use Test::More' outside of the BEGIN block, I don't get
the 'duplicate leader seen' error.
M ext/PerlIO-encoding/t/fallback.t
commit 96cfa1df465e71dba7e2099fc37db1b569d300b4
Author: Karl Williamson <k...@cpan.org>
Date: Wed Nov 26 19:54:22 2014 -0700
perluniintro: Vertically stack ternarys
It's clearer and sets a better example for the reader
M pod/perluniintro.pod
commit e8135575e753a05a492447ea2c091bb1c88a0b1a
Author: Karl Williamson <k...@cpan.org>
Date: Wed Nov 26 19:56:25 2014 -0700
t/op/utfhash.t: Clarify comment
M t/op/utfhash.t
commit faad849dd7af72f2db0a94098b4c462d3e573f5f
Author: Karl Williamson <k...@cpan.org>
Date: Thu Nov 27 22:29:36 2014 -0700
perldiag: Add missing entry
M pod/perldiag.pod
commit 1da502408efd227568b7465f40e93444be78c216
Author: Karl Williamson <k...@cpan.org>
Date: Sun Nov 30 21:31:49 2014 -0700
t/run/locale.t: Nit in comment
M t/run/locale.t
commit 32514330ba9a2a815117a54029648cb6386298ba
Author: Karl Williamson <k...@cpan.org>
Date: Thu Dec 4 22:00:43 2014 -0700
t/re/reg_eval_scope.t: Don't stress memory limit
The test here used a lot of memory, causing problems on an os390 smoker.
The warning used is immaterial, so change to use a different warning,
one that doesn't use up memory.
M t/re/reg_eval_scope.t
commit 19d55f68928f21b1b109e2e9ed392af0010a32bc
Author: Karl Williamson <k...@cpan.org>
Date: Thu Dec 4 22:08:45 2014 -0700
t/re/pat_rt_report.t: Skip a test on os390
We run out of memory there for this test
M t/re/pat_rt_report.t
commit 7c754bd3cebb80940d6bfe12e72c3a9643d050e4
Author: Karl Williamson <k...@cpan.org>
Date: Sat Dec 6 22:49:16 2014 -0700
Delete: t/lib/1_compile.t, t/lib/compmod.pl
These are obsolete that no longer do anything useful. See
http://nntp.perl.org/group/perl.perl5.porters/222709
M MANIFEST
D t/lib/1_compile.t
D t/lib/compmod.pl
commit 638c2f561aabf609b4278710e676fe8f8058bd38
Author: Karl Williamson <k...@cpan.org>
Date: Mon Dec 8 09:04:37 2014 -0700
toke.c: Use mnemonic rather than numeric
This was clear because the comment gave what the number meant, but if
the value ever changed, this would break.
M toke.c
commit 5e4ff68ea6a2e558cc4bbaf4e39ca0363240fdb4
Author: Karl Williamson <k...@cpan.org>
Date: Mon Dec 8 09:03:18 2014 -0700
toke.c: \v is a legal C89 mnemonic.
Use this in preference to an octal number.
M toke.c
commit e87b2888910c8917d356d87ac24585020120d12c
Author: Karl Williamson <k...@cpan.org>
Date: Tue Dec 9 20:51:34 2014 -0700
generate_uudmap.c: Clarify comment
M generate_uudmap.c
commit ba1a4362addff2138f20ec81beb513387b98d277
Author: Karl Williamson <k...@cpan.org>
Date: Wed Dec 10 13:08:41 2014 -0700
Stop errorneous warnings for C locale
HP-UX - B.11.00/64 has a problem with the C locale that's only
noticeable from newly added warnings flooding the logs. This adds a
test to suppress them.
M locale.c
commit 62fe37a7bf046974cc0d734bd54112719cfbdd32
Author: Karl Williamson <k...@cpan.org>
Date: Wed Dec 10 13:08:10 2014 -0700
t/run/locale.t: Rmv duplicate closing of STDERR
STDERR is now closed during these tests, so no need to do it again. And
if you wanted to see STDERR for some reason, you had to remember to fix
things in two places. This also sets PERL_BADLANG to suppress some of
the things that we were closing STDERR to avoid printing.
M t/run/locale.t
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 3 +-
ext/PerlIO-encoding/t/fallback.t | 3 +-
generate_uudmap.c | 2 +-
locale.c | 11 ++++-
pod/perldiag.pod | 2 +
pod/perluniintro.pod | 14 +++---
t/base/translate.t | 27 +++++++++++
t/lib/1_compile.t | 64 ------------------------
t/lib/compmod.pl | 19 --------
t/loc_tools.pl | 102 ++++++++++++++++++++++-----------------
t/op/utfhash.t | 2 +-
t/re/pat_rt_report.t | 5 +-
t/re/reg_eval_scope.t | 7 ++-
t/run/locale.t | 13 +++--
toke.c | 6 +--
15 files changed, 127 insertions(+), 153 deletions(-)
create mode 100644 t/base/translate.t
delete mode 100644 t/lib/1_compile.t
delete mode 100644 t/lib/compmod.pl
diff --git a/MANIFEST b/MANIFEST
index 7d04e1f..3291137 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4917,6 +4917,7 @@ t/base/num.t See if numbers work
t/base/pat.t See if pattern matching works
t/base/rs.t See if record-read works
t/base/term.t See if various terms work
+t/base/translate.t See if character set translation works
t/base/while.t See if while work
t/benchmark/rt26188-speed-up-keys-on-empty-hash.t Benchmark if keys on
empty hashes is fast enough
t/bigmem/index.t Check that index() handles large offsets
@@ -5000,12 +5001,10 @@ t/io/tell.t See if file seeking
works
t/io/through.t See if pipe passes data intact
t/io/utf8.t See if file seeking works
t/japh/abigail.t Obscure tests
-t/lib/1_compile.t See if the various libraries and extensions
compile
t/lib/charnames/alias Tests of "use charnames" with aliases.
t/lib/Cname.pm Test charnames in regexes (op/pat.t)
t/lib/common.pl Helper for lib/{warnings,feature}.t
t/lib/commonsense.t See if configuration meets basic needs
-t/lib/compmod.pl Helper for 1_compile.t
t/lib/Count.pm Helper for t/op/method.t
t/lib/croak/mg Test croak calls from mg.c
t/lib/croak/op Test croak calls from op.c
diff --git a/ext/PerlIO-encoding/t/fallback.t b/ext/PerlIO-encoding/t/fallback.t
index 450feb8..17c241c 100644
--- a/ext/PerlIO-encoding/t/fallback.t
+++ b/ext/PerlIO-encoding/t/fallback.t
@@ -13,10 +13,11 @@ BEGIN {
print "1..0 # Skip: No Encode\n";
exit 0;
}
- use Test::More tests => 9;
import Encode qw(:fallback_all);
}
+use Test::More tests => 9;
+
# $PerlIO::encoding = 0; # WARN_ON_ERR|PERLQQ;
my $file = "fallback$$.txt";
diff --git a/generate_uudmap.c b/generate_uudmap.c
index b6307c0..4c7d56c 100644
--- a/generate_uudmap.c
+++ b/generate_uudmap.c
@@ -99,7 +99,7 @@ static const char PL_uuemap[]
typedef unsigned char U8;
-/* This will ensure it is all zeros. */
+/* This will ensure it is initialized to all zeros. */
static char PL_uudmap[256];
static char PL_bitcount[256];
diff --git a/locale.c b/locale.c
index a5a2cb3..429fdb7 100644
--- a/locale.c
+++ b/locale.c
@@ -345,7 +345,16 @@ Perl_new_ctype(pTHX_ const char *newctype)
/* We only handle single-byte locales (outside of UTF-8 ones; so if
* this locale requires than one byte, there are going to be
* problems. */
- if (check_for_problems && MB_CUR_MAX > 1) {
+ if (check_for_problems && MB_CUR_MAX > 1
+
+ /* Some platforms return MB_CUR_MAX > 1 for even the "C"
+ * locale. Just assume that the implementation for them (plus
+ * for POSIX) is correct and the > 1 value is spurious. (Since
+ * these are specially handled to never be considered UTF-8
+ * locales, as long as this is the only problem, everything
+ * should work fine */
+ && strNE(newctype, "C") && strNE(newctype, "POSIX"))
+ {
multi_byte_locale = TRUE;
}
#endif
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f9a56fa..d1bb1eb 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3307,6 +3307,8 @@ file-specification as an argument. See
L<perlfunc/require>.
(F) Missing right brace in C<\x{...}>, C<\p{...}>, C<\P{...}>, or C<\N{...}>.
+=item Missing right brace on \\N{}
+
=item Missing right brace on \N{} or unescaped left brace after \N
(F) C<\N> has two meanings.
diff --git a/pod/perluniintro.pod b/pod/perluniintro.pod
index 4348663..244cd38 100644
--- a/pod/perluniintro.pod
+++ b/pod/perluniintro.pod
@@ -473,13 +473,13 @@ its argument so that Unicode characters with code points
greater than
displayed as C<\x..>, and the rest of the characters as themselves:
sub nice_string {
- join("",
- map { $_ > 255 ? # if wide character...
- sprintf("\\x{%04X}", $_) : # \x{...}
- chr($_) =~ /[[:cntrl:]]/ ? # else if control character...
- sprintf("\\x%02X", $_) : # \x..
- quotemeta(chr($_)) # else quoted or as themselves
- } unpack("W*", $_[0])); # unpack Unicode characters
+ join("",
+ map { $_ > 255 # if wide character...
+ ? sprintf("\\x{%04X}", $_) # \x{...}
+ : chr($_) =~ /[[:cntrl:]]/ # else if control character...
+ ? sprintf("\\x%02X", $_) # \x..
+ : quotemeta(chr($_)) # else quoted or as themselves
+ } unpack("W*", $_[0])); # unpack Unicode characters
}
For example,
diff --git a/t/base/translate.t b/t/base/translate.t
new file mode 100644
index 0000000..614f22c
--- /dev/null
+++ b/t/base/translate.t
@@ -0,0 +1,27 @@
+#!./perl
+
+# Verify round trip of translations from the native character set to unicode
+# and back work. If this is wrong, nothing will be reliable.
+
+print "1..257\n"; # 0-255 plus one beyond
+
+for my $i (0 .. 255) {
+ my $uni = utf8::native_to_unicode($i);
+ if ($uni < 0 || $uni >= 256) {
+ print "not ";
+ }
+ elsif (utf8::unicode_to_native(utf8::native_to_unicode($i)) != $i) {
+ print "not ";
+ }
+ print "ok ";
+ print $i + 1;
+ print "\n";
+}
+
+# Choose a largish number that might cause a seg fault if inappropriate array
+# lookup
+if (utf8::unicode_to_native(utf8::native_to_unicode(100000)) != 100000) {
+ print "not ";
+}
+print "ok ";
+print "257\n";
diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t
deleted file mode 100644
index a1437ed..0000000
--- a/t/lib/1_compile.t
+++ /dev/null
@@ -1,64 +0,0 @@
-#!./perl
-
-# Modules should have their own tests. For historical reasons, some
-# do not. This does basic compile tests on modules that have no tests
-# of their own.
-
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
- require './test.pl';
-}
-
-use warnings;
-use File::Spec::Functions;
-
-# Okay, this is the list.
-
-my @Core_Modules = grep /\S/, <DATA>;
-chomp @Core_Modules;
-
-if (eval { require Socket }) {
- # Two Net:: modules need the Convert::EBCDIC if in EBDCIC.
- if (ord("A") != 193 || eval { require Convert::EBCDIC }) {
- push @Core_Modules, qw(Net::Cmd Net::POP3);
- }
-}
-
-@Core_Modules = sort @Core_Modules;
-
-plan tests => 1+@Core_Modules;
-
-cmp_ok(@Core_Modules, '>', 0, "All modules should have tests");
-note("http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-04/msg01223.html";);
-note("20010421230349.P2946\@blackrider.blackstar.co.uk");
-
-foreach my $module (@Core_Modules) {
- if ($module eq 'ByteLoader' && $^O eq 'VMS') {
- TODO: {
- local $TODO = "$module needs porting on $^O";
- ok(compile_module($module), "compile $module");
- }
- }
- else {
- ok(compile_module($module), "compile $module");
- }
-}
-
-# We do this as a separate process else we'll blow the hell
-# out of our namespace.
-sub compile_module {
- my ($module) = $_[0];
-
- my $compmod = catfile(curdir(), 'lib', 'compmod.pl');
- my $lib = '-I' . catdir(updir(), 'lib');
-
- my $out = scalar `$^X $lib $compmod $module`;
- return $out =~ /^ok/;
-}
-
-# These modules have no tests of their own.
-# Keep up to date with
-# http://perl-qa.hexten.net/wiki/index.php/Untested_Core_Modules
-# and vice-versa. The list should only shrink.
-__DATA__
diff --git a/t/lib/compmod.pl b/t/lib/compmod.pl
deleted file mode 100644
index fa032f1..0000000
--- a/t/lib/compmod.pl
+++ /dev/null
@@ -1,19 +0,0 @@
-#!./perl
-
-BEGIN {
- chdir 't';
- @INC = '../lib';
-}
-
-my $module = shift;
-
-# 'require open' confuses Perl, so we use instead.
-eval "use $module ();";
-if( $@ ) {
- print "not ";
- $@ =~ s/\n/\n# /g;
- warn "# require failed with '$@'\n";
-}
-print "ok - $module\n";
-
-
diff --git a/t/loc_tools.pl b/t/loc_tools.pl
index b4845b8..502af60 100644
--- a/t/loc_tools.pl
+++ b/t/loc_tools.pl
@@ -8,32 +8,35 @@
# anyway later during the scanning process (and besides, some clueless
# vendor might have them capitalized erroneously anyway).
-# Some of the locales on the system may not play well with Perl. Since, we
-# may be trying every possible locale, we don't want to be warned about the
-# weird ones.
-no warnings 'locale';
-
-sub _trylocale { # Adds the locale given by the first parameter to the list
- # given by the 3rd iff the platform supports the locale in
- # each of the categories given by the 2nd parameter, which
- # is either a single category or a reference to a list of
- # categories
+sub _trylocale ($$$$) { # Adds the locale given by the first parameter to the
+ # list given by the 3rd iff the platform supports the
+ # locale in each of the categories given by the 2nd
+ # parameter, which is either a single category or a
+ # reference to a list of categories
+ # The 4th parameter is true if to reject locales that
+ # aren't apparently fully compatible with Perl.
my $locale = shift;
my $categories = shift;
my $list = shift;
+ my $only_plays_well = shift;
+
return if ! $locale || grep { $locale eq $_ } @$list;
$categories = [ $categories ] unless ref $categories;
+ my $badutf8 = 0;
+ my $plays_well = 1;
+
+ use warnings 'locale';
+
+ local $SIG{__WARN__} = sub {
+ $badutf8 = 1 if $_[0] =~ /Malformed UTF-8/;
+ $plays_well = 0 if $_[0] =~ /Locale .* may not work well/i
+ };
+
foreach my $category (@$categories) {
return unless setlocale($category, $locale);
- }
-
- my $badutf8;
- {
- local $SIG{__WARN__} = sub {
- $badutf8 = $_[0] =~ /Malformed UTF-8/;
- };
+ return if $only_plays_well && ! $plays_well;
}
if ($badutf8) {
@@ -70,14 +73,16 @@ sub _decode_encodings {
return @enc;
}
-sub find_locales ($) { # Returns an array of all the locales we found on the
- # system. The parameter is either a single locale
- # category or a reference to a list of categories to
- # find valid locales for it (or in the case of
- # multiple) for all of them. Note that currently the
- # array includes even those locales that don't play
- # well with Perl
+sub find_locales ($;$) { # Returns an array of all the locales we found on the
+ # system. If the optional 2nd parameter is
+ # non-zero, the list is restricted to those locales
+ # that play well with Perl.
+ # The first parameter is either a single locale
+ # category or a reference to a list of categories to
+ # find valid locales for it (or in the case of
+ # multiple) for all of them.
my $categories = shift;
+ my $only_plays_well = shift // 0;
use Config;;
my $have_setlocale = $Config{d_setlocale};
@@ -103,16 +108,16 @@ sub find_locales ($) { # Returns an array of all the
locales we found on the
return;
}
- _trylocale("C", $categories, \@Locale);
- _trylocale("POSIX", $categories, \@Locale);
+ _trylocale("C", $categories, \@Locale, $only_plays_well);
+ _trylocale("POSIX", $categories, \@Locale, $only_plays_well);
foreach (0..15) {
- _trylocale("ISO8859-$_", $categories, \@Locale);
- _trylocale("iso8859$_", $categories, \@Locale);
- _trylocale("iso8859-$_", $categories, \@Locale);
- _trylocale("iso_8859_$_", $categories, \@Locale);
- _trylocale("isolatin$_", $categories, \@Locale);
- _trylocale("isolatin-$_", $categories, \@Locale);
- _trylocale("iso_latin_$_", $categories, \@Locale);
+ _trylocale("ISO8859-$_", $categories, \@Locale, $only_plays_well);
+ _trylocale("iso8859$_", $categories, \@Locale, $only_plays_well);
+ _trylocale("iso8859-$_", $categories, \@Locale, $only_plays_well);
+ _trylocale("iso_8859_$_", $categories, \@Locale, $only_plays_well);
+ _trylocale("isolatin$_", $categories, \@Locale, $only_plays_well);
+ _trylocale("isolatin-$_", $categories, \@Locale, $only_plays_well);
+ _trylocale("iso_latin_$_", $categories, \@Locale, $only_plays_well);
}
# Sanitize the environment so that we can run the external 'locale'
@@ -133,7 +138,7 @@ sub find_locales ($) { # Returns an array of all the
locales we found on the
# locales will cause all IO hadles to default to (assume) utf8
next unless utf8::valid($_);
chomp;
- _trylocale($_, $categories, \@Locale);
+ _trylocale($_, $categories, \@Locale, $only_plays_well);
}
close(LOCALES);
} elsif ($^O eq 'VMS'
@@ -145,7 +150,7 @@ sub find_locales ($) { # Returns an array of all the
locales we found on the
opendir(LOCALES, "SYS\$I18N_LOCALE:");
while ($_ = readdir(LOCALES)) {
chomp;
- _trylocale($_, $categories, \@Locale);
+ _trylocale($_, $categories, \@Locale, $only_plays_well);
}
close(LOCALES);
} elsif (($^O eq 'openbsd' || $^O eq 'bitrig' ) && -e '/usr/share/locale')
{
@@ -156,7 +161,7 @@ sub find_locales ($) { # Returns an array of all the
locales we found on the
opendir(LOCALES, '/usr/share/locale');
while ($_ = readdir(LOCALES)) {
chomp;
- _trylocale($_, $categories, \@Locale);
+ _trylocale($_, $categories, \@Locale, $only_plays_well);
}
close(LOCALES);
} else { # Final fallback. Try our list of locales hard-coded here
@@ -180,27 +185,31 @@ sub find_locales ($) { # Returns an array of all the
locales we found on the
split /:/, $line;
my @enc = _decode_encodings($encodings);
foreach my $loc (split(/ /, $locale_name)) {
- _trylocale($loc, $categories, \@Locale);
+ _trylocale($loc, $categories, \@Locale, $only_plays_well);
foreach my $enc (@enc) {
- _trylocale("$loc.$enc", $categories, \@Locale);
+ _trylocale("$loc.$enc", $categories, \@Locale,
+ $only_plays_well);
}
$loc = lc $loc;
foreach my $enc (@enc) {
- _trylocale("$loc.$enc", $categories, \@Locale);
+ _trylocale("$loc.$enc", $categories, \@Locale,
+ $only_plays_well);
}
}
foreach my $lang (split(/ /, $language_codes)) {
- _trylocale($lang, $categories, \@Locale);
+ _trylocale($lang, $categories, \@Locale, $only_plays_well);
foreach my $country (split(/ /, $country_codes)) {
my $lc = "${lang}_${country}";
- _trylocale($lc, $categories, \@Locale);
+ _trylocale($lc, $categories, \@Locale, $only_plays_well);
foreach my $enc (@enc) {
- _trylocale("$lc.$enc", $categories, \@Locale);
+ _trylocale("$lc.$enc", $categories, \@Locale,
+ $only_plays_well);
}
my $lC = "${lang}_\U${country}";
- _trylocale($lC, $categories, \@Locale);
+ _trylocale($lC, $categories, \@Locale, $only_plays_well);
foreach my $enc (@enc) {
- _trylocale("$lC.$enc", $categories, \@Locale);
+ _trylocale("$lC.$enc", $categories, \@Locale,
+ $only_plays_well);
}
}
}
@@ -221,6 +230,7 @@ sub is_locale_utf8 ($) { # Return a boolean as to if core
Perl thinks the input
my $locale = shift;
use locale;
+ no warnings 'locale'; # We may be trying out a weird locale
my $save_locale = setlocale(&POSIX::LC_CTYPE());
if (! $save_locale) {
@@ -264,7 +274,9 @@ sub find_utf8_ctype_locale (;$) { # Return the name of a
locale that core Perl
my $locales_ref = shift;
return if !defined &POSIX::LC_CTYPE;
if (! defined $locales_ref) {
- my @locales = find_locales(&POSIX::LC_CTYPE());
+ my @locales = find_locales(&POSIX::LC_CTYPE(),
+ 1 # Reject iffy locales.
+ );
$locales_ref = \@locales;
}
diff --git a/t/op/utfhash.t b/t/op/utfhash.t
index ebb2934..2f1b688 100644
--- a/t/op/utfhash.t
+++ b/t/op/utfhash.t
@@ -10,7 +10,7 @@ BEGIN {
use strict;
-# Two hashes one will all keys 8-bit possible (initially), other
+# Two hashes one with all 8-bit possible keys (initially), other
# with a utf8 requiring key from the outset.
my %hash8 = ( "\xff" => 0xff,
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 712affe..ed8fafc 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -972,8 +972,11 @@ sub run_tests {
is($x, 'ab cd', $message);
}
- {
+ SKIP: {
+ skip("Can run out of memory on os390", 1) if $^O eq 'os390';
ok (("a" x (2 ** 15 - 10)) =~ /^()(a|bb)*$/, "Recursive stack cracker;
Bug 24274");
+ }
+ {
ok ((q(a)x 100) =~ /^(??{'(.)'x 100})/,
"Regexp /^(??{'(.)'x 100})/ crashes older perls; Bug 24274");
}
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
index 4243f87..dc9c1c8 100644
--- a/t/re/reg_eval_scope.t
+++ b/t/re/reg_eval_scope.t
@@ -243,16 +243,15 @@ CODE
pass "undef *_ in a re-eval does not cause a double free";
# make sure regexp warnings are reported on the right line
-# (we don't care what warning; the 32768 limit is just one
-# that was easy to reproduce) */
+# (we don't care what warning */
{
use warnings;
my $w;
local $SIG{__WARN__} = sub { $w = "@_" };
my $qr = qr/(??{'a'})/;
my $filler = 1;
- ("a" x 40_000) =~ /^$qr(ab*)+/; my $line = __LINE__;
- like($w, qr/recursion limit.* line $line\b/, "warning on right line");
+ my $a = "\x{110000}" =~ /\p{Unassigned}/; my $line = __LINE__;
+ like($w, qr/Matched non-Unicode code point .* line $line\b/, "warning on
right line");
}
# on immediate exit from pattern with code blocks, make sure PL_curcop is
diff --git a/t/run/locale.t b/t/run/locale.t
index 1aaeb0f..1f88168 100644
--- a/t/run/locale.t
+++ b/t/run/locale.t
@@ -21,7 +21,10 @@ BEGIN {
}
use Config;
my $have_strtod = $Config{d_strtod} eq 'define';
-my @locales = eval { find_locales( [ &LC_ALL, &LC_CTYPE, &LC_NUMERIC ] ) };
+my @locales = eval { find_locales( [ &LC_ALL, &LC_CTYPE, &LC_NUMERIC ],
+ 1 # Only return locales that work well with
+ # Perl
+ ) };
skip_all("no locales available") unless @locales;
plan tests => &last;
@@ -283,7 +286,7 @@ EOF
# within this block, STDERR is closed. This is because fresh_perl_is()
# forks a shell, and some shells (like bash) can complain noisily when
- #LC_ALL or similar is set to an invalid value
+ # LC_ALL or similar is set to an invalid value
{
open my $saved_stderr, ">&STDERR" or die "Can't dup STDERR: $!";
@@ -293,9 +296,10 @@ EOF
local $ENV{LC_ALL} = "invalid";
local $ENV{LC_NUMERIC} = "invalid";
local $ENV{LANG} = $different;
+ local $ENV{PERL_BADLANG} = 0;
# Can't turn off the warnings, so send them to /dev/null
- if (! fresh_perl_is(<<"EOF", "$difference", { stderr => "devnull"
},
+ if (! fresh_perl_is(<<"EOF", "$difference", { },
if (\$ENV{LC_ALL} ne "invalid") {
# Make the test pass if the sh didn't accept the ENV set
print "$difference\n";
@@ -321,9 +325,10 @@ EOF
local $ENV{LC_ALL} = "invalid";
local $ENV{LC_NUMERIC} = "invalid";
local $ENV{LANG} = "invalid";
+ local $ENV{PERL_BADLANG} = 0;
# Can't turn off the warnings, so send them to /dev/null
- if (! fresh_perl_is(<<"EOF", 4.2, { stderr => "devnull" },
+ if (! fresh_perl_is(<<"EOF", 4.2, { },
if (\$ENV{LC_ALL} ne "invalid") {
print "$difference\n";
exit 0;
diff --git a/toke.c b/toke.c
index d364e42..cce9323 100644
--- a/toke.c
+++ b/toke.c
@@ -4948,7 +4948,7 @@ Perl_yylex(pTHX)
Perl_croak(aTHX_
"\t(Maybe you didn't strip carriage returns after a network
transfer?)\n");
#endif
- case ' ': case '\t': case '\f': case 013:
+ case ' ': case '\t': case '\f': case '\v':
s++;
goto retry;
case '#':
@@ -10512,7 +10512,7 @@ S_scan_formline(pTHX_ char *s)
if (needargs) {
const char *s2 = s;
while (*s2 == '\r' || *s2 == ' ' || *s2 == '\t' || *s2 == '\f'
- || *s2 == 013)
+ || *s2 == '\v')
s2++;
if (*s2 == '{') {
PL_expect = XTERMBLOCK;
@@ -10634,7 +10634,7 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len,
U32 flags)
}
else if (yychar > 255)
sv_catpvs(where_sv, "next token ???");
- else if (yychar == -2) { /* YYEMPTY */
+ else if (yychar == YYEMPTY) {
if (PL_lex_state == LEX_NORMAL ||
(PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
sv_catpvs(where_sv, "at end of line");
--
Perl5 Master Repository
