diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-02-11 07:29:00 +1200 |
|---|---|---|
| committer | Chip Salzenberg <chip@atlantic.net> | 1997-02-11 07:29:00 +1200 |
| commit | 4fdae80067c447c675a6ac92c7959d2206e207ba (patch) | |
| tree | 740e9f3cd04f3c2347cb569c759c89cd6ee2974b /pp_ctl.c | |
| parent | 2752eb9f87187a7a0fa57ed387bf0cc9633772a9 (diff) | |
| download | perl-4fdae80067c447c675a6ac92c7959d2206e207ba.tar.gz | |
[inseparable changes from patch from perl5.003_25 to perl5.003_26]perl-5.003_26
CORE LANGUAGE CHANGES
Subject: Make \r in script an error (per Larry)
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod toke.c
CORE PORTABILITY
Subject: VMS patches post _25
Date: Fri, 07 Feb 1997 01:56:12 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: Porting/Glossary lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp perl.c vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl vms/perlvms.pod vms/vms.c vms/vmsish.h x2p/a2p.c
private-msgid: <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu>
LIBRARY AND EXTENSIONS
Subject: Make diagnostics module strip formatting directives
From: Chip Salzenberg <chip@perl.com>
Files: lib/diagnostics.pm pod/perldiag.pod
OTHER CORE CHANGES
Subject: Fix (yet another) Tk closure problem
From: Chip Salzenberg <chip@perl.com>
Files: op.c perl.c pp_ctl.c
Subject: Fix value of C<foreach>
From: Chip Salzenberg <chip@perl.com>
Files: cop.h pp_ctl.c
Subject: Refine 'runaway string' heuristic
From: Chip Salzenberg <chip@perl.com>
Files: toke.c
Subject: Fix core dump on C<print "a", last> in eval
From: Chip Salzenberg <chip@perl.com>
Files: pp_ctl.c
Diffstat (limited to 'pp_ctl.c')
| -rw-r--r-- | pp_ctl.c | 16 |
1 files changed, 11 insertions, 5 deletions
@@ -1287,9 +1287,9 @@ PP(pp_leaveloop) SV **mark; POPBLOCK(cx,newpm); + mark = newsp; POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ - mark = newsp; if (gimme == G_SCALAR) { if (op->op_private & OPpLEAVE_VOID) ; @@ -1422,8 +1422,7 @@ PP(pp_last) case CXt_LOOP: POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ pop2 = CXt_LOOP; - nextop = cx->blk_loop.last_op->op_next; - LEAVE; + nextop = cxloop.last_op->op_next; break; case CXt_SUB: POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ @@ -1458,6 +1457,7 @@ PP(pp_last) switch (pop2) { case CXt_LOOP: POPLOOP2(); /* release loop vars ... */ + LEAVE; break; case CXt_SUB: POPSUB2(); /* release CV and @_ ... */ @@ -2035,10 +2035,8 @@ int gimme; DEBUG_x(dump_eval()); /* Register with debugger: */ - if (perldb && saveop->op_type == OP_REQUIRE) { CV *cv = perl_get_cv("DB::postponed", FALSE); - if (cv) { dSP; PUSHMARK(sp); @@ -2050,6 +2048,8 @@ int gimme; /* compiled okay, so do it */ + CvDEPTH(compcv) = 1; + SP = stack_base + POPMARK; /* pop original mark */ RETURNOP(eval_start); } @@ -2271,6 +2271,11 @@ PP(pp_leaveeval) } curpm = newpm; /* Don't pop $1 et al till now */ +#ifdef DEBUGGING + assert(CvDEPTH(compcv) == 1); +#endif + CvDEPTH(compcv) = 0; + if (optype == OP_REQUIRE && !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) { char *name = cx->blk_eval.old_name; @@ -2282,6 +2287,7 @@ PP(pp_leaveeval) lex_end(); LEAVE; + if (!(save_flags & OPf_SPECIAL)) sv_setpv(GvSV(errgv),""); |