From: Malcolm Beattie Date: Thu, 16 Oct 1997 11:09:25 +0000 (+0000) Subject: Merge maint-5.004 branch (5.004_04) with mainline. X-Git-Tag: accepted/trunk/20130322.191538~38014 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=d58bf5aa3d3631a46847733b1ff1985b30140228;p=platform%2Fupstream%2Fperl.git Merge maint-5.004 branch (5.004_04) with mainline. p4raw-id: //depot/perl@137 --- d58bf5aa3d3631a46847733b1ff1985b30140228 diff --cc MANIFEST index e6b3b41,26a5409..9c8ace9 --- a/MANIFEST +++ b/MANIFEST @@@ -208,10 -206,6 +208,9 @@@ ext/SDBM_File/typemap SDBM extension i ext/Socket/Makefile.PL Socket extension makefile writer ext/Socket/Socket.pm Socket extension Perl module ext/Socket/Socket.xs Socket extension external subroutines +ext/attrs/Makefile.PL attrs extension makefile writer +ext/attrs/attrs.pm attrs extension Perl module +ext/attrs/attrs.xs attrs extension external subroutines - ext/util/extliblist Used by extension Makefile.PL to make lib lists ext/util/make_ext Used by Makefile to execute extension Makefiles ext/util/mkbootstrap Turns ext/*/*_BS into bootstrap info form.h Public declarations for the above diff --cc embed.h index a824b0a,51e5f40..a34d057 --- a/embed.h +++ b/embed.h @@@ -338,9 -324,9 +339,10 @@@ #define magic_gettaint Perl_magic_gettaint #define magic_getuvar Perl_magic_getuvar #define magic_len Perl_magic_len +#define magic_mutexfree Perl_magic_mutexfree #define magic_nextpack Perl_magic_nextpack #define magic_set Perl_magic_set + #define magic_set_all_env Perl_magic_set_all_env #define magic_setamagic Perl_magic_setamagic #define magic_setarylen Perl_magic_setarylen #define magic_setbm Perl_magic_setbm diff --cc mg.c index e02a1d2,ee87d47..dedf381 --- a/mg.c +++ b/mg.c @@@ -384,6 -391,14 +391,17 @@@ MAGIC *mg case '\020': /* ^P */ sv_setiv(sv, (IV)perldb); break; + case '\023': /* ^S */ - if (lex_state != LEX_NOTPARSING) - SvOK_off(sv); - else if (in_eval) - sv_setiv(sv, 1); - else - sv_setiv(sv, 0); ++ { ++ dTHR; ++ if (lex_state != LEX_NOTPARSING) ++ SvOK_off(sv); ++ else if (in_eval) ++ sv_setiv(sv, 1); ++ else ++ sv_setiv(sv, 0); ++ } + break; case '\024': /* ^T */ #ifdef BIG_TIME sv_setnv(sv, basetime); @@@ -658,6 -669,28 +676,29 @@@ MAGIC* mg } int + magic_set_all_env(sv,mg) + SV* sv; + MAGIC* mg; + { + #if defined(VMS) + die("Can't make list assignment to %%ENV on this system"); + #else ++ dTHR; + if (localizing) { + HE* entry; + magic_clear_all_env(sv,mg); + hv_iterinit((HV*)sv); + while (entry = hv_iternext((HV*)sv)) { + I32 keylen; + my_setenv(hv_iterkey(entry, &keylen), + SvPV(hv_iterval((HV*)sv, entry), na)); + } + } + #endif + return 0; + } + + int magic_clear_all_env(sv,mg) SV* sv; MAGIC* mg; diff --cc op.c index 8a3debc,8e8811d..7c769d1 --- a/op.c +++ b/op.c @@@ -2872,10 -2808,11 +2874,11 @@@ OP *cont OP *redo; OP *next = 0; OP *listop; - OP *op; + OP *o; OP *condop; - if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) { + if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB + || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) { expr = newUNOP(OP_DEFINED, 0, newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) ); } @@@ -3892,20 -3792,20 +3902,20 @@@ OP *o } OP * -ck_eof(op) -OP *op; +ck_eof(o) +OP *o; { - I32 type = op->op_type; + I32 type = o->op_type; - if (op->op_flags & OPf_KIDS) { - if (cLISTOP->op_first->op_type == OP_STUB) { - op_free(op); - op = newUNOP(type, OPf_SPECIAL, - newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV))); + if (o->op_flags & OPf_KIDS) { + if (cLISTOPo->op_first->op_type == OP_STUB) { + op_free(o); + o = newUNOP(type, OPf_SPECIAL, - newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV))); ++ newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV))); } - return ck_fun(op); + return ck_fun(o); } - return op; + return o; } OP * @@@ -4072,9 -3970,9 +4082,9 @@@ OP *o } } else { - op_free(op); + op_free(o); if (type == OP_FTTTY) - return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE, + return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE, SVt_PVIO)); else return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); @@@ -4222,33 -4119,39 +4232,31 @@@ OP *o } OP * -ck_glob(op) -OP *op; +ck_glob(o) +OP *o; { - GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV); + GV *gv; + + if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling) + append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv))); + + if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv))) + gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); if (gv && GvIMPORTED_CV(gv)) { static int glob_index; - append_elem(OP_GLOB, op, + append_elem(OP_GLOB, o, newSVOP(OP_CONST, 0, newSViv(glob_index++))); - o->op_type = OP_LIST; - o->op_ppaddr = ppaddr[OP_LIST]; - cLISTOPo->op_first->op_type = OP_PUSHMARK; - cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK]; - o = newUNOP(OP_ENTERSUB, OPf_STACKED, - append_elem(OP_LIST, o, - scalar(newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, gv))))); - return ck_subr(o); - } - if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) - append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv))); - op->op_type = OP_LIST; - op->op_ppaddr = ppaddr[OP_LIST]; - ((LISTOP*)op)->op_first->op_type = OP_PUSHMARK; - ((LISTOP*)op)->op_first->op_ppaddr = ppaddr[OP_PUSHMARK]; - op = newUNOP(OP_ENTERSUB, OPf_STACKED, - append_elem(OP_LIST, op, - scalar(newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, gv))))); - op = newUNOP(OP_NULL, 0, ck_subr(op)); - op->op_targ = OP_GLOB; /* hint at what it used to be */ - return op; ++ o = newUNOP(OP_NULL, 0, ck_subr(o)); ++ o->op_targ = OP_GLOB; /* hint at what it used to be */ ++ return o; + } gv = newGVgen("main"); gv_IOadd(gv); - append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv)); - scalarkids(op); - return ck_fun(op); + append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv)); + scalarkids(o); + return ck_fun(o); } OP * @@@ -4739,14 -4628,15 +4747,15 @@@ OP *o } } else - list(o); - mod(o, OP_ENTERSUB); - prev = o; - o = o->op_sibling; + list(o2); + mod(o2, OP_ENTERSUB); + prev = o2; + o2 = o2->op_sibling; } - if (proto && !optional && *proto == '$') + if (proto && !optional && + (*proto && *proto != '@' && *proto != '%' && *proto != ';')) - return too_few_arguments(op, gv_ename(namegv)); - return op; + return too_few_arguments(o, gv_ename(namegv)); + return o; } OP * diff --cc pp_ctl.c index 15b975d,516e41e..d14fa4b --- a/pp_ctl.c +++ b/pp_ctl.c @@@ -2272,14 -2224,9 +2272,15 @@@ int gimme /* compiled okay, so do it */ CvDEPTH(compcv) = 1; - SP = stack_base + POPMARK; /* pop original mark */ + op = saveop; /* The caller may need it. */ +#ifdef USE_THREADS + MUTEX_LOCK(&eval_mutex); + eval_owner = 0; + COND_SIGNAL(&eval_cond); + MUTEX_UNLOCK(&eval_mutex); +#endif /* USE_THREADS */ + RETURNOP(eval_start); } diff --cc regexec.c index 0ed2bc7,c640d67..e5d9e4d --- a/regexec.c +++ b/regexec.c @@@ -145,9 -143,9 +145,10 @@@ regcppop( * 0 > length [ "foobar" =~ / ( (foo) | (bar) )* /x ]->[1] */ static void - regcppartblow() + regcppartblow(base) + I32 base; { + dTHR; I32 i = SSPOPINT; U32 paren; char *startp; diff --cc scope.c index 7628196,3006f1a..3fc1a0e --- a/scope.c +++ b/scope.c @@@ -177,8 -165,12 +177,13 @@@ save_gp(gv, empty GV *gv; I32 empty; { + dTHR; - SSCHECK(3); + SSCHECK(6); + SSPUSHIV((IV)SvLEN(gv)); + SvLEN(gv) = 0; /* forget that anything was allocated here */ + SSPUSHIV((IV)SvCUR(gv)); + SSPUSHPTR(SvPVX(gv)); + SvPOK_off(gv); SSPUSHPTR(SvREFCNT_inc(gv)); SSPUSHPTR(GvGP(gv)); SSPUSHINT(SAVEt_GP); @@@ -201,10 -193,11 +206,12 @@@ AV save_ary(gv) GV *gv; { + dTHR; + AV *oav, *av; + SSCHECK(3); SSPUSHPTR(gv); - SSPUSHPTR(GvAVn(gv)); + SSPUSHPTR(oav = GvAVn(gv)); SSPUSHINT(SAVEt_AV); GvAV(gv) = Null(AV*); @@@ -215,10 -218,11 +232,12 @@@ HV save_hash(gv) GV *gv; { + dTHR; + HV *ohv, *hv; + SSCHECK(3); SSPUSHPTR(gv); - SSPUSHPTR(GvHVn(gv)); + SSPUSHPTR(ohv = GvHVn(gv)); SSPUSHINT(SAVEt_HV); GvHV(gv) = Null(HV*); @@@ -661,8 -674,7 +720,8 @@@ voi cx_dump(cx) CONTEXT* cx; { + dTHR; - PerlIO_printf(Perl_debug_log, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]); + PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]); if (cx->cx_type != CXt_SUBST) { PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);