From: Marcus Holland-Moritz <mhx-perl@gmx.net>
Date: Thu, 30 Oct 2008 18:55:04 +0000 (+0000)
Subject: Upgrade to Devel::PPPort 3.14_04
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db42c9028c2e0e8bf2d418f40276d99e5fbaf04c;p=p5sagit%2Fp5-mst-13.2.git
Upgrade to Devel::PPPort 3.14_04
p4raw-id: //depot/perl@34669
---
diff --git a/MANIFEST b/MANIFEST
index 2992de2..b2dcdab 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -280,6 +280,7 @@ ext/Devel/PPPort/parts/inc/ppphbin Devel::PPPort include
ext/Devel/PPPort/parts/inc/ppphdoc Devel::PPPort include
ext/Devel/PPPort/parts/inc/ppphtest Devel::PPPort include
ext/Devel/PPPort/parts/inc/pvs Devel::PPPort include
+ext/Devel/PPPort/parts/inc/pv_tools Devel::PPPort include
ext/Devel/PPPort/parts/inc/shared_pv Devel::PPPort include
ext/Devel/PPPort/parts/inc/snprintf Devel::PPPort include
ext/Devel/PPPort/parts/inc/sprintf Devel::PPPort include
@@ -354,6 +355,7 @@ ext/Devel/PPPort/TODO Devel::PPPort Todo
ext/Devel/PPPort/t/podtest.t Devel::PPPort test file
ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file
ext/Devel/PPPort/t/pvs.t Devel::PPPort test file
+ext/Devel/PPPort/t/pv_tools.t Devel::PPPort test file
ext/Devel/PPPort/t/shared_pv.t Devel::PPPort test file
ext/Devel/PPPort/t/snprintf.t Devel::PPPort test file
ext/Devel/PPPort/t/sprintf.t Devel::PPPort test file
diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes
index f08dae4..7b985df 100755
--- a/ext/Devel/PPPort/Changes
+++ b/ext/Devel/PPPort/Changes
@@ -1,3 +1,33 @@
+3.14_04 - 2008-10-30
+
+ * added support for the following API
+ isALNUMC [depend]
+ isASCII
+ isBLANK
+ isCNTRL
+ isGRAPH
+ isPRINT
+ isPSXSPC
+ isPUNCT
+ isXDIGIT
+ PERL_PV_ESCAPE_ALL
+ PERL_PV_ESCAPE_FIRSTCHAR
+ PERL_PV_ESCAPE_NOBACKSLASH
+ PERL_PV_ESCAPE_NOCLEAR
+ PERL_PV_ESCAPE_QUOTE
+ PERL_PV_ESCAPE_RE
+ PERL_PV_ESCAPE_UNI
+ PERL_PV_ESCAPE_UNI_DETECT
+ PERL_PV_PRETTY_DUMP
+ PERL_PV_PRETTY_ELLIPSES
+ PERL_PV_PRETTY_LTGT
+ PERL_PV_PRETTY_NOCLEAR
+ PERL_PV_PRETTY_QUOTE
+ PERL_PV_PRETTY_REGPROP
+ pv_display
+ pv_escape
+ pv_pretty
+
3.14_03 - 2008-10-21
* fix C++ compilation issue with last release
diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL
index 1420b64..321b747 100644
--- a/ext/Devel/PPPort/PPPort_pm.PL
+++ b/ext/Devel/PPPort/PPPort_pm.PL
@@ -4,9 +4,9 @@
#
################################################################################
#
-# $Revision: 62 $
+# $Revision: 63 $
# $Author: mhx $
-# $Date: 2008/10/21 23:12:30 +0200 $
+# $Date: 2008/10/30 01:47:31 +0100 $
#
################################################################################
#
@@ -372,9 +372,9 @@ __DATA__
#
################################################################################
#
-# $Revision: 62 $
+# $Revision: 63 $
# $Author: mhx $
-# $Date: 2008/10/21 23:12:30 +0200 $
+# $Date: 2008/10/30 01:47:31 +0100 $
#
################################################################################
#
@@ -535,7 +535,7 @@ package Devel::PPPort;
use strict;
use vars qw($VERSION $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_04 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
sub _init_data
{
@@ -656,6 +656,8 @@ __DATA__
%include strlfuncs
+%include pv_tools
+
#endif /* _P_P_PORTABILITY_H_ */
/* End of File ppport.h */
diff --git a/ext/Devel/PPPort/parts/apicheck.pl b/ext/Devel/PPPort/parts/apicheck.pl
index dedc41a..99063e4 100644
--- a/ext/Devel/PPPort/parts/apicheck.pl
+++ b/ext/Devel/PPPort/parts/apicheck.pl
@@ -5,9 +5,9 @@
#
################################################################################
#
-# $Revision: 32 $
+# $Revision: 33 $
# $Author: mhx $
-# $Date: 2008/10/12 20:50:38 +0200 $
+# $Date: 2008/10/30 01:47:30 +0100 $
#
################################################################################
#
@@ -157,6 +157,9 @@ print OUT <<HEAD;
#define NEED_newCONSTSUB
#define NEED_newRV_noinc
#define NEED_newSVpvn_share
+#define NEED_pv_display
+#define NEED_pv_escape
+#define NEED_pv_pretty
#define NEED_sv_2pv_flags
#define NEED_sv_2pvbyte
#define NEED_sv_catpvf_mg
diff --git a/ext/Devel/PPPort/parts/inc/misc b/ext/Devel/PPPort/parts/inc/misc
index 6f3a7cf..ac09a54 100644
--- a/ext/Devel/PPPort/parts/inc/misc
+++ b/ext/Devel/PPPort/parts/inc/misc
@@ -1,8 +1,8 @@
################################################################################
##
-## $Revision: 47 $
+## $Revision: 48 $
## $Author: mhx $
-## $Date: 2008/10/21 23:14:09 +0200 $
+## $Date: 2008/10/30 01:46:33 +0100 $
##
################################################################################
##
@@ -250,6 +250,34 @@ typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
#endif
+__UNDEFINED__ isPSXSPC(c) (isSPACE(c) || (c) == '\v')
+__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t')
+#ifdef EBCDIC
+__UNDEFINED__ isALNUMC(c) isalnum(c)
+__UNDEFINED__ isASCII(c) isascii(c)
+__UNDEFINED__ isCNTRL(c) iscntrl(c)
+__UNDEFINED__ isGRAPH(c) isgraph(c)
+__UNDEFINED__ isPRINT(c) isprint(c)
+__UNDEFINED__ isPUNCT(c) ispunct(c)
+__UNDEFINED__ isXDIGIT(c) isxdigit(c)
+#else
+# if { VERSION < 5.10.0 }
+/* Hint: isPRINT
+ * The implementation in older perl versions includes all of the
+ * isSPACE() characters, which is wrong. The version provided by
+ * Devel::PPPort always overrides a present buggy version.
+ */
+# undef isPRINT
+# endif
+__UNDEFINED__ isALNUMC(c) (isALPHA(c) || isDIGIT(c))
+__UNDEFINED__ isASCII(c) ((c) <= 127)
+__UNDEFINED__ isCNTRL(c) ((c) < ' ' || (c) == 127)
+__UNDEFINED__ isGRAPH(c) (isALNUM(c) || isPUNCT(c))
+__UNDEFINED__ isPRINT(c) (((c) >= 32 && (c) < 127))
+__UNDEFINED__ isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+__UNDEFINED__ isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+#endif
+
=xsmisc
XS(XS_Devel__PPPort_dXSTARG); /* prototype */
diff --git a/ext/Devel/PPPort/parts/inc/pv_tools b/ext/Devel/PPPort/parts/inc/pv_tools
new file mode 100644
index 0000000..8a31130
--- /dev/null
+++ b/ext/Devel/PPPort/parts/inc/pv_tools
@@ -0,0 +1,281 @@
+################################################################################
+##
+## $Revision: 3 $
+## $Author: mhx $
+## $Date: 2008/10/30 19:42:36 +0100 $
+##
+################################################################################
+##
+## Version 3.x, Copyright (C) 2004-2008, Marcus Holland-Moritz.
+## Version 2.x, Copyright (C) 2001, Paul Marquess.
+## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+##
+## This program is free software; you can redistribute it and/or
+## modify it under the same terms as Perl itself.
+##
+################################################################################
+
+=provides
+
+__UNDEFINED__
+pv_escape
+pv_pretty
+pv_display
+
+=implementation
+
+__UNDEFINED__ PERL_PV_ESCAPE_QUOTE 0x0001
+__UNDEFINED__ PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
+__UNDEFINED__ PERL_PV_PRETTY_ELLIPSES 0x0002
+__UNDEFINED__ PERL_PV_PRETTY_LTGT 0x0004
+__UNDEFINED__ PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+__UNDEFINED__ PERL_PV_ESCAPE_UNI 0x0100
+__UNDEFINED__ PERL_PV_ESCAPE_UNI_DETECT 0x0200
+__UNDEFINED__ PERL_PV_ESCAPE_ALL 0x1000
+__UNDEFINED__ PERL_PV_ESCAPE_NOBACKSLASH 0x2000
+__UNDEFINED__ PERL_PV_ESCAPE_NOCLEAR 0x4000
+__UNDEFINED__ PERL_PV_ESCAPE_RE 0x8000
+__UNDEFINED__ PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+
+__UNDEFINED__ PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
+__UNDEFINED__ PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
+
+/* Hint: pv_escape
+ * Note that unicode functionality is only backported to
+ * those perl versions that support it. For older perl
+ * versions, the implementation will fall back to bytes.
+ */
+
+#ifndef pv_escape
+#if { NEED pv_escape }
+
+char *
+pv_escape(pTHX_ SV *dsv, char const * const str,
+ const STRLEN count, const STRLEN max,
+ STRLEN * const escaped, const U32 flags)
+{
+ const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
+ const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
+ char octbuf[32] = "%123456789ABCDF";
+ STRLEN wrote = 0;
+ STRLEN chsize = 0;
+ STRLEN readsize = 1;
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
+#endif
+ const char *pv = str;
+ const char * const end = pv + count;
+ octbuf[0] = esc;
+
+ if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
+ sv_setpvs(dsv, "");
+
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
+ isuni = 1;
+#endif
+
+ for (; pv < end && (!max || wrote < max) ; pv += readsize) {
+ const UV u =
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
+#endif
+ (U8)*pv;
+ const U8 c = (U8)u & 0xFF;
+
+ if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
+ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+ chsize = my_snprintf(octbuf, sizeof octbuf,
+ "%"UVxf, u);
+ else
+ chsize = my_snprintf(octbuf, sizeof octbuf,
+ "%cx{%"UVxf"}", esc, u);
+ } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
+ chsize = 1;
+ } else {
+ if (c == dq || c == esc || !isPRINT(c)) {
+ chsize = 2;
+ switch (c) {
+ case '\\' : /* fallthrough */
+ case '%' : if (c == esc)
+ octbuf[1] = esc;
+ else
+ chsize = 1;
+ break;
+ case '\v' : octbuf[1] = 'v'; break;
+ case '\t' : octbuf[1] = 't'; break;
+ case '\r' : octbuf[1] = 'r'; break;
+ case '\n' : octbuf[1] = 'n'; break;
+ case '\f' : octbuf[1] = 'f'; break;
+ case '"' : if (dq == '"')
+ octbuf[1] = '"';
+ else
+ chsize = 1;
+ break;
+ default: chsize = my_snprintf(octbuf, sizeof octbuf,
+ pv < end && isDIGIT((U8)*(pv+readsize))
+ ? "%c%03o" : "%c%o", esc, c);
+ }
+ } else {
+ chsize = 1;
+ }
+ }
+ if (max && wrote + chsize > max) {
+ break;
+ } else if (chsize > 1) {
+ sv_catpvn(dsv, octbuf, chsize);
+ wrote += chsize;
+ } else {
+ char tmp[2];
+ my_snprintf(tmp, sizeof tmp, "%c", c);
+ sv_catpvn(dsv, tmp, 1);
+ wrote++;
+ }
+ if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+ break;
+ }
+ if (escaped != NULL)
+ *escaped= pv - str;
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#ifndef pv_pretty
+#if { NEED pv_pretty }
+
+char *
+pv_pretty(pTHX_ SV *dsv, char const * const str, const STRLEN count,
+ const STRLEN max, char const * const start_color, char const * const end_color,
+ const U32 flags)
+{
+ const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+ STRLEN escaped;
+
+ if (!(flags & PERL_PV_PRETTY_NOCLEAR))
+ sv_setpvs(dsv, "");
+
+ if (dq == '"')
+ sv_catpvs(dsv, "\"");
+ else if (flags & PERL_PV_PRETTY_LTGT)
+ sv_catpvs(dsv, "<");
+
+ if (start_color != NULL)
+ sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
+
+ pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
+
+ if (end_color != NULL)
+ sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
+
+ if (dq == '"')
+ sv_catpvs(dsv, "\"");
+ else if (flags & PERL_PV_PRETTY_LTGT)
+ sv_catpvs(dsv, ">");
+
+ if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
+ sv_catpvs(dsv, "...");
+
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+#ifndef pv_display
+#if { NEED pv_display }
+
+char *
+pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
+{
+ pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
+ if (len > cur && pv[cur] == '\0')
+ sv_catpvs(dsv, "\\0");
+ return SvPVX(dsv);
+}
+
+#endif
+#endif
+
+=xsinit
+
+#define NEED_pv_escape
+#define NEED_pv_pretty
+#define NEED_pv_display
+
+=xsubs
+
+void
+pv_escape_can_unicode()
+ PPCODE:
+#if defined(is_utf8_string) && defined(utf8_to_uvchr)
+ XSRETURN_YES;
+#else
+ XSRETURN_NO;
+#endif
+
+void
+pv_pretty()
+ PREINIT:
+ char *rv;
+ PPCODE:
+ EXTEND(SP, 8);
+ ST(0) = sv_newmortal();
+ rv = pv_pretty(ST(0), "foobarbaz",
+ 9, 40, NULL, NULL, 0);
+ ST(1) = sv_2mortal(newSVpv(rv, 0));
+ ST(2) = sv_newmortal();
+ rv = pv_pretty(ST(2), "pv_p\retty\n",
+ 10, 40, "left", "right", PERL_PV_PRETTY_LTGT);
+ ST(3) = sv_2mortal(newSVpv(rv, 0));
+ ST(4) = sv_newmortal();
+ rv = pv_pretty(ST(4), "N\303\275 Batter\303\255",
+ 16, 20, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT);
+ ST(5) = sv_2mortal(newSVpv(rv, 0));
+ ST(6) = sv_newmortal();
+ rv = pv_pretty(ST(6), "\303\201g\303\246tis Byrjun",
+ 16, 20, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT|PERL_PV_PRETTY_ELLIPSES);
+ ST(7) = sv_2mortal(newSVpv(rv, 0));
+ XSRETURN(8);
+
+void
+pv_display()
+ PREINIT:
+ char *rv;
+ PPCODE:
+ EXTEND(SP, 4);
+ ST(0) = sv_newmortal();
+ rv = pv_display(ST(0), "foob\0rbaz", 9, 10, 20);
+ ST(1) = sv_2mortal(newSVpv(rv, 0));
+ ST(2) = sv_newmortal();
+ rv = pv_display(ST(2), "pv_display", 10, 11, 5);
+ ST(3) = sv_2mortal(newSVpv(rv, 0));
+ XSRETURN(4);
+
+=tests plan => 13
+
+my $uni = &Devel::PPPort::pv_escape_can_unicode();
+
+# sanity check
+ok($uni ? $] >= 5.006 : $] < 5.008);
+
+my @r;
+
+@r = &Devel::PPPort::pv_pretty();
+ok($r[0], $r[1]);
+ok($r[0], "foobarbaz");
+ok($r[2], $r[3]);
+ok($r[2], '<leftpv_p\retty\nright>');
+ok($r[4], $r[5]);
+ok($r[4], $uni ? 'N\375 Batter\355\0' : 'N\303\275 Batter\303');
+ok($r[6], $r[7]);
+ok($r[6], $uni ? '\\301g\\346tis Byrjun...' : '\303\201g\303\246tis...');
+
+@r = &Devel::PPPort::pv_display();
+ok($r[0], $r[1]);
+ok($r[0], '"foob\0rbaz"\0');
+ok($r[2], $r[3]);
+ok($r[2] eq '"pv_di"...\0' ||
+ $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :(
+
diff --git a/ext/Devel/PPPort/parts/todo/5006000 b/ext/Devel/PPPort/parts/todo/5006000
index 146fb5f..86f24e2 100644
--- a/ext/Devel/PPPort/parts/todo/5006000
+++ b/ext/Devel/PPPort/parts/todo/5006000
@@ -100,7 +100,6 @@ new_numeric # U (perl_new_numeric)
op_dump # U
perl_parse # E (perl_parse)
pmop_dump # U
-pv_display # U
re_intuit_string # U
reginitcolors # U
require_pv # U (perl_require_pv)
diff --git a/ext/Devel/PPPort/parts/todo/5009004 b/ext/Devel/PPPort/parts/todo/5009004
index a9d57b7..0d6b7d5 100644
--- a/ext/Devel/PPPort/parts/todo/5009004
+++ b/ext/Devel/PPPort/parts/todo/5009004
@@ -3,8 +3,6 @@ PerlIO_context_layers # U
gv_name_set # U
my_vsnprintf # U
newXS_flags # U
-pv_escape # U
-pv_pretty # U
regclass_swash # E (Perl_regclass_swash)
sv_does # U
sv_usepvn_flags # U
diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak
index 1116392..8e99759 100644
--- a/ext/Devel/PPPort/soak
+++ b/ext/Devel/PPPort/soak
@@ -33,7 +33,7 @@ use File::Find;
use List::Util qw(max);
use Config;
-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.14_04 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
$| = 1;
my %OPT = (
diff --git a/ext/Devel/PPPort/t/pv_tools.t b/ext/Devel/PPPort/t/pv_tools.t
new file mode 100644
index 0000000..61b0f14
--- /dev/null
+++ b/ext/Devel/PPPort/t/pv_tools.t
@@ -0,0 +1,74 @@
+################################################################################
+#
+# !!!!! Do NOT edit this file directly! !!!!!
+#
+# Edit mktests.PL and/or parts/inc/pv_tools instead.
+#
+# This file was automatically generated from the definition files in the
+# parts/inc/ subdirectory by mktests.PL. To learn more about how all this
+# works, please read the F<HACKERS> file that came with this distribution.
+#
+################################################################################
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}) {
+ chdir 't' if -d 't';
+ @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
+ require Config; import Config;
+ use vars '%Config';
+ if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
+ print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
+ exit 0;
+ }
+ }
+ else {
+ unshift @INC, 't';
+ }
+
+ sub load {
+ eval "use Test";
+ require 'testutil.pl' if $@;
+ }
+
+ if (13) {
+ load();
+ plan(tests => 13);
+ }
+}
+
+use Devel::PPPort;
+use strict;
+$^W = 1;
+
+package Devel::PPPort;
+use vars '@ISA';
+require DynaLoader;
+@ISA = qw(DynaLoader);
+bootstrap Devel::PPPort;
+
+package main;
+
+my $uni = &Devel::PPPort::pv_escape_can_unicode();
+
+# sanity check
+ok($uni ? $] >= 5.006 : $] < 5.008);
+
+my @r;
+
+@r = &Devel::PPPort::pv_pretty();
+ok($r[0], $r[1]);
+ok($r[0], "foobarbaz");
+ok($r[2], $r[3]);
+ok($r[2], '<leftpv_p\retty\nright>');
+ok($r[4], $r[5]);
+ok($r[4], $uni ? 'N\375 Batter\355\0' : 'N\303\275 Batter\303');
+ok($r[6], $r[7]);
+ok($r[6], $uni ? '\\301g\\346tis Byrjun...' : '\303\201g\303\246tis...');
+
+@r = &Devel::PPPort::pv_display();
+ok($r[0], $r[1]);
+ok($r[0], '"foob\0rbaz"\0');
+ok($r[2], $r[3]);
+ok($r[2] eq '"pv_di"...\0' ||
+ $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :(
+