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
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
+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
#
################################################################################
#
-# $Revision: 47 $
+# $Revision: 48 $
# $Author: mhx $
-# $Date: 2006/07/08 11:44:19 +0200 $
+# $Date: 2006/07/24 21:03:14 +0200 $
#
################################################################################
#
#
################################################################################
#
-# $Revision: 47 $
+# $Revision: 48 $
# $Author: mhx $
-# $Date: 2006/07/08 11:44:19 +0200 $
+# $Date: 2006/07/24 21:03:14 +0200 $
#
################################################################################
#
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
{
%include exception
+%include strlfuncs
+
#endif /* _P_P_PORTABILITY_H_ */
/* End of File ppport.h */
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?
#
################################################################################
#
-# $Revision: 20 $
+# $Revision: 21 $
# $Author: mhx $
-# $Date: 2006/05/28 19:35:39 +0200 $
+# $Date: 2006/07/25 19:14:07 +0200 $
#
################################################################################
#
#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
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
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
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
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)
--- /dev/null
+################################################################################
+##
+## $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[$_]);
+}
+
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
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 = (
--- /dev/null
+################################################################################
+#
+# !!!!! 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[$_]);
+}
+
projects / platform / upstream / perl.git / commitdiff