This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.09_02
authorMarcus Holland-Moritz <mhx-perl@gmx.net>
Tue, 25 Jul 2006 18:54:08 +0000 (18:54 +0000)
committerMarcus Holland-Moritz <mhx-perl@gmx.net>
Tue, 25 Jul 2006 18:54:08 +0000 (18:54 +0000)
p4raw-id: //depot/perl@28616

MANIFEST
ext/Devel/PPPort/Changes
ext/Devel/PPPort/PPPort_pm.PL
ext/Devel/PPPort/TODO
ext/Devel/PPPort/parts/apicheck.pl
ext/Devel/PPPort/parts/base/5009004
ext/Devel/PPPort/parts/embed.fnc
ext/Devel/PPPort/parts/inc/strlfuncs [new file with mode: 0644]
ext/Devel/PPPort/parts/todo/5009004
ext/Devel/PPPort/soak
ext/Devel/PPPort/t/strlfuncs.t [new file with mode: 0644]

index 7875748..0742b2d 100644 (file)
--- 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
index 9af7b01..a8b4770 100755 (executable)
@@ -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
index cff5558..fb98ced 100644 (file)
@@ -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 */
index 6b77ebe..f46be30 100644 (file)
@@ -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?
index a1c6ebd..424bea9 100644 (file)
@@ -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
index cb6baa8..b978b8c 100644 (file)
@@ -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
index 81127e0..d69d87e 100644 (file)
@@ -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 (file)
index 0000000..46bf688
--- /dev/null
@@ -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[$_]);
+}
+
index 431f8c7..56d9803 100644 (file)
@@ -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
index f597dc5..4a1d9f0 100644 (file)
@@ -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 (file)
index 0000000..dc911ce
--- /dev/null
@@ -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[$_]);
+}
+