From 27287bba2c2ae5afdeaf015ace7f9010013916cd Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 26 Jan 2012 11:30:32 +0100
Subject: 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.
---
 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 a7aab35f97..b5905873b6 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 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");
+    }
+}
diff --git a/handy.h b/handy.h
index 8777644aa7..d0f07b85f0 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 fe1eaecfb6..90aa206de2 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!)
-- 
cgit v1.2.1