Safe.pm: Don’t eval code under ‘no strict’

Instead of evaluating code under ‘no strict’, we should be evaluating
it with no pragmata at all by default.

This allows ‘use 5.012’ to enable strictures in reval.  It also
has the side effect of suppressing the ‘Unbalanced string table
refcount’ warnings, at least in some cases.  This was brought up in
ticket #107000.

3 files changed, 26 insertions, 5 deletions

diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index a8114ccf36..b578bc7984 100644
--- a/dist/Safe/Safe.pm
+++ b/dist/Safe/Safe.pm
@@ -1,7 +1,6 @@
 package Safe;
 
 use 5.003_11;
-use strict;
 use Scalar::Util qw(reftype refaddr);
 
 $Safe::VERSION = "2.32";
@@ -22,10 +21,11 @@ sub lexless_anon_sub {
     # Uses a closure (on $__ExPr__) to pass in the code to be executed.
     # (eval on one line to keep line numbers as expected by caller)
     eval sprintf
-    'package %s; %s strict; sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
-                $_[0], $_[1] ? 'use' : 'no';
+    'package %s; %s sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
+                $_[0], $_[1] ? 'use strict;' : '';
 }
 
+use strict;
 use Carp;
 BEGIN { eval q{
     use Carp::Heavy;
diff --git a/dist/Safe/t/safeload.t b/dist/Safe/t/safeload.t
index 2d2c3ccb4a..6ff7a762ea 100644
--- a/dist/Safe/t/safeload.t
+++ b/dist/Safe/t/safeload.t
@@ -18,9 +18,16 @@ 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 $@;
+
+# Does this test really belong here?  We are testing the "loading" of
+# a perl version number.
+# This should died because of strictures under 5.12+ and because of the
+# perl version in 5.10-.
+ok !$c->reval(q{use 5.012; $undeclared; 1}),
+   'reval does not prevent use 5.012 from enabling strict';
diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t
index 7f981e0f5c..885b0db150 100644
--- a/dist/Safe/t/safeops.t
+++ b/dist/Safe/t/safeops.t
@@ -40,7 +40,7 @@ while (<$fh>) {
 }
 close $fh;
 
-plan(tests => scalar @op);
+plan(tests => scalar @op + 1);
 
 sub testop {
     my ($op, $opname, $code) = @_;
@@ -61,6 +61,20 @@ foreach (@op) {
     }
 }
 
+# Test also that the errors resulting from disallowed ops do not cause
+# ‘Unbalanced’ warnings.
+{
+    local $ENV{PERL_DESTRUCT_LEVEL}=2;
+    unlike
+	runperl(
+	    switches => [ '-MSafe', '-w' ],
+	    prog     => 'Safe->new->reval(q(use strict))',
+	    stderr   => 1,
+	),
+	qr/Unbalanced/,
+	'No Unbalanced warnings when disallowing ops';
+}
+
 # things that begin with SKIP are skipped, for various reasons (notably
 # optree modified by the optimizer -- Safe checks are done before the
 # optimizer modifies the optree)