Change 21036 by [EMAIL PROTECTED] on 2003/09/04 19:34:26
Subject: Re: [PATCH] Data::Dumper 2.121
From: Ilya Martynov <[EMAIL PROTECTED]>
Date: Fri, 05 Sep 2003 00:33:46 +0400
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/Data/Dumper/Changes#5 edit
... //depot/perl/ext/Data/Dumper/Dumper.pm#32 edit
... //depot/perl/ext/Data/Dumper/Dumper.xs#48 edit
... //depot/perl/ext/Data/Dumper/t/dumper.t#11 edit
... //depot/perl/ext/Data/Dumper/t/overload.t#2 edit
... //depot/perl/ext/Data/Dumper/t/pair.t#2 edit
Differences ...
==== //depot/perl/ext/Data/Dumper/Changes#5 (text) ====
Index: perl/ext/Data/Dumper/Changes
--- perl/ext/Data/Dumper/Changes#4~11857~ Tue Sep 4 05:27:51 2001
+++ perl/ext/Data/Dumper/Changes Thu Sep 4 12:34:26 2003
@@ -6,6 +6,10 @@
=over 8
+=item 2.121 (Aug 24 2003)
+
+Backport to 5.6.1 by Ilya Martynov <[EMAIL PROTECTED]>.
+
=item 2.11 (unreleased)
C<0> is now dumped as such, not as C<'0'>.
==== //depot/perl/ext/Data/Dumper/Dumper.pm#32 (text) ====
Index: perl/ext/Data/Dumper/Dumper.pm
--- perl/ext/Data/Dumper/Dumper.pm#31~20699~ Thu Aug 14 06:16:27 2003
+++ perl/ext/Data/Dumper/Dumper.pm Thu Sep 4 12:34:26 2003
@@ -645,6 +645,10 @@
return qq("$_");
}
+# helper sub to sort hash keys in Perl < 5.8.0 where we don't have
+# access to sortsv() from XS
+sub _sortkeys { [ sort keys %{$_[0]} ] }
+
1;
__END__
@@ -1193,6 +1197,9 @@
SCALAR objects have the weirdest looking C<bless> workaround.
+Pure Perl version of C<Data::Dumper> escapes UTF-8 strings correctly
+only in Perl 5.8.0 and later.
+
=head2 NOTE
Starting from Perl 5.8.1 different runs of Perl will have different
@@ -1215,7 +1222,7 @@
=head1 VERSION
-Version 2.12 (unreleased)
+Version 2.121 (Aug 24 2003)
=head1 SEE ALSO
==== //depot/perl/ext/Data/Dumper/Dumper.xs#48 (text) ====
Index: perl/ext/Data/Dumper/Dumper.xs
--- perl/ext/Data/Dumper/Dumper.xs#47~19005~ Sun Mar 16 18:06:20 2003
+++ perl/ext/Data/Dumper/Dumper.xs Thu Sep 4 12:34:26 2003
@@ -3,26 +3,6 @@
#include "perl.h"
#include "XSUB.h"
-#ifndef PERL_VERSION
-# include <patchlevel.h>
-# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
-# include <could_not_find_Perl_patchlevel.h>
-# endif
-# define PERL_VERSION PATCHLEVEL
-#endif
-
-#if PERL_VERSION < 5
-# ifndef PL_sv_undef
-# define PL_sv_undef sv_undef
-# endif
-# ifndef ERRSV
-# define ERRSV GvSV(errgv)
-# endif
-# ifndef newSVpvn
-# define newSVpvn newSVpv
-# endif
-#endif
-
static I32 num_q (char *s, STRLEN slen);
static I32 esc_q (char *dest, char *src, STRLEN slen);
static I32 esc_q_utf8 (pTHX_ SV *sv, char *src, STRLEN slen);
@@ -34,6 +14,39 @@
I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
I32 maxdepth, SV *sortkeys);
+#if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
+
+# ifdef EBCDIC
+# define UNI_TO_NATIVE(ch) (((ch) > 255) ? (ch) : ASCII_TO_NATIVE(ch))
+# else
+# define UNI_TO_NATIVE(ch) (ch)
+# endif
+
+UV
+Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
+{
+ UV uv = utf8_to_uv(s, UTF8_MAXLEN, retlen,
+ ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ return UNI_TO_NATIVE(uv);
+}
+
+# if !defined(PERL_IMPLICIT_CONTEXT)
+# define utf8_to_uvchr Perl_utf8_to_uvchr
+# else
+# define utf8_to_uvchr(a,b) Perl_utf8_to_uvchr(aTHX_ a,b)
+# endif
+
+#endif /* PERL_VERSION <= 6 */
+
+/* Changes in 5.7 series mean that now IOK is only set if scalar is
+ precisely integer but in 5.6 and earlier we need to do a more
+ complex test */
+#if PERL_VERSION <= 6
+#define DD_is_integer(sv) (SvIOK(sv) && (SvIsUV(val) ? SvUV(sv) == SvNV(sv) :
SvIV(sv) == SvNV(sv)))
+#else
+#define DD_is_integer(sv) SvIOK(sv)
+#endif
+
/* does a string need to be protected? */
static I32
needs_quote(register char *s)
@@ -339,7 +352,7 @@
(void)SvREFCNT_inc(val);
av_push(seenentry, val);
(void)hv_store(seenhv, id, strlen(id),
- newRV((SV*)seenentry), 0);
+ newRV_inc((SV*)seenentry), 0);
SvREFCNT_dec(seenentry);
}
}
@@ -546,6 +559,9 @@
/* If requested, get a sorted/filtered array of hash keys */
if (sortkeys) {
if (sortkeys == &PL_sv_yes) {
+#if PERL_VERSION < 8
+ sortkeys = sv_2mortal(newSVpvn("Data::Dumper::_sortkeys", 23));
+#else
keys = newAV();
(void)hv_iterinit((HV*)ival);
while ((entry = hv_iternext((HV*)ival))) {
@@ -553,17 +569,18 @@
SvREFCNT_inc(sv);
av_push(keys, sv);
}
-#ifdef USE_LOCALE_NUMERIC
+# ifdef USE_LOCALE_NUMERIC
sortsv(AvARRAY(keys),
av_len(keys)+1,
IN_LOCALE ? Perl_sv_cmp_locale : Perl_sv_cmp);
-#else
+# else
sortsv(AvARRAY(keys),
av_len(keys)+1,
Perl_sv_cmp);
+# endif
#endif
}
- else {
+ if (sortkeys != &PL_sv_yes) {
dSP; ENTER; SAVETMPS; PUSHMARK(sp);
XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
@@ -759,24 +776,19 @@
sv_catpvn(namesv, name, namelen);
seenentry = newAV();
av_push(seenentry, namesv);
- av_push(seenentry, newRV(val));
- (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
+ av_push(seenentry, newRV_inc(val));
+ (void)hv_store(seenhv, id, strlen(id), newRV_inc((SV*)seenentry), 0);
SvREFCNT_dec(seenentry);
}
}
- if (SvIOK(val)) {
+ if (DD_is_integer(val)) {
STRLEN len;
if (SvIsUV(val))
(void) sprintf(tmpbuf, "%"UVuf, SvUV(val));
else
(void) sprintf(tmpbuf, "%"IVdf, SvIV(val));
len = strlen(tmpbuf);
- /* For 5.6.x and earlier will need to change this test to check
- NV if NOK, as there NOK trumps IOK, and NV=3.5,IV=3 is valid.
- Current code will Dump that as $VAR1 = 3;
- Changes in 5.7 series mean that now IOK is only set if scalar
- is precisely integer. */
if (SvPOK(val)) {
/* Need to check to see if this is a string such as " 0".
I'm assuming from sprintf isn't going to clash with utf8.
@@ -841,7 +853,7 @@
sv_catpvn(nname, entries[j], sizes[j]);
sv_catpvn(postentry, " = ", 3);
av_push(postav, postentry);
- e = newRV(e);
+ e = newRV_inc(e);
SvCUR(newapad) = 0;
if (indent >= 2)
==== //depot/perl/ext/Data/Dumper/t/dumper.t#11 (xtext) ====
Index: perl/ext/Data/Dumper/t/dumper.t
--- perl/ext/Data/Dumper/t/dumper.t#10~19854~ Wed Jun 25 22:32:02 2003
+++ perl/ext/Data/Dumper/t/dumper.t Thu Sep 4 12:34:26 2003
@@ -4,12 +4,14 @@
#
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
- require Config; import Config;
- if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
- print "1..0 # Skip: Data::Dumper was not built\n";
- exit 0;
+ if ($ENV{PERL_CORE}){
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+ print "1..0 # Skip: Data::Dumper was not built\n";
+ exit 0;
+ }
}
}
@@ -64,6 +66,13 @@
: "not ok [EMAIL PROTECTED]");
}
+sub SKIP_TEST {
+ my $reason = shift;
+ ++$TNUM; print "ok $TNUM # skip $reason\n";
+ ++$TNUM; print "ok $TNUM # skip $reason\n";
+ ++$TNUM; print "ok $TNUM # skip $reason\n";
+}
+
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
# it direct. Out here it lets us knobble the next if to test that the perl
# only tests do work (and count correctly)
@@ -827,10 +836,13 @@
#$a = "\x{9c10}";
EOT
- TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}";
+ if($] >= 5.007) {
+ TEST q(Data::Dumper->Dump([$a], ['a'])), "\\x{9c10}";
+ } else {
+ SKIP_TEST "Incomplete support for UTF-8 in old perls";
+ }
TEST q(Data::Dumper->Dumpxs([$a], ['a'])), "XS \\x{9c10}"
if $XS;
-
}
{
@@ -1332,8 +1344,13 @@
$ping = 5;
%ping = (chr (0xDECAF) x 4 =>\$ping);
for $Data::Dumper::Sortkeys (0, 1) {
- TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
- TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
+ if($] >= 5.007) {
+ TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
+ TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
+ } else {
+ SKIP_TEST "Incomplete support for UTF-8 in old perls";
+ SKIP_TEST "Incomplete support for UTF-8 in old perls";
+ }
}
}
==== //depot/perl/ext/Data/Dumper/t/overload.t#2 (xtext) ====
Index: perl/ext/Data/Dumper/t/overload.t
--- perl/ext/Data/Dumper/t/overload.t#1~10676~ Sun Jun 17 21:17:15 2001
+++ perl/ext/Data/Dumper/t/overload.t Thu Sep 4 12:34:26 2003
@@ -1,12 +1,15 @@
#!./perl -w
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
- require Config; import Config;
- if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
- print "1..0 # Skip: Data::Dumper was not built\n";
- exit 0;
+ if ($ENV{PERL_CORE}){
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ no warnings 'once';
+ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+ print "1..0 # Skip: Data::Dumper was not built\n";
+ exit 0;
+ }
}
}
==== //depot/perl/ext/Data/Dumper/t/pair.t#2 (xtext) ====
Index: perl/ext/Data/Dumper/t/pair.t
--- perl/ext/Data/Dumper/t/pair.t#1~19005~ Sun Mar 16 18:06:20 2003
+++ perl/ext/Data/Dumper/t/pair.t Thu Sep 4 12:34:26 2003
@@ -4,12 +4,15 @@
#
BEGIN {
- chdir 't' if -d 't';
- unshift @INC, '../lib';
- require Config; import Config;
- if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
- print "1..0 # Skip: Data::Dumper was not built\n";
- exit 0;
+ if ($ENV{PERL_CORE}){
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ require Config; import Config;
+ no warnings 'once';
+ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+ print "1..0 # Skip: Data::Dumper was not built\n";
+ exit 0;
+ }
}
}
End of Patch.
