From: Malcolm Beattie Date: Wed, 8 Oct 1997 10:19:27 +0000 (+0000) Subject: Merge maint-5.004 branch (5.004_03) with mainline. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93af7a870f71dbbb13443b4087703de0221add17;p=p5sagit%2Fp5-mst-13.2.git Merge maint-5.004 branch (5.004_03) with mainline. MANIFEST is out of sync. p4raw-id: //depot/perl@114 --- 93af7a870f71dbbb13443b4087703de0221add17 diff --cc ext/DB_File/DB_File.pm index e097046,df1593f..9ed5185 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@@ -1,8 -1,8 +1,8 @@@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - # last modified 31st May 1997 - # version 1.15 -# last modified 29th Jun 1997 -# version 1.15 ++# last modified 8th Oct 1997 ++# version 1.16 # # Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@@ -1668,8 -1663,19 +1663,23 @@@ ordinary array to a HASH or BTREE datab =item 1.15 + Patch from Gisle Aas to suppress "use of undefined + value" warning with db_get and db_seq. + + Patch from Gisle Aas to make DB_File export only the O_* + constants from Fcntl. + + Removed the DESTROY method from the DB_File::HASHINFO module. + + Previously DB_File hard-wired the class name of any object that it + created to "DB_File". This makes sub-classing difficult. Now DB_File + creats objects in the namespace of the package it has been inherited + into. + ++=item 1.16 ++ +Minor changes to DB_File.xs to support multithreaded perl. + =back =head1 BUGS diff --cc ext/DB_File/DB_File.xs index cc70b5d,d2c7e6c..bd0c933 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@@ -3,8 -3,8 +3,8 @@@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 31st May 1997 - version 1.15 - last modified 29th Jun 1997 - version 1.15 ++ last modified 8th Oct 1997 ++ version 1.16 All comments/suggestions/problems are welcome @@@ -42,7 -42,9 +42,9 @@@ 1.13 - Tidied up a few casts. 1.14 - Made it illegal to tie an associative array to a RECNO database and an ordinary array to a HASH or BTREE database. - 1.15 - Minor additions to DB_File.xs to support multithreaded perl. + 1.15 - Patch from Gisle Aas to suppress "use of + undefined value" warning with db_get and db_seq. - ++ 1.16 - Minor additions to DB_File.xs to support multithreaded perl. */ diff --cc gv.c index 5dcf8e0,6658259..cfa96ee --- a/gv.c +++ b/gv.c @@@ -1348,12 -1339,12 +1350,12 @@@ int flags myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; ENTER; - SAVESPTR(op); + SAVEOP(); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; PUTBACK; - pp_pushmark(); + pp_pushmark(ARGS); EXTEND(sp, notfound + 5); PUSHs(lr>0? right: left); diff --cc hints/linux.sh index 54bc122,6a11a42..8ff7f5d --- a/hints/linux.sh +++ b/hints/linux.sh @@@ -183,14 -183,14 +183,25 @@@ els echo 'Your csh is really tcsh. Good.' fi + # Shimpei Yamashita + # Message-Id: <33EF1634.B36B6500@pobox.com> + # + # MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other + # linuces, needs special flags passed in order for dynamic loading to work. + # instead of the recommended: + # ccdlflags='-rdynamic' + # + # it should be: + # ccdlflags='-Wl,-E' + +if [ "X$usethreads" != "X" ]; then + ccflags="-D_REENTRANT -DUSE_THREADS $ccflags" + cppflags="-D_REENTRANT -DUSE_THREADS $cppflags" + # -lpthread needs to come before -lc but after other libraries such + # as -lgdbm and such like. We assume here that -lc is present in + # libswanted. If that fails to be true in future, then this can be + # changed to add pthread to the very end of libswanted. + set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + shift + libswanted="$*" +fi diff --cc op.c index 1973507,feae588..8a3debc --- a/op.c +++ b/op.c @@@ -1110,9 -1059,11 +1110,11 @@@ I32 type case OP_RV2AV: case OP_RV2HV: - if (!type && cUNOP->op_first->op_type != OP_GV) ++ if (!type && cUNOPo->op_first->op_type != OP_GV) + croak("Can't localize through a reference"); - if (type == OP_REFGEN && op->op_flags & OPf_PARENS) { + if (type == OP_REFGEN && o->op_flags & OPf_PARENS) { modcount = 10000; - return op; /* Treat \(@foo) like ordinary list. */ + return o; /* Treat \(@foo) like ordinary list. */ } /* FALL THROUGH */ case OP_RV2GV: @@@ -1130,9 -1081,9 +1132,9 @@@ modcount = 10000; break; case OP_RV2SV: - if (!type && cUNOP->op_first->op_type != OP_GV) + if (!type && cUNOPo->op_first->op_type != OP_GV) - croak("Can't localize a reference"); + croak("Can't localize through a reference"); - ref(cUNOP->op_first, op->op_type); + ref(cUNOPo->op_first, o->op_type); /* FALL THROUGH */ case OP_GV: case OP_AV2ARYLEN: @@@ -4641,10 -4526,10 +4653,10 @@@ OP *o } } } - op->op_private |= (hints & HINT_STRICT_REFS); + o->op_private |= (hints & HINT_STRICT_REFS); - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) - op->op_private |= OPpENTERSUB_DB; - while (o != cvop) { + o->op_private |= OPpENTERSUB_DB; + while (o2 != cvop) { if (proto) { switch (*proto) { case '\0': diff --cc perl.c index de66109,69b5c0e..db1cb59 --- a/perl.c +++ b/perl.c @@@ -1004,10 -895,8 +1016,10 @@@ PerlInterpreter *sv_interp PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename); my_exit(0); } - if (perldb && DBsingle) - sv_setiv(DBsingle, 1); + if (PERLDB_SINGLE && DBsingle) + sv_setiv(DBsingle, 1); + if (initav) + call_list(oldscope, initav); } /* do it */ diff --cc perl.h index 60b0e17,e33122a..62623af --- a/perl.h +++ b/perl.h @@@ -1310,26 -1283,9 +1316,21 @@@ typedef Sighandler_t Sigsave_t # ifndef register # define register # endif - # ifdef MYMALLOC - # ifndef DEBUGGING_MSTATS - # define DEBUGGING_MSTATS - # endif - # endif # define PAD_SV(po) pad_sv(po) +# define RUNOPS_DEFAULT runops_debug #else # define PAD_SV(po) curpad[po] +# define RUNOPS_DEFAULT runops_standard +#endif + +/* + * These need prototyping here because isn't + * included until after runops is initialised. + */ + +int runops_standard _((void)); +#ifdef DEBUGGING +int runops_debug _((void)); #endif /****************/ diff --cc pp_ctl.c index 929be04,561c9fd..15b975d --- a/pp_ctl.c +++ b/pp_ctl.c @@@ -1969,7 -1940,12 +1969,12 @@@ PP(pp_goto OP *oldop = op; for (ix = 1; enterops[ix]; ix++) { op = enterops[ix]; + /* Eventually we may want to stack the needed arguments + * for each op. For now, we punt on the hard ones. */ + if (op->op_type == OP_ENTERITER) + DIE("Can't \"goto\" into the middle of a foreach loop", + label); - (*op->op_ppaddr)(); + (*op->op_ppaddr)(ARGS); } op = oldop; } @@@ -2466,19 -2412,12 +2474,20 @@@ PP(pp_entereval /* prepare to compile string */ - if (perldb && curstash != debstash) + if (PERLDB_LINE && curstash != debstash) save_lines(GvAV(compiling.cop_filegv), linestr); PUTBACK; +#ifdef USE_THREADS + MUTEX_LOCK(&eval_mutex); + if (eval_owner && eval_owner != thr) + while (eval_owner) + COND_WAIT(&eval_cond, &eval_mutex); + eval_owner = thr; + MUTEX_UNLOCK(&eval_mutex); +#endif /* USE_THREADS */ ret = doeval(gimme); - if (perldb && was != sub_generation) { /* Some subs defined here. */ + if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */ + && ret != op->op_next) { /* Successive compilation. */ strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ } return DOCATCH(ret); diff --cc pp_hot.c index e8cb782,82372d0..fcf3d22 --- a/pp_hot.c +++ b/pp_hot.c @@@ -524,10 -499,8 +522,8 @@@ PP(pp_rv2hv if (SvROK(sv)) { wasref: hv = (HV*)SvRV(sv); - if (SvTYPE(hv) != SVt_PVHV) + if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV) DIE("Not a HASH reference"); - if (op->op_private & OPpLVAL_INTRO) - hv = (HV*)save_svref((SV**)sv); if (op->op_flags & OPf_REF) { SETs((SV*)hv); RETURN; diff --cc pp_sys.c index 7cded50,d0915e0..78f7af5 --- a/pp_sys.c +++ b/pp_sys.c @@@ -534,9 -533,9 +534,9 @@@ PP(pp_tie CATCH_SET(TRUE); ENTER; - SAVESPTR(op); + SAVEOP(); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; XPUSHs((SV*)GvCV(gv)); @@@ -645,12 -644,12 +645,12 @@@ PP(pp_dbmopen CATCH_SET(TRUE); ENTER; - SAVESPTR(op); + SAVEOP(); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; PUTBACK; - pp_pushmark(); + pp_pushmark(ARGS); EXTEND(sp, 5); PUSHs(sv); diff --cc regexec.c index 5493e28,271dc4d..0ed2bc7 --- a/regexec.c +++ b/regexec.c @@@ -136,6 -134,34 +136,35 @@@ regcppop( return input; } + /* After a successful match in WHILEM, we want to restore paren matches + * that have been overwritten by a failed match attempt in the process + * of reaching this success. We do this by restoring regstartp[i] + * wherever regendp[i] has not changed; if OPEN is changed to modify + * regendp[], the '== endp' test below should be changed to match. + * This corrects the error of: + * 0 > length [ "foobar" =~ / ( (foo) | (bar) )* /x ]->[1] + */ + static void + regcppartblow() + { ++ dTHR; + I32 i = SSPOPINT; + U32 paren; + char *startp; + char *endp; + assert(i == SAVEt_REGCONTEXT); + i = SSPOPINT; + /* input, lastparen, size */ + SSPOPPTR; SSPOPINT; SSPOPINT; + for (i -= 3; i > 0; i -= 3) { + paren = (U32)SSPOPINT; + startp = (char *) SSPOPPTR; + endp = (char *) SSPOPPTR; + if (paren <= *reglastparen && regendp[paren] == endp) + regstartp[paren] = startp; + } + } + #define regcpblow(cp) leave_scope(cp) /* diff --cc sv.c index ab08483,6e40732..e7d824b --- a/sv.c +++ b/sv.c @@@ -1731,12 -1716,15 +1734,16 @@@ STRLEN *lp if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); olderrno = errno; /* some Xenix systems wipe out errno here */ - sv_setpvf(sv, "%Vd", SvIVX(sv)); + sv_setpviv(sv, SvIVX(sv)); errno = olderrno; s = SvEND(sv); + if (oldIOK) + SvIOK_on(sv); + else + SvIOKp_on(sv); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); *lp = 0;