RE: Perl @ 33218 (Stratus VOS patches)

[p5sagit/p5-mst-13.2.git] / ext / Opcode / Safe.pm

diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index f4d3558..04a3b55 100644 (file)
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -3,7 +3,7 @@ package Safe;
 use 5.003_11;
 use strict;
 
-$Safe::VERSION = "2.12";
+$Safe::VERSION = "2.15";
 
 # *** Don't declare any lexicals above this point ***
 #
@@ -26,7 +26,9 @@ sub lexless_anon_sub {
 }
 
 use Carp;
-use Carp::Heavy;
+BEGIN { eval q{
+    use Carp::Heavy;
+} }
 
 use Opcode 1.01, qw(
     opset opset_to_ops opmask_add
@@ -38,7 +40,61 @@ use Opcode 1.01, qw(
 
 
 my $default_root  = 0;
-my $default_share = ['*_']; #, '*main::'];
+# share *_ and functions defined in universal.c
+# Don't share stuff like *UNIVERSAL:: otherwise code from the
+# compartment can 0wn functions in UNIVERSAL
+my $default_share = [qw[
+    *_
+    &PerlIO::get_layers
+    &Regexp::DESTROY
+    &UNIVERSAL::isa
+    &UNIVERSAL::can
+    &UNIVERSAL::VERSION
+    &utf8::is_utf8
+    &utf8::valid
+    &utf8::encode
+    &utf8::decode
+    &utf8::upgrade
+    &utf8::downgrade
+    &utf8::native_to_unicode
+    &utf8::unicode_to_native
+    $version::VERSION
+    $version::CLASS
+    @version::ISA
+], ($] >= 5.010 && qw[
+    &re::is_regexp
+    &re::regname
+    &re::regnames
+    &re::regnames_count
+    &Tie::Hash::NamedCapture::FETCH
+    &Tie::Hash::NamedCapture::STORE
+    &Tie::Hash::NamedCapture::DELETE
+    &Tie::Hash::NamedCapture::CLEAR
+    &Tie::Hash::NamedCapture::EXISTS
+    &Tie::Hash::NamedCapture::FIRSTKEY
+    &Tie::Hash::NamedCapture::NEXTKEY
+    &Tie::Hash::NamedCapture::SCALAR
+    &Tie::Hash::NamedCapture::flags
+    &UNIVERSAL::DOES
+    &version::()
+    &version::new
+    &version::(""
+    &version::stringify
+    &version::(0+
+    &version::numify
+    &version::normal
+    &version::(cmp
+    &version::(<=>
+    &version::vcmp
+    &version::(bool
+    &version::boolean
+    &version::(nomethod
+    &version::noop
+    &version::is_alpha
+    &version::qv
+]), ($] >= 5.011 && qw[
+    &re::regexp_pattern
+])];
 
 sub new {
     my($class, $root, $mask) = @_;
@@ -183,9 +239,6 @@ sub share_from {
     my $arg;
     foreach $arg (@$vars) {
        # catch some $safe->share($var) errors:
-       croak("'$arg' not a valid symbol table name")
-           unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/
-               or $arg =~ /^\$\W$/;
        my ($var, $type);
        $type = $1 if ($var = $arg) =~ s/^(\W)//;
        # warn "share_from $pkg $type $var";
@@ -566,11 +619,11 @@ but more subtle effect.
 
 =head2 AUTHOR
 
-Originally designed and implemented by Malcolm Beattie,
-mbeattie@sable.ox.ac.uk.
+Originally designed and implemented by Malcolm Beattie.
 
-Reworked to use the Opcode module and other changes added by Tim Bunce
-E<lt>F<Tim.Bunce@ig.co.uk>E<gt>.
+Reworked to use the Opcode module and other changes added by Tim Bunce.
+
+Currently maintained by the Perl 5 Porters, <perl5-porters@perl.org>.
 
 =cut