summaryrefslogtreecommitdiff
path: root/t/test.pl
diff options
context:
space:
mode:
authorAaron Crane <arc@cpan.org>2016-05-16 12:19:03 +0100
committerAaron Crane <arc@cpan.org>2016-05-16 12:19:03 +0100
commit94b9cb53c203ffad48e3011ea660a3a5ed9a2b38 (patch)
tree270bc2104aaa9a758dc64961a14dedaddab95bba /t/test.pl
parent8255316ac82c0fbd7ae49f2f9a217ce063d7bbfb (diff)
downloadperl-94b9cb53c203ffad48e3011ea660a3a5ed9a2b38.tar.gz
[perl #128052] make t/test.pl compatible with older Perls
The RT ticket points out that the threads and threads::shared libraries, among other CPAN modules, copy t/test.pl and must operate on older versions of Perl; but that the version in threads 2.07 and threads::shared 1.51 contains constructs that require Perl 5.10. This change restores 5.8 compatibility in t/test.pl, ready for reimporting into the CPAN releases of those modules. I can't see a way to test that this compatibility doesn't get accidentally broken in the future, unfortunately.
Diffstat (limited to 't/test.pl')
-rw-r--r--t/test.pl14
1 files changed, 10 insertions, 4 deletions
diff --git a/t/test.pl b/t/test.pl
index 84475ea3ee..41b77f4393 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -4,9 +4,9 @@
# NOTE:
#
-# It's best to not features found only in more modern Perls here, as some cpan
-# distributions copy this file and operate on older Perls. Similarly keep
-# things simple as this may be run under fairly broken circumstances. For
+# Do not rely on features found only in more modern Perls here, as some CPAN
+# distributions copy this file and must operate on older Perls. Similarly, keep
+# things, simple as this may be run under fairly broken circumstances. For
# example, increment ($x++) has a certain amount of cleverness for things like
#
# $x = 'zz';
@@ -284,6 +284,12 @@ sub _qq {
return defined $x ? '"' . display ($x) . '"' : 'undef';
};
+# Support pre-5.10 Perls, for the benefit of CPAN dists that copy this file.
+# Note that chr(90) exists in both ASCII ("Z") and EBCDIC ("!").
+my $chars_template = defined(eval { pack "W*", 90 }) ? "W*" : "U*";
+eval 'sub re::is_regexp { ref($_[0]) eq "Regexp" }'
+ if !defined &re::is_regexp;
+
# keys are the codes \n etc map to, values are 2 char strings such as \n
my %backslash_escape;
foreach my $x (split //, 'nrtfa\\\'"') {
@@ -296,7 +302,7 @@ sub display {
foreach my $x (@_) {
if (defined $x and not ref $x) {
my $y = '';
- foreach my $c (unpack("W*", $x)) {
+ foreach my $c (unpack($chars_template, $x)) {
if ($c > 255) {
$y = $y . sprintf "\\x{%x}", $c;
} elsif ($backslash_escape{$c}) {