summaryrefslogtreecommitdiff
path: root/ext/Opcode
diff options
context:
space:
mode:
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>1997-03-22 15:34:25 +1200
committerChip Salzenberg <chip@atlantic.net>1997-03-22 15:34:25 +1200
commit3fe9a6f19eb206c685bd7389e54e2838fdfd04b7 (patch)
tree94845bcda5f58956e6c9ccef24340d1b5c93d182 /ext/Opcode
parent9a2c4ce3a0904191a580ec822adeb696331d31ce (diff)
downloadperl-3fe9a6f19eb206c685bd7389e54e2838fdfd04b7.tar.gz
[inseparable changes from match from perl-5.003_94 to perl-5.003_95]
CORE LANGUAGE CHANGES Subject: Don't compile scalar mods of aggregates, like C<@a =~ s/a/b/> From: Chip Salzenberg <chip@perl.com> Files: op.c t/op/misc.t Subject: Warn about undef magic values just like non-magic From: Chip Salzenberg <chip@perl.com> Files: ext/Opcode/Safe.pm sv.c t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t t/pragma/locale.t CORE PORTABILITY Subject: Win32 update (five patches) From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: MANIFEST README.win32 doio.c dosish.h pp_sys.c lib/ExtUtils/Command.pm t/comp/multiline.t t/op/magic.t t/op/mkdir.t t/op/runlevel.t t/op/stat.t t/op/write.t win32/Makefile win32/config.H win32/config.w32 win32/win32.c win32/win32.h win32/win32aux.c win32/*.mak win32/VC-2.0/*.mak DOCUMENTATION Subject: INSTALL-1.8 to INSTALL-1.9 updates Date: Tue, 25 Mar 1997 13:52:53 -0500 (EST) From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> Files: INSTALL Msg-ID: Pine.SOL.3.95q.970325135138.3374A-100000@fractal.lafayette.e (applied based on p5p patch as commit 9b1ae96a0b4301a9588f62b3175bc0312302f4b9) Subject: Document possible problems with -Mdiagnostics after upgrade From: Chip Salzenberg <chip@perl.com> Files: INSTALL Subject: Mention perldelta in INSTALL From: Chip Salzenberg <chip@perl.com> Files: INSTALL Subject: Describe pod format at top of INSTALL From: Chip Salzenberg <chip@perl.com> Files: INSTALL Subject: Document C</a *b/x> fix From: Chip Salzenberg <chip@perl.com> Files: pod/perldelta.pod Subject: pods for subroutine argument autovivication Date: Mon, 24 Mar 1997 07:25:21 +0000 From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> Files: pod/perldelta.pod pod/perlsub.pod Msg-ID: E0w9489-0005YT-00@ursa.cus.cam.ac.uk (applied based on p5p patch as commit db8878faa51a8a1541a40745a8613adb5db155e4) Subject: Missing item in perldiag Date: Sun, 23 Mar 1997 09:24:09 +0000 From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> Files: pod/perldiag.pod Msg-ID: E0w8jVZ-0005va-00@ursa.cus.cam.ac.uk (applied based on p5p patch as commit c00a529017138505fcbe538b74c7884abe1d18e1) Subject: Pod problems & fixes Date: Mon, 24 Mar 1997 21:31:51 +0100 (MET) From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> Files: INSTALL lib/Term/Complete.pm lib/subs.pm pod/perlcall.pod pod/perldata.pod pod/perldiag.pod pod/perlembed.pod pod/perlguts.pod pod/perlmod.pod pod/perlop.pod pod/perlpod.pod pod/pod2html.PL Msg-ID: 199703242031.VAA14997@bombur2.uio.no (applied based on p5p patch as commit 55a864fe4cea1a0586891b83d359ba71e0972da5) Subject: FAQ update From: Nathan Torkington <gnat@prometheus.frii.com> Files: pod/perlfaq*.pod OTHER CORE CHANGES Subject: Improve 'prototype mismatch' warning From: Chip Salzenberg <chip@perl.com> Files: global.sym op.c pod/perldiag.pod proto.h sv.c t/comp/redef.t
Diffstat (limited to 'ext/Opcode')
-rw-r--r--ext/Opcode/Safe.pm21
1 files changed, 11 insertions, 10 deletions
diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index 22772796e2..c9d741647e 100644
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -150,26 +150,27 @@ sub share_from {
my $vars = shift;
my $no_record = shift || 0;
my $root = $obj->root();
- my ($var, $arg);
croak("vars not an array ref") unless ref $vars eq 'ARRAY';
no strict 'refs';
# Check that 'from' package actually exists
croak("Package \"$pkg\" does not exist")
unless keys %{"$pkg\::"};
+ 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$/;
- ($var = $arg) =~ s/^(\W)//; # get type char
- # warn "share_from $pkg $1 $var";
- *{$root."::$var"} = ($1 eq '$') ? \${$pkg."::$var"}
- : ($1 eq '@') ? \@{$pkg."::$var"}
- : ($1 eq '%') ? \%{$pkg."::$var"}
- : ($1 eq '*') ? *{$pkg."::$var"}
- : ($1 eq '&') ? \&{$pkg."::$var"}
- : (!$1) ? \&{$pkg."::$var"}
- : croak(qq(Can't share "$1$var" of unknown type));
+ my ($var, $type);
+ $type = $1 if ($var = $arg) =~ s/^(\W)//;
+ # warn "share_from $pkg $type $var";
+ *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"}
+ : ($type eq '&') ? \&{$pkg."::$var"}
+ : ($type eq '$') ? \${$pkg."::$var"}
+ : ($type eq '@') ? \@{$pkg."::$var"}
+ : ($type eq '%') ? \%{$pkg."::$var"}
+ : ($type eq '*') ? *{$pkg."::$var"}
+ : croak(qq(Can't share "$type$var" of unknown type));
}
$obj->share_record($pkg, $vars) unless $no_record or !$vars;
}