Upgrade to Devel::PPPort 3.09_02

p4raw-id: //depot/perl@28616

11 files changed, 220 insertions, 10 deletions

diff --git a/MANIFEST b/MANIFEST
index 78757485f7..0742b2de92 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -404,6 +404,7 @@ 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/snprintf	Devel::PPPort include
+ext/Devel/PPPort/parts/inc/strlfuncs	Devel::PPPort include
 ext/Devel/PPPort/parts/inc/SvPV	Devel::PPPort include
 ext/Devel/PPPort/parts/inc/SvREFCNT	Devel::PPPort include
 ext/Devel/PPPort/parts/inc/Sv_set	Devel::PPPort include
@@ -469,6 +470,7 @@ 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/snprintf.t	Devel::PPPort test file
+ext/Devel/PPPort/t/strlfuncs.t	Devel::PPPort test file
 ext/Devel/PPPort/t/SvPV.t	Devel::PPPort test file
 ext/Devel/PPPort/t/SvREFCNT.t	Devel::PPPort test file
 ext/Devel/PPPort/t/Sv_set.t	Devel::PPPort test file
diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes
index 9af7b01f91..a8b4770ef7 100755
--- a/ext/Devel/PPPort/Changes
+++ b/ext/Devel/PPPort/Changes
@@ -1,3 +1,10 @@
+3.09_02 - 2006-07-25
+
+    * added support for the following API
+        my_strlcat
+        my_strlcpy
+      (thanks to Steve Peters for providing a patch)
+
 3.09_01 - 2006-07-21
 
     * avoid using 'glob' when running under miniperl
diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL
index cff55581e8..fb98ced47b 100644
--- a/ext/Devel/PPPort/PPPort_pm.PL
+++ b/ext/Devel/PPPort/PPPort_pm.PL
@@ -4,9 +4,9 @@
 #
 ################################################################################
 #
-#  $Revision: 47 $
+#  $Revision: 48 $
 #  $Author: mhx $
-#  $Date: 2006/07/08 11:44:19 +0200 $
+#  $Date: 2006/07/24 21:03:14 +0200 $
 #
 ################################################################################
 #
@@ -335,9 +335,9 @@ __DATA__
 #
 ################################################################################
 #
-#  $Revision: 47 $
+#  $Revision: 48 $
 #  $Author: mhx $
-#  $Date: 2006/07/08 11:44:19 +0200 $
+#  $Date: 2006/07/24 21:03:14 +0200 $
 #
 ################################################################################
 #
