diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-12-19 16:44:00 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1996-12-19 16:44:00 +1200 |
commit | 5f05dabc4054964aa3b10f44f8468547f051cdf8 (patch) | |
tree | 7bcc2c7b6d5cf44e7f0111bac2240ca979d9c804 /pp_hot.c | |
parent | 6a3992aa749356d657a4c0e14be8c2f4c2f4f999 (diff) | |
download | perl-5f05dabc4054964aa3b10f44f8468547f051cdf8.tar.gz |
[inseparable changes from patch from perl5.003_11 to perl5.003_12]
CORE LANGUAGE CHANGES
Subject: Support C<delete @hash{@keys}>
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c op.h opcode.pl pod/perldiag.pod pod/perlfunc.pod pp.c t/op/delete.t
Subject: Autovivify scalars
From: Chip Salzenberg <chip@atlantic.net>
Files: dump.c op.c op.h pp.c pp_hot.c
DOCUMENTATION
Subject: Update pods: perldelta -> perlnews, perli18n -> perllocale
From: Tom Christiansen <tchrist@perl.com>
Files: MANIFEST pod/perl.pod pod/perldelta.pod pod/perli18n.pod pod/perlnews.pod
Subject: perltoot.pod
Date: Mon, 09 Dec 1996 07:44:10 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Files: MANIFEST pod/perltoot.pod
Msg-ID: <199612091444.HAA09947@toy.perl.com>
(applied based on p5p patch as commit 32e22efaa9ec59b73a208b6c532a0b435e2c6462)
Subject: Perlguts, version 25
Date: Fri, 6 Dec 96 11:40:27 PST
From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
Files: pod/perlguts.pod
private-msgid: <199612061940.AA055461228@hpcc123.corp.hp.com>
Subject: pod patches for English errors
Date: Mon, 09 Dec 1996 13:33:11 -0800
From: Steve Kelem <steve.kelem@xilinx.com>
Files: pod/*.pod
Msg-ID: <24616.850167191@castor>
(applied based on p5p patch as commit 0135f10892ed8a21c4dbd1fca21fbcc365df99dd)
Subject: Misc doc updates
Date: Sat, 14 Dec 1996 18:56:33 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Files: pod/*
Subject: Re: perldelta.pod
Here are some diffs to the _11 pods. I forgot to add perldelta to
perl.pod though.
And *PLEASE* fix the Artistic License so it no longer has the bogus
"whomever" misdeclined in the nominative case:
under the copyright of this Package, but belong to whomever generated
them, and may be sold commercially, and may be aggregated with this
It should obviously be "whoever".
p5p-msgid: <199612150156.SAA12506@mox.perl.com>
OTHER CORE CHANGES
Subject: Allow assignment to empty array values during foreach()
From: Chip Salzenberg <chip@atlantic.net>
Files: cop.h global.sym mg.c op.c perl.h pp_hot.c proto.h sv.c
Subject: Fix nested closures
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c opcode.pl pp.c pp_ctl.c pp_hot.c
Subject: Fix core dump on auto-vivification
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_hot.c
Subject: Fix core dump on C<open $undef_var, "X">
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c
Subject: Fix -T/-B on globs and globrefs
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_sys.c
Subject: Fix memory management of $`, $&, and $'
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_hot.c regexec.c
Subject: Fix paren matching during backtracking
From: Chip Salzenberg <chip@atlantic.net>
Files: regexec.c
Subject: Fix memory leak and std{in,out,err} death in perl_{con,de}str
From: Chip Salzenberg <chip@atlantic.net>
Files: miniperlmain.c perl.c perl.h sv.c
Subject: Discard garbage bytes at end of prototype()
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c
Subject: Fix local($pack::{foo})
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym pp.c pp_hot.c proto.h scope.c
Subject: Disable warn, die, and parse hooks _before_ global destruction
From: Chip Salzenberg <chip@atlantic.net>
Files: perl.c
Subject: Re: Bug in formline
Date: Sun, 08 Dec 1996 14:58:32 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pp_ctl.c
Msg-ID: <199612081958.OAA26025@aatma.engin.umich.edu>
(applied based on p5p patch as commit b386bda18108ba86d0b76ebe2d8745eafa80f39e)
Subject: Fix C<@a = ($a,$b,$c,$d) = (1,2)>
From: Chip Salzenberg <chip@atlantic.net>
Files: pp_hot.c
Subject: Properly support and document newRV{,_inc,_noinc}
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym pod/perlguts.pod sv.c sv.h
Subject: Allow lvalue pos inside recursive function
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c pp.c pp_ctl.c pp_hot.c
PORTABILITY
Subject: Make $privlib contents compatible with 5.003
From: Chip Salzenberg <chip@atlantic.net>
Files: INSTALL ext/Opcode/Safe.pm installperl lib/FileHandle.pm lib/Test/Harness.pm
Subject: Support $bincompat3 config variable; update metaconfig units
From: Chip Salzenberg <chip@atlantic.net>
Files: Configure MANIFEST compat3.sym config_h.SH embed.pl global.sym old_embed.pl old_global.sym old_perl_exp.SH perl_exp.SH
Subject: Look for gettimeofday() in Configure
Date: Wed, 11 Dec 1996 15:49:57 +0100
From: John Hughes <john@AtlanTech.COM>
Files: Configure config_H config_h.SH pp.c
Subject: perl5.003_11, Should base use of gettimeofday on HAS_GETTIMEOFDAY, not I_SYS_TIME
I've been installing perl5.003_11 on a SCO system that has the TCP/IP runtime
installed but not the TCP/IP development system.
Unfortunately the <sys/time.h> include file is included in the TCP/IP runtime
while libsocket.a is in the development system.
This means that pp.c decides to use "gettimeofday" because <sys/time.h> is
present but I can't link the perl that gets compiled.
So, here's a patch to base the use of "gettimeofday" on "HAS_GETTIMEOFDAY"
instead of "I_SYS_TIME". I also took the liberty of removing the special
case for plan9 (I assume plan9 has <sys/time.h> but no gettimeofday. Am I
right?).
p5p-msgid: <01BBE77A.F6F37F80@malvinas.AtlanTech.COM>
Subject: Make $startperl a relative path if people want portable scrip
From: Chip Salzenberg <chip@atlantic.net>
Files: Configure
Subject: Homogenize use of "eval exec" hack
From: Chip Salzenberg <chip@atlantic.net>
Files: Porting/Glossary eg/README eg/nih eg/sysvipc/ipcmsg eg/sysvipc/ipcsem eg/sysvipc/ipcshm lib/diagnostics.pm makeaperl.SH pod/checkpods.PL pod/perlrun.pod pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL x2p/a2py.c x2p/find2perl.PL x2p/s2p.PL
Subject: LynxOS support
Date: Thu, 12 Dec 1996 09:25:00 PST
From: Greg Seibert <seibert@Lynx.COM>
Files: Configure MANIFEST hints/lynxos.sh t/op/stat.t
Msg-ID: <m0vYEsY-0000IZC@kzinti.lynx.com>
(applied based on p5p patch as commit 6693373533b15e559fd8f0f1877e5e6ec15483cc)
Subject: Re: db-recno.t failures with _11 on Freebsd 2.1-stable
Date: 11 Dec 1996 18:58:56 -0500
From: Roderick Schertler <roderick@gate.net>
Files: INSTALL hints/freebsd.sh
Msg-ID: <pzohg0r5tr.fsf@eeyore.ibcinc.com>
(applied based on p5p patch as commit 10e40321ee752c58e3407b204c74c8049894cb51)
Subject: VMS patches to 5.003_11
Date: Mon, 09 Dec 1996 23:16:10 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: MANIFEST regexec.c t/lib/filehand.t util.c vms/*
private-msgid: <01ICTR32LCZG001A1D@hmivax.humgen.upenn.edu>
TESTING
Subject: recurse recurse recurse ...
Date: Mon, 9 Dec 1996 23:44:27 +0200 (EET)
From: Jarkko Hietaniemi <jhi@cc.hut.fi>
Files: MANIFEST t/op/recurse.t
private-msgid: <199612092144.XAA29025@alpha.hut.fi>
UTILITIES, LIBRARY, AND EXTENSIONS
Subject: Add CPAN and Net::FTP
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm lib/Net/FTP.pm lib/Net/Netrc.pm lib/Net/Socket.pm pod/perlmod.pod
Subject: Add File::Compare
Date: Mon, 16 Dec 1996 18:44:59 GMT
From: Nick Ing-Simmons <nik@tiuk.ti.com>
Files: MANIFEST lib/File/Compare.pm pod/perlmod.pod
Msg-ID: <199612161844.SAA02152@pluto>
(applied based on p5p patch as commit ec971c5c328aca84fb827f69f2cc1dc3be81f830)
Subject: Add Tie::RefHash
Date: Sun, 15 Dec 1996 18:58:08 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: MANIFEST lib/Tie/RefHash.pm pod/perlmod.pod
Msg-ID: <199612152358.SAA28665@aatma.engin.umich.edu>
(applied based on p5p patch as commit 9a079709134ebbf4c935cc8752fdb564e5c82b94)
Subject: Put "splain" in utils.
From: Chip Salzenberg <chip@atlantic.net>
Files: Makefile.SH installperl utils/Makefile utils/splain.PL
Subject: Some h2ph fixes
Date: Fri, 13 Dec 1996 11:34:12 -0800
From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
Files: utils/h2ph.PL
Here is a message regarding changes to h2ph that should probably be folded
into the 5.004 release.
p5p-msgid: <199612131934.AA289845652@hpcc123.corp.hp.com>
Diffstat (limited to 'pp_hot.c')
-rw-r--r-- | pp_hot.c | 91 |
1 files changed, 64 insertions, 27 deletions
@@ -217,7 +217,7 @@ PP(pp_padsv) if (op->op_flags & OPf_MOD) { if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + else if (op->op_private & OPpDEREF) provide_ref(op, curpad[op->op_targ]); } RETURN; @@ -725,6 +725,8 @@ PP(pp_aassign) SP = lastrelem; else SP = firstrelem + (lastlelem - firstlelem); + while (relem <= SP) + *relem++ = &sv_undef; RETURN; } else { @@ -786,7 +788,7 @@ PP(pp_match) } if (!rx->nparens && !global) gimme = G_SCALAR; /* accidental array context? */ - safebase = (gimme == G_ARRAY) || global; + safebase = (((gimme == G_ARRAY) || global) && !sawampersand); if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { SAVEINT(multiline); multiline = pm->op_pmflags & PMf_MULTILINE; @@ -795,7 +797,7 @@ PP(pp_match) play_it_again: if (global && rx->startp[0]) { t = s = rx->endp[0]; - if (s > strend) + if (s >= strend) goto nope; minmatch = (s == rx->startp[0]); } @@ -868,6 +870,7 @@ play_it_again: } if (global) { truebase = rx->subbeg; + strend = rx->subend; if (rx->startp[0] && rx->startp[0] == rx->endp[0]) ++rx->endp[0]; goto play_it_again; @@ -885,7 +888,7 @@ play_it_again: mg = mg_find(TARG, 'g'); } if (rx->startp[0]) { - mg->mg_len = rx->endp[0] - truebase; + mg->mg_len = rx->endp[0] - rx->subbeg; if (rx->startp[0] == rx->endp[0]) mg->mg_flags |= MGf_MINMATCH; else @@ -903,6 +906,8 @@ yup: curpm = pm; if (pm->op_pmflags & PMf_ONCE) pm->op_pmflags |= PMf_USED; + Safefree(rx->subbase); + rx->subbase = Nullch; if (global) { rx->subbeg = truebase; rx->subend = strend; @@ -913,8 +918,6 @@ yup: if (sawampersand) { char *tmps; - if (rx->subbase) - Safefree(rx->subbase); tmps = rx->subbase = savepvn(t, strend-t); rx->subbeg = tmps; rx->subend = tmps + (strend-t); @@ -1234,9 +1237,13 @@ PP(pp_helem) if (lval) { if (!he || HeVAL(he) == &sv_undef) DIE(no_helem, SvPV(keysv, na)); - if (op->op_private & OPpLVAL_INTRO) - save_svref(&HeVAL(he)); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + if (op->op_private & OPpLVAL_INTRO) { + if (HvNAME(hv) && isGV(HeVAL(he))) + save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL)); + else + save_svref(&HeVAL(he)); + } + else if (op->op_private & OPpDEREF) provide_ref(op, HeVAL(he)); } PUSHs(he ? HeVAL(he) : &sv_undef); @@ -1300,7 +1307,7 @@ PP(pp_iter) { dSP; register CONTEXT *cx; - SV *sv; + SV* sv; AV* av; EXTEND(sp, 1); @@ -1314,13 +1321,26 @@ PP(pp_iter) if (cx->blk_loop.iterix >= AvFILL(av)) RETPUSHNO; - if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) { + if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) SvTEMP_off(sv); - *cx->blk_loop.itervar = sv; - } else - *cx->blk_loop.itervar = &sv_undef; - + sv = &sv_undef; + if (av != curstack && SvIMMORTAL(sv)) { + SV *lv = cx->blk_loop.iterlval; + if (lv) + SvREFCNT_dec(LvTARG(lv)); + else { + lv = cx->blk_loop.iterlval = newSVsv(sv); + sv_upgrade(lv, SVt_PVLV); + sv_magic(lv, Nullsv, 'y', Nullch, 0); + LvTYPE(lv) = 'y'; + } + LvTARG(lv) = SvREFCNT_inc(av); + LvTARGOFF(lv) = cx->blk_loop.iterix; + LvTARGLEN(lv) = 1; + sv = (SV*)lv; + } + *cx->blk_loop.itervar = sv; RETPUSHYES; } @@ -1370,7 +1390,7 @@ PP(pp_subst) pm = curpm; rx = pm->op_pmregexp; } - safebase = ((!rx || !rx->nparens) && !sawampersand); + safebase = (!rx->nparens && !sawampersand); if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { SAVEINT(multiline); multiline = pm->op_pmflags & PMf_MULTILINE; @@ -1518,7 +1538,7 @@ PP(pp_subst) else c = Nullch; if (pregexec(rx, s, strend, orig, 0, - SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { + SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { long_way: if (force_on_match) { force_on_match = 0; @@ -1550,8 +1570,7 @@ PP(pp_subst) sv_catpvn(dstr, c, clen); if (once) break; - } while (pregexec(rx, s, strend, orig, s == m, Nullsv, - safebase)); + } while (pregexec(rx, s, strend, orig, s == m, Nullsv, safebase)); sv_catpvn(dstr, s, strend - s); (void)SvOOK_off(TARG); @@ -1831,7 +1850,8 @@ PP(pp_entersub) if (CvDEPTH(cv) < 2) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ - if (CvDEPTH(cv) == 100 && dowarn) + if (CvDEPTH(cv) == 100 && dowarn + && !(perldb && cv == GvCV(DBsub))) warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv))); if (CvDEPTH(cv) > AvFILL(padlist)) { AV *av; @@ -1842,9 +1862,10 @@ PP(pp_entersub) for ( ;ix > 0; ix--) { if (svp[ix] != &sv_undef) { char *name = SvPVX(svp[ix]); - if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */ - av_store(newpad, ix, - SvREFCNT_inc(oldpad[ix]) ); + if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */ + || *name == '&') /* anonymous code? */ + { + av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); } else { /* our own lexical */ if (*name == '@') @@ -1929,7 +1950,7 @@ PP(pp_aelem) DIE(no_aelem, elem); if (op->op_private & OPpLVAL_INTRO) save_svref(svp); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + else if (op->op_private & OPpDEREF) provide_ref(op, *svp); } PUSHs(svp ? *svp : &sv_undef); @@ -1946,9 +1967,25 @@ SV* sv; if (!SvOK(sv)) { if (SvREADONLY(sv)) croak(no_modify); - (void)SvUPGRADE(sv, SVt_RV); - SvRV(sv) = (op->op_private & OPpDEREF_HV ? - (SV*)newHV() : (SV*)newAV()); + if (SvTYPE(sv) < SVt_RV) + sv_upgrade(sv, SVt_RV); + else if (SvTYPE(sv) >= SVt_PV) { + (void)SvOOK_off(sv); + Safefree(SvPVX(sv)); + SvLEN(sv) = SvCUR(sv) = 0; + } + switch (op->op_private & OPpDEREF) + { + case OPpDEREF_SV: + SvRV(sv) = newSV(0); + break; + case OPpDEREF_AV: + SvRV(sv) = (SV*)newAV(); + break; + case OPpDEREF_HV: + SvRV(sv) = (SV*)newHV(); + break; + } SvROK_on(sv); SvSETMAGIC(sv); } |