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