Permalink
Browse files

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.
  • Loading branch information...
1 parent 96f88f6 commit 25dc25e774abbe993644899cf4d9f9925a9fb9a8 Father Chrysostomos committed Mar 31, 2012
Showing with 26 additions and 5 deletions.
  1. +3 −3 dist/Safe/Safe.pm
  2. +8 −1 dist/Safe/t/safeload.t
  3. +15 −1 dist/Safe/t/safeops.t
View
@@ -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;
View
@@ -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';
View
@@ -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)

0 comments on commit 25dc25e

Please sign in to comment.