@@ -498,7 +498,7 @@ package Devel::PPPort;
 use strict;
 use vars qw($VERSION $data);
 
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.09_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.09_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 sub _init_data
 {
@@ -614,6 +614,8 @@ __DATA__
 
 %include exception
 
+%include strlfuncs
+
 #endif /* _P_P_PORTABILITY_H_ */
 
 /* End of File ppport.h */
diff --git a/ext/Devel/PPPort/TODO b/ext/Devel/PPPort/TODO
index 6b77ebe699..f46be3029d 100644
--- a/ext/Devel/PPPort/TODO
+++ b/ext/Devel/PPPort/TODO
@@ -1,5 +1,7 @@
 TODO:
 
+* try to make parts/apicheck.pl automatically find NEED_ #defines
+
 * implement snprintf with newSVpvf for >= 5.004, which is safer?
 
 * add support for my_vsnprintf?
diff --git a/ext/Devel/PPPort/parts/apicheck.pl b/ext/Devel/PPPort/parts/apicheck.pl
index a1c6ebdd1f..424bea9737 100644
--- a/ext/Devel/PPPort/parts/apicheck.pl
+++ b/ext/Devel/PPPort/parts/apicheck.pl
@@ -5,9 +5,9 @@
 #
 ################################################################################
 #
-#  $Revision: 20 $
+#  $Revision: 21 $
 #  $Author: mhx $
-#  $Date: 2006/05/28 19:35:39 +0200 $
+#  $Date: 2006/07/25 19:14:07 +0200 $
 #
 ################################################################################
 #
@@ -148,6 +148,8 @@ print OUT <<HEAD;
 #define NEED_grok_numeric_radix
 #define NEED_grok_oct
 #define NEED_my_snprintf
+#define NEED_my_strlcat
+#define NEED_my_strlcpy
 #define NEED_newCONSTSUB
 #define NEED_newRV_noinc
 #define NEED_sv_2pv_nolen
diff --git a/ext/Devel/PPPort/parts/base/5009004 b/ext/Devel/PPPort/parts/base/5009004
index cb6baa86de..b978b8cf61 100644
--- a/ext/Devel/PPPort/parts/base/5009004
+++ b/ext/Devel/PPPort/parts/base/5009004
@@ -16,10 +16,13 @@ SvREFCNT_inc_void_NN           # U
 gv_name_set                    # U
 hv_stores                      # U
 my_snprintf                    # U
+my_strlcat                     # U
+my_strlcpy                     # U
 my_vsnprintf                   # U
 newXS_flags                    # U
 pad_sv                         # U
 pv_escape                      # U
+pv_pretty                      # U
 regclass_swash                 # E (Perl_regclass_swash)
 stashpv_hvname_match           # U
 sv_does                        # U
diff --git a/ext/Devel/PPPort/parts/embed.fnc b/ext/Devel/PPPort/parts/embed.fnc
index 81127e0375..d69d87e555 100644
--- a/ext/Devel/PPPort/parts/embed.fnc
+++ b/ext/Devel/PPPort/parts/embed.fnc
@@ -982,8 +982,15 @@ Apdbm	|void	|sv_usepvn_mg	|NN SV *sv|NULLOK char *ptr|STRLEN len
 ApR	|MGVTBL*|get_vtbl	|int vtbl_id
 Apd	|char*	|pv_display	|NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \
 				|STRLEN pvlim
-Apd	|char*	|pv_escape	|NN SV *dsv|NN const char *pv|const STRLEN count \
-				|const STRLEN max|const U32 flags
+Apd	|char*	|pv_escape	|NN SV *dsv|NN char const * const str\
+                                |const STRLEN count|const STRLEN max\
+                                |NULLOK STRLEN * const escaped\
+                                |const U32 flags				
+Apd     |char*  |pv_pretty      |NN SV *dsv|NN char const * const str\
+                                |const STRLEN count|const STRLEN max\
+                                |NULLOK char const * const start_color\
+                                |NULLOK char const * const end_color\
+                                |const U32 flags				
 Afp	|void	|dump_indent	|I32 level|NN PerlIO *file|NN const char* pat|...
 Ap	|void	|dump_vindent	|I32 level|NN PerlIO *file|NN const char* pat \
 				|NULLOK va_list *args
@@ -1354,6 +1361,7 @@ Es	|void	|to_utf8_substr	|NN regexp * prog
 Es	|void	|to_byte_substr	|NN regexp * prog
 #  ifdef DEBUGGING
 Es	|void	|dump_exec_pos	|NN const char *locinput|NN const regnode *scan|const bool do_utf8
+Es	|void	|debug_start_match|NN const regexp *prog|const bool do_utf8|NN const char *start|NN const char *end|NN const char *blurb
 #  endif
 #endif
 
@@ -1718,6 +1726,14 @@ px	|void	|my_clearenv
 Apo	|void*	|my_cxt_init	|NN int *index|size_t size
 #endif
 
+#ifndef HAS_STRLCAT
+Apno	|Size_t	|my_strlcat	|NULLOK char *dst|NULLOK const char *src|Size_t size
+#endif
+
+#ifndef HAS_STRLCPY
+Apno     |Size_t |my_strlcpy     |NULLOK char *dst|NULLOK const char *src|Size_t size
+#endif
+
 #ifdef PERL_MAD
 Mnp	|void	|pad_peg	|NN const char* s
 #if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT)
diff --git a/ext/Devel/PPPort/parts/inc/strlfuncs b/ext/Devel/PPPort/parts/inc/strlfuncs
new file mode 100644
index 0000000000..46bf6883e4
--- /dev/null
+++ b/ext/Devel/PPPort/parts/inc/strlfuncs
@@ -0,0 +1,114 @@
+################################################################################
+##
+##  $Revision: 2 $
+##  $Author: mhx $
+##  $Date: 2006/07/25 19:59:33 +0200 $
+##
+################################################################################
+##
+##  Version 3.x, Copyright (C) 2004-2006, 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
+
+my_strlcat
+my_strlcpy
+
+=implementation
+
+#if !defined(my_strlcat)
+#if { NEED my_strlcat }
+
+Size_t
+my_strlcat(char *dst, const char *src, Size_t size)
+{
+    Size_t used, length, copy;
+
+    used = strlen(dst);
+    length = strlen(src);
+    if (size > 0 && used < size - 1) {
+        copy = (length >= size - used) ? size - used - 1 : length;
+        memcpy(dst + used, src, copy);
+        dst[used + copy] = '\0';
+    }
+    return used + length;
+}
+#endif
+#endif
+
+#if !defined(my_strlcpy)
+#if { NEED my_strlcpy }
+
+Size_t
+my_strlcpy(char *dst, const char *src, Size_t size)
+{
+    Size_t length, copy;
+
+    length = strlen(src);
+    if (size > 0) {
+        copy = (length >= size) ? size - 1 : length;
+        memcpy(dst, src, copy);
+        dst[copy] = '\0';
+    }
+    return length;
+}
+
+#endif
+#endif
+
+=xsinit
+
+#define NEED_my_strlcat
+#define NEED_my_strlcpy
+
+=xsubs
+
+void
+my_strlfunc()
+	PREINIT:
+		char buf[8];
+		int len;
+	PPCODE:
+                len = my_strlcpy(buf, "foo", sizeof(buf));
+		XPUSHs(newSViv(len));
+		XPUSHs(newSVpv(buf, 0));
+		len = my_strlcat(buf, "bar", sizeof(buf));
+		XPUSHs(newSViv(len));
+		XPUSHs(newSVpv(buf, 0));
+		len = my_strlcat(buf, "baz", sizeof(buf));
+		XPUSHs(newSViv(len));
+		XPUSHs(newSVpv(buf, 0));
+		len = my_strlcpy(buf, "1234567890", sizeof(buf));
+		XPUSHs(newSViv(len));
+		XPUSHs(newSVpv(buf, 0));
+		len = my_strlcpy(buf, "1234", sizeof(buf));
+		XPUSHs(newSViv(len));
+		XPUSHs(newSVpv(buf, 0));
+		len = my_strlcat(buf, "567890123456", sizeof(buf));
+		XPUSHs(newSViv(len));
+		XPUSHs(newSVpv(buf, 0));
+		XSRETURN(12);
+
+=tests plan => 13
+
+my @e = (3, 'foo',
+         6, 'foobar',
+         9, 'foobarb',
+         10, '1234567',
+         4, '1234',
+         16, '1234567',
+        );
+my @r = Devel::PPPort::my_strlfunc();
+
+ok(@e == @r);
+
+for (0 .. $#e) {
+  ok($r[$_], $e[$_]);
+}
+
diff --git a/ext/Devel/PPPort/parts/todo/5009004 b/ext/Devel/PPPort/parts/todo/5009004
index 431f8c7d78..56d98036da 100644
--- a/ext/Devel/PPPort/parts/todo/5009004
+++ b/ext/Devel/PPPort/parts/todo/5009004
@@ -8,6 +8,7 @@ my_vsnprintf                   # U
 newXS_flags                    # U
 pad_sv                         # U
 pv_escape                      # U
+pv_pretty                      # U
 regclass_swash                 # E (Perl_regclass_swash)
 stashpv_hvname_match           # U
 sv_does                        # U
diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak
index f597dc547c..4a1d9f0590 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.09_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.09_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 $| = 1;
 my %OPT = (
diff --git a/ext/Devel/PPPort/t/strlfuncs.t b/ext/Devel/PPPort/t/strlfuncs.t
new file mode 100644
index 0000000000..dc911ce662
--- /dev/null
+++ b/ext/Devel/PPPort/t/strlfuncs.t
@@ -0,0 +1,61 @@
+################################################################################
+#
+#            !!!!!   Do NOT edit this file directly!   !!!!!
+#
+#            Edit mktests.PL and/or parts/inc/strlfuncs instead.
+#
+################################################################################
+
+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 @e = (3, 'foo',
+         6, 'foobar',
+         9, 'foobarb',
+         10, '1234567',
+         4, '1234',
+         16, '1234567',
+        );
+my @r = Devel::PPPort::my_strlfunc();
+
+ok(@e == @r);
+
+for (0 .. $#e) {
+  ok($r[$_], $e[$_]);
+}
+