From bc2829b51122cce7fb70c374b5639f3fc93c4838 Mon Sep 17 00:00:00 2001
From: chansen <chansen@cpan.org>
Date: Wed, 19 Mar 2014 01:24:28 +0100
Subject: [PATCH] Added several cases for critical XS bugs

---
 Simple-Class/t/Simple-Class.t | 81 ++++++++++++++++++++++++++++++-----
 1 file changed, 70 insertions(+), 11 deletions(-)
 mode change 100644 => 100755 Simple-Class/t/Simple-Class.t

diff --git a/Simple-Class/t/Simple-Class.t b/Simple-Class/t/Simple-Class.t
old mode 100644
new mode 100755
index a447124..588b78f
--- a/Simple-Class/t/Simple-Class.t
+++ b/Simple-Class/t/Simple-Class.t
@@ -40,19 +40,78 @@ ok(($stdout eq $exp1) || ($stdout eq $exp2), "display() works")
 	or diag("Got $stdout, expected $exp1 or $exp2");
 
 # Make sure stored data isn't references to *OUR* data
-my $dog = 'dog';
+{
+    my $dog = 'dog';
 
-my $obj = Simple::Class->new(
-	'cat' => $dog,
-	'bird' => 1,
-);
-ok($obj, 'Got an object');
-isa_ok($obj, 'Simple::Class', 'obj is the correct class');
+    my $obj = Simple::Class->new(
+    	'cat' => $dog,
+    	'bird' => 1,
+    );
+    ok($obj, 'Got an object');
+    isa_ok($obj, 'Simple::Class', 'obj is the correct class');
 
-$dog = 'not a dog';
+    $dog = 'not a dog';
 
-# Check hash entries are correct
-is($obj->{cat}, 'dog', 'private member cat is correct');
-is($obj->{bird}, 1, 'private member bird is correct');
+    # Check hash entries are correct
+    is($obj->{cat}, 'dog', 'private member cat is correct');
+    is($obj->{bird}, 1, 'private member bird is correct');
+}
+
+# Make sure stored strings are not terminated with a null
+{
+    my $dog = "Dog \x00 Foo";
+    my $obj = Simple::Class->new(
+    	$dog => 'Fido',
+    	'bird' => 1,
+    );
+    ok($obj, 'Got an object');
+    isa_ok($obj, 'Simple::Class', 'obj is the correct class');
+
+    # Check hash entries are correct
+    is($obj->{$dog}, $dog, 'private member cat is correct');
+}
+
+# Make sure UTF-X strings are stored properly
+{
+    my $dog = "Dog \x{1F415}";
+    my $obj = Simple::Class->new(
+    	$dog => $dog
+    );
+    ok($obj, 'Got an object');
+    isa_ok($obj, 'Simple::Class', 'obj is the correct class');
+
+
+    is($obj->{$dog}, $dog, 'private member is correct');
+}
+
+{
+    package MyDogNames;
+    sub TIESCALAR { return bless \(my $i = 0), shift }
+
+    sub FETCH {
+        my ($self) = @_;
+        return qw(Skip Lassie)[$$self ^= 1];
+    }
+}
+
+# Make sure MAGIC strings are stored properly
+{
+    tie my $name, 'MyDogNames';
+    my $obj = Simple::Class->new(
+    	$name => "Fido",
+    );
+    ok($obj, 'Got an object');
+    isa_ok($obj, 'Simple::Class', 'obj is the correct class');
+
+    # Check hash entries are correct
+    is($obj->{Lassie}, 'Fido', 'private member is correct');
+}
+
+{
+    use Test::LeakTrace 0.10;
+    no_leaks_ok {
+        eval { Simple::Class->new(foo => \1) };
+    }
+}
 
 done_testing;