In perl.git, the branch smoke-me/Copy-overlap-wrapper-proto has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/27287bba2c2ae5afdeaf015ace7f9010013916cd?hp=2a7afa746140382bc9615f6d66ae6f04d3469e48> - Log ----------------------------------------------------------------- commit 27287bba2c2ae5afdeaf015ace7f9010013916cd Author: Nicholas Clark <[email protected]> Date: Thu Jan 26 11:30:32 2012 +0100 PROOF OF CONCEPT for a wrapper for Copy() to detect overlap. Should be conditionally compilable. Tests shouldn't run unless it's compiled in, as overlapping memcpy() is undefined behaviour and may SEGV. Needs handy.h untangled so that Copy, Move, Zero live in the same place. ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 19 +++++++++++++++++++ ext/XS-APItest/t/copy.t | 35 +++++++++++++++++++++++++++++++++++ handy.h | 2 -- perl.h | 18 ++++++++++++++++++ 6 files changed, 74 insertions(+), 3 deletions(-) create mode 100644 ext/XS-APItest/t/copy.t diff --git a/MANIFEST b/MANIFEST index a7aab35..b590587 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3945,6 +3945,7 @@ ext/XS-APItest/t/clone-with-stack.t test clone with CLONEf_COPY_STACKS works ext/XS-APItest/t/cophh.t test COPHH API ext/XS-APItest/t/coplabel.t test cop_*_label ext/XS-APItest/t/copyhints.t test hv_copy_hints_hv() API +ext/XS-APItest/t/copy.t test the Copy overlap checker ext/XS-APItest/t/customop.t XS::APItest: tests for custom ops ext/XS-APItest/t/eval-filter.t Simple source filter/eval test ext/XS-APItest/t/exception.t XS::APItest extension diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 476207e..45e95d2 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -52,7 +52,7 @@ sub import { } } -our $VERSION = '0.35'; +our $VERSION = '0.36'; use vars '$WARNINGS_ON_BOOTSTRAP'; use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END); diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 01b5b08..001a90d 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3372,3 +3372,22 @@ test_get_vtbl() RETVAL = PTR2UV(get_vtbl(-1)); OUTPUT: RETVAL + +MODULE = XS::APItest PACKAGE = XS::APItest::Copy + +PROTOTYPES: DISABLE + +void +Copy(SV *buffer, UV source, UV dest, UV len) + CODE: + { + STRLEN blen; + char *p = SvPVbyte_force(buffer, blen); + + if (source >= blen || source + len > blen || dest >= blen + || dest + len > blen) + croak("Copy parameters %"UVuf", %"UVuf", %"UVuf" vs blen %"UVuf, + source, dest, len, (UV) blen); + + Copy(p + source, p + dest, len, U8); + } diff --git a/ext/XS-APItest/t/copy.t b/ext/XS-APItest/t/copy.t new file mode 100644 index 0000000..cce7bee --- /dev/null +++ b/ext/XS-APItest/t/copy.t @@ -0,0 +1,35 @@ +#!./perl -w +use strict; + +# Tests for the Copy overlap checker. +use Test::More; +use XS::APItest 'Copy'; + +my @tests = (["ABCD", 0, 2, 2, "ABAB"], + ["ABCD", 0, 2, 1, "ABAD"], + ["ABCD", 2, 0, 2, "CDCD"], + ["ABCD", 2, 0, 1, "CBCD"], + ["ABCD", 2, 1, 2, qr/^Copy.*From.*To/], + ["ABCD", 0, 1, 2, qr/^Copy.*To.*From/], + ); + +plan (tests => 2 * @tests); + +foreach (@tests) { + my ($buffer, $src, $dest, $len, $want) = @$_; + my $name = "Copy('$buffer', $src, $dest, $len)"; + if (ref $want) { + is(eval { + Copy($buffer, $src, $dest, $len); + 1; + }, undef, "$name should fail"); + like($@, $want, "$name gave expected error"); + } else { + is(eval { + Copy($buffer, $src, $dest, $len); + 1; + }, 1, "$name should not fail") + or diag("\$@ = $@"); + is($buffer, $want, "$name gave expected result"); + } +} diff --git a/handy.h b/handy.h index 8777644..d0f07b8 100644 --- a/handy.h +++ b/handy.h @@ -1214,11 +1214,9 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe #endif #define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t))) -#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))) #define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t))) #define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t))) -#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))) #ifdef HAS_MEMSET #define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t))) #else diff --git a/perl.h b/perl.h index fe1eaec..90aa206 100644 --- a/perl.h +++ b/perl.h @@ -5769,6 +5769,24 @@ extern void moncontrol(int); #define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE #define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII + +PERL_STATIC_INLINE void * +S_memcpy_checker(const char *s, char *d, MEM_SIZE num, MEM_SIZE size, + const char *type_name) +{ + const MEM_SIZE len = num * size; + if (s >= d && s < d + len) + Perl_croak_nocontext("Copy(%p, %p, %"UVuf", %s) From[%p To %p) [%p %p)", + s, d, num, type_name, s, d, s + len, d + len); + if (d >= s && d < s + len) + Perl_croak_nocontext("Copy(%p, %p, %"UVuf", %s) To[%p From %p) [%p %p)", + s, d, num, type_name, d, s, d + len, s + len); + return memcpy(d, s, len); +} + +#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)S_memcpy_checker((const char*)(s),(char*)(d), (n), sizeof(t), STRINGIFY(t))) +#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) S_memcpy_checker((const char*)(s),(char*)(d), (n), sizeof(t), STRINGIFY(t))) + /* (KEEP THIS LAST IN perl.h!) -- Perl5 Master Repository
