More tests for Safedual/Safe

3 files changed, 40 insertions, 1 deletions

diff --git a/MANIFEST b/MANIFEST
index 3963c22449..676a5d3872 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2760,6 +2760,7 @@ dist/Safe/t/safe2.t		See if Safe works
 dist/Safe/t/safe3.t		See if Safe works
 dist/Safe/t/safeload.t		Tests that some modules can be loaded by Safe
 dist/Safe/t/safeops.t		Tests that all ops can be trapped by Safe
+dist/Safe/t/saferegexp.t	Tests Safe with regexps
 dist/Safe/t/safesort.t		Tests Safe with sort
 dist/Safe/t/safeuniversal.t	Tests Safe with functions from universal.c
 dist/Safe/t/safeutf8.t		Tests Safe with utf8.pm
diff --git a/dist/Safe/t/safeload.t b/dist/Safe/t/safeload.t
index 2d2c3ccb4a..3ed2793fd7 100644
--- a/dist/Safe/t/safeload.t
+++ b/dist/Safe/t/safeload.t
@@ -18,9 +18,13 @@ BEGIN {
 use strict;
 use Test::More;
 use Safe;
-plan(tests => 1);
+plan(tests => 2);
 
 my $c = new Safe;
 $c->permit(qw(require caller entereval unpack));
 my $r = $c->reval(q{ use version; 1 });
 ok( defined $r, "Can load version.pm in a Safe compartment" ) or diag $@;
+
+$r = $c->reval(q{ version->new(1.2) });
+is(ref $r, "Safe::Root0::version", "version objects rerooted");
+$r or diag $@;
diff --git a/dist/Safe/t/saferegexp.t b/dist/Safe/t/saferegexp.t
new file mode 100644
index 0000000000..2719ca1202
--- /dev/null
+++ b/dist/Safe/t/saferegexp.t
@@ -0,0 +1,34 @@
+#!perl -w
+
+BEGIN {
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/) {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+use Test::More tests => 3;
+use Safe;
+
+my $c; my $r;
+my $snippet = q{
+    my $foo = qr/foo/;
+    ref $foo;
+};
+$c = new Safe;
+$r = $c->reval($snippet);
+is( $r, "Safe::Root0::Regexp" );
+$r or diag $@;
+
+# once more with the same compartment
+# (where DESTROY has been cleaned up)
+$r = $c->reval($snippet);
+is( $r, "Safe::Root0::Regexp" );
+$r or diag $@;
+
+# try with a new compartment
+$c = new Safe;
+$r = $c->reval($snippet);
+is( $r, "Safe::Root1::Regexp" );
+$r or diag $@;