]>
Commit | Line | Data |
---|---|---|
63d652d6 JB |
1 | --- perl-5.6.1.orig/ext/Opcode/Safe.pm |
2 | +++ perl-5.6.1/ext/Opcode/Safe.pm | |
9768ced4 | 3 | @@ -3,7 +3,7 @@ |
4 | use 5.003_11; | |
5 | use strict; | |
6 | ||
7 | -our $VERSION = "2.06"; | |
8 | +$Safe::VERSION = "2.09"; | |
9 | ||
10 | use Carp; | |
11 | ||
12 | @@ -47,6 +47,7 @@ | |
13 | # the whole glob *_ rather than $_ and @_ separately, otherwise | |
14 | # @_ in non default packages within the compartment don't work. | |
15 | $obj->share_from('main', $default_share); | |
16 | + Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04); | |
17 | return $obj; | |
18 | } | |
19 | ||
20 | @@ -154,7 +155,7 @@ | |
21 | my $no_record = shift || 0; | |
22 | my $root = $obj->root(); | |
23 | croak("vars not an array ref") unless ref $vars eq 'ARRAY'; | |
24 | - no strict 'refs'; | |
25 | + no strict 'refs'; | |
26 | # Check that 'from' package actually exists | |
27 | croak("Package \"$pkg\" does not exist") | |
28 | unless keys %{"$pkg\::"}; | |
29 | @@ -189,7 +190,7 @@ | |
30 | sub share_redo { | |
31 | my $obj = shift; | |
32 | my $shares = \%{$obj->{Shares} ||= {}}; | |
33 | - my($var, $pkg); | |
34 | + my($var, $pkg); | |
35 | while(($var, $pkg) = each %$shares) { | |
36 | # warn "share_redo $pkg\:: $var"; | |
37 | $obj->share_from($pkg, [ $var ], 1); | |
38 | @@ -213,11 +214,11 @@ | |
63d652d6 JB |
39 | # Create anon sub ref in root of compartment. |
40 | # Uses a closure (on $expr) to pass in the code to be executed. | |
41 | # (eval on one line to keep line numbers as expected by caller) | |
42 | - my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); | |
9768ced4 | 43 | + my $evalcode = sprintf('package %s; sub { @_ = (); eval $expr; }', $root); |
63d652d6 JB |
44 | my $evalsub; |
45 | ||
9768ced4 | 46 | - if ($strict) { use strict; $evalsub = eval $evalcode; } |
47 | - else { no strict; $evalsub = eval $evalcode; } | |
48 | + if ($strict) { use strict; $evalsub = eval $evalcode; } | |
49 | + else { no strict; $evalsub = eval $evalcode; } | |
50 | ||
51 | return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); | |
52 | } | |
53 | @@ -227,7 +228,7 @@ | |
63d652d6 JB |
54 | my $root = $obj->{Root}; |
55 | ||
56 | my $evalsub = eval | |
57 | - sprintf('package %s; sub { do $file }', $root); | |
58 | + sprintf('package %s; sub { @_ = (); do $file }', $root); | |
59 | return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); | |
60 | } | |
61 | ||
9768ced4 | 62 | @@ -379,11 +380,12 @@ |
63 | =item share (NAME, ...) | |
64 | ||
65 | This shares the variable(s) in the argument list with the compartment. | |
66 | -This is almost identical to exporting variables using the L<Exporter(3)> | |
67 | +This is almost identical to exporting variables using the L<Exporter> | |
68 | module. | |
69 | ||
70 | -Each NAME must be the B<name> of a variable, typically with the leading | |
71 | -type identifier included. A bareword is treated as a function name. | |
72 | +Each NAME must be the B<name> of a non-lexical variable, typically | |
73 | +with the leading type identifier included. A bareword is treated as a | |
74 | +function name. | |
75 | ||
76 | Examples of legal names are '$foo' for a scalar, '@foo' for an | |
77 | array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo' | |
78 | @@ -425,7 +427,7 @@ | |
79 | Any attempt by the code in STRING to use an operator which is not permitted | |
80 | by the compartment will cause an error (at run-time of the main program | |
81 | but at compile-time for the code in STRING). The error is of the form | |
82 | -"%s trapped by operation mask operation...". | |
83 | +"'%s' trapped by operation mask...". | |
84 | ||
85 | If an operation is trapped in this way, then the code in STRING will | |
86 | not be executed. If such a trapped operation occurs or any other |