diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.pm | 2 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 19 | ||||
| -rw-r--r-- | ext/XS-APItest/t/copy.t | 35 | ||||
| -rw-r--r-- | handy.h | 2 | ||||
| -rw-r--r-- | perl.h | 18 |
6 files changed, 74 insertions, 3 deletions
@@ -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 476207e3dd..45e95d24aa 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 01b5b087f8..001a90d324 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 0000000000..cce7bee355 --- /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"); + } +} @@ -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 @@ -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!) |