diff options
| -rw-r--r-- | AUTHORS | 7 | ||||
| -rw-r--r-- | av.c | 2 | ||||
| -rw-r--r-- | doio.c | 8 | ||||
| -rw-r--r-- | doop.c | 13 | ||||
| -rw-r--r-- | ext/ByteLoader/bytecode.h | 1 | ||||
| -rw-r--r-- | ext/Cwd/Cwd.xs | 2 | ||||
| -rw-r--r-- | ext/DB_File/DB_File.xs | 3 | ||||
| -rw-r--r-- | ext/Devel/DProf/DProf.xs | 2 | ||||
| -rw-r--r-- | ext/Devel/Peek/Peek.xs | 2 | ||||
| -rw-r--r-- | ext/Encode/Encode.xs | 1 | ||||
| -rw-r--r-- | ext/List/Util/Util.xs | 4 | ||||
| -rw-r--r-- | gv.c | 11 | ||||
| -rw-r--r-- | hints/irix_6.sh | 14 | ||||
| -rw-r--r-- | lib/autouse.pm | 2 | ||||
| -rw-r--r-- | lib/utf8_heavy.pl | 4 | ||||
| -rw-r--r-- | mg.c | 15 | ||||
| -rw-r--r-- | op.c | 4 | ||||
| -rw-r--r-- | perl.c | 9 | ||||
| -rw-r--r-- | perl.h | 2 | ||||
| -rw-r--r-- | perlio.c | 13 | ||||
| -rw-r--r-- | pod/perlfaq4.pod | 12 | ||||
| -rw-r--r-- | pp.c | 22 | ||||
| -rw-r--r-- | pp_ctl.c | 28 | ||||
| -rw-r--r-- | pp_hot.c | 8 | ||||
| -rw-r--r-- | pp_sys.c | 4 | ||||
| -rw-r--r-- | regcomp.c | 28 | ||||
| -rw-r--r-- | regexec.c | 55 | ||||
| -rw-r--r-- | sv.c | 17 | ||||
| -rw-r--r-- | t/lib/md5-file.t | 2 | ||||
| -rwxr-xr-x | t/op/cmp.t | 12 | ||||
| -rw-r--r-- | t/pragma/autouse.t | 4 | ||||
| -rw-r--r-- | t/run/runenv.t | 39 | ||||
| -rw-r--r-- | toke.c | 19 | ||||
| -rw-r--r-- | universal.c | 8 | ||||
| -rw-r--r-- | utf8.c | 4 | ||||
| -rw-r--r-- | utf8.h | 8 | ||||
| -rw-r--r-- | utfebcdic.h | 4 | ||||
| -rw-r--r-- | util.c | 20 | ||||
| -rw-r--r-- | x2p/a2py.c | 6 | ||||
| -rw-r--r-- | x2p/str.c | 2 | ||||
| -rw-r--r-- | x2p/walk.c | 6 | ||||
| -rw-r--r-- | xsutils.c | 3 |
42 files changed, 231 insertions, 199 deletions
@@ -8,6 +8,7 @@ -- A. C. Yardley <yardley@tanet.net> Aaron B. Dossett <aaron@iglou.com> +Abhijit Menon-Sen <ams@wiw.org> Abigail <abigail@foad.org> Achim Bohnet <ach@mpe.mpg.de> Adam Krolnik <adamk@gypsy.cyrix.com> @@ -179,11 +180,13 @@ Gabe Schaffer Garry T. Williams <garry@zvolve.com> Gary Clark <GaryC@mail.jeld-wen.com> Gary Ng <71564.1743@compuserve.com> +Geraint A Edwards <gedge@serf.org> Gerben Wierda <G.C.Th.Wierda@AWT.nl> Gerrit P. Haase <gerrit.haase@t-online.de> Gerd Knops <gerti@BITart.com> Giles Lean <giles@nemeton.com.au> Gisle Aas <gisle@aas.no> +Golubev I. N. <gin@mo.msk.ru> Gordon J. Miller <gjm@cray.com> Grace Lee <grace@hal.com> Graham Barr <gbarr@pobox.com> @@ -314,6 +317,7 @@ Joseph S. Myers <jsm28@hermes.cam.ac.uk> Joshua E. Rodd <jrodd@pbs.org> Joshua Pritikin <joshua.pritikin@db.com> Juan Gallego <Little.Boss@physics.mcgill.ca> +Juha Laiho <juha.laiho@Elma.Net> Julian Yip <julian@imoney.com> Justin Banks <justinb@cray.com> Ka-Ping Yee <kpyee@aw.sgi.com> @@ -340,6 +344,7 @@ Krishna Sethuraman <krishna@sgi.com> Kurt D. Starsinic <kstar@wolfetech.com> Kyriakos Georgiou Larry Parmelee <parmelee@CS.Cornell.EDU> +Larry Shatzer <lshatzer@islanddata.com> Larry Schuler Larry Schwimmer <rosebud@cyclone.Stanford.EDU> Larry W. Virden <lvirden@cas.org> @@ -399,6 +404,7 @@ Matthew T Harden <mthard@mthard1.monsanto.com> Matthias Ulrich Neeracher <neeri@iis.ee.ethz.ch> Matthias Urlichs <smurf@noris.net> Maurizio Loreti <maurizio.loreti@pd.infn.it> +Merijn Broeren <merijnb@iloquent.nl> Michael Cook <mcook@cognex.com> Michael De La Rue <mikedlr@tardis.ed.ac.uk> Michael Engel <engel@nms1.cc.huji.ac.il> @@ -471,6 +477,7 @@ Randal L. Schwartz <merlyn@stonehenge.com> Randy J. Ray <rjray@redhat.com> Raphael Manfredi <Raphael.Manfredi@pobox.com> Raymund Will <ray@caldera.de> +Reini Urban <rurban@sbox.tu-graz.ac.at> Rex Dieter <rdieter@math.unl.edu> Rich Morin <rdm@cfcl.com> Rich Salz <rsalz@bbn.com> @@ -130,7 +130,9 @@ Perl_av_extend(pTHX_ AV *av, I32 key) Safefree(AvALLOC(av)); AvALLOC(av) = ary; #endif +#if defined(MYMALLOC) && !defined(LEAKTEST) resized: +#endif ary = AvALLOC(av) + AvMAX(av) + 1; tmp = newmax - AvMAX(av); if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */ @@ -1011,7 +1011,7 @@ Perl_do_eof(pTHX_ GV *gv) Off_t Perl_do_tell(pTHX_ GV *gv) { - register IO *io; + register IO *io = 0; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { @@ -1030,7 +1030,7 @@ Perl_do_tell(pTHX_ GV *gv) bool Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) { - register IO *io; + register IO *io = 0; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { @@ -1049,7 +1049,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) Off_t Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) { - register IO *io; + register IO *io = 0; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) @@ -1332,7 +1332,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); #else register char **a; - char *tmps; + char *tmps = Nullch; STRLEN n_a; if (sp > mark) { @@ -141,7 +141,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ I32 grows = PL_op->op_private & OPpTRANS_GROWS; I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT; I32 del = PL_op->op_private & OPpTRANS_DELETE; - STRLEN len, rlen; + STRLEN len, rlen = 0; short *tbl; I32 ch; @@ -308,7 +308,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ SV** svp = hv_fetch(hv, "NONE", 4, FALSE); UV none = svp ? SvUV(*svp) : 0x7fffffff; UV extra = none + 1; - UV final; + UV final = 0; UV uv; I32 isutf8; U8 hibit = 0; @@ -397,7 +397,7 @@ STATIC I32 S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ { U8 *s; - U8 *start, *send; + U8 *start = 0, *send; I32 matches = 0; STRLEN len; @@ -448,7 +448,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ SV** svp = hv_fetch(hv, "NONE", 4, FALSE); UV none = svp ? SvUV(*svp) : 0x7fffffff; UV extra = none + 1; - UV final; + UV final = 0; bool havefinal = FALSE; UV uv; STRLEN len; @@ -648,7 +648,8 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s STRLEN delimlen; STRLEN tmplen; - (void) SvPV(del, delimlen); /* get the delimlen */ + (void) SvPV(del, delimlen); /* stringify and get the delimlen */ + /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */ mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); @@ -1083,7 +1084,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) char *rsave; bool left_utf = DO_UTF8(left); bool right_utf = DO_UTF8(right); - I32 needlen; + I32 needlen = 0; if (left_utf && !right_utf) sv_utf8_upgrade(right); diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h index c6acd28436..9ad3237a3e 100644 --- a/ext/ByteLoader/bytecode.h +++ b/ext/ByteLoader/bytecode.h @@ -74,7 +74,6 @@ typedef IV IV64; #define BGET_op_tr_array(arg) do { \ unsigned short *ary; \ - int i; \ New(666, ary, 256, unsigned short); \ BGET_FREAD(ary, sizeof(unsigned short), 256); \ arg = (char *) ary; \ diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs index 745a67ffe9..872591d3ad 100644 --- a/ext/Cwd/Cwd.xs +++ b/ext/Cwd/Cwd.xs @@ -130,7 +130,7 @@ _cwdxs_abs_path(char *start) char dotdots[MAXPATHLEN] = { 0 }; char name[MAXPATHLEN] = { 0 }; char *cwd; - int namelen; + int namelen = 0; struct stat cst, pst, tst; if (PerlLIO_stat(start, &cst) < 0) { diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 74cbd1b7cc..f84f55069c 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -1768,7 +1768,6 @@ unshift(db, ...) DBT value ; int i ; int One ; - DB * Db = db->dbp ; STRLEN n_a; DBT_clear(key) ; @@ -1791,7 +1790,7 @@ unshift(db, ...) #ifdef DB_VERSION_MAJOR RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ; #else - RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ; + RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ; #endif if (RETVAL != 0) break; diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs index aba6de99d3..0cd7daaac7 100644 --- a/ext/Devel/DProf/DProf.xs +++ b/ext/Devel/DProf/DProf.xs @@ -384,7 +384,7 @@ test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s) int i, j, k = 0; HV *oldstash = PL_curstash; struct tms t1, t2; - clock_t realtime1, realtime2; + clock_t realtime1 = 0, realtime2 = 0; U32 ototal = g_total; U32 ostack = g_SAVE_STACK; U32 operldb = PL_perldb; diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs index 1e481492b5..b3131b6c85 100644 --- a/ext/Devel/Peek/Peek.xs +++ b/ext/Devel/Peek/Peek.xs @@ -10,7 +10,7 @@ DeadCode(pTHX) return Nullsv; #else SV* sva; - SV* sv, *dbg; + SV* sv; SV* ret = newRV_noinc((SV*)newAV()); register SV* svend; int tm = 0, tref = 0, ts = 0, ta = 0, tas = 0; diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index 6e3684ef0d..ef21d5bd91 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -534,6 +534,7 @@ _utf8_to_bytes(sv, ...) STRLEN len; U8 *s = (U8*)SvPV(sv, len); + RETVAL = 0; if (SvTRUE(check)) { /* Must do things the slow way */ U8 *dest; diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs index 1e6d8f6fe9..c5b5ebf27e 100644 --- a/ext/List/Util/Util.xs +++ b/ext/List/Util/Util.xs @@ -89,7 +89,6 @@ PROTOTYPE: @ CODE: { int index; - NV ret; if(!items) { XSRETURN_UNDEF; } @@ -193,7 +192,6 @@ first(block,...) PROTOTYPE: &@ CODE: { - SV *ret; int index; I32 markix; GV *gv; @@ -237,7 +235,7 @@ CODE: STRLEN len; char *ptr = SvPV(str,len); ST(0) = sv_newmortal(); - SvUPGRADE(ST(0),SVt_PVNV); + (void)SvUPGRADE(ST(0),SVt_PVNV); sv_setpvn(ST(0),ptr,len); if(SvNOKp(num) || !SvIOKp(num)) { SvNVX(ST(0)) = SvNV(num); @@ -1230,7 +1230,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table); AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; - STRLEN n_a; if (mg && amtp->was_ok_am == PL_amagic_generation && amtp->was_ok_sub == PL_sub_generation) @@ -1284,7 +1283,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) GV *ngv; DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", - SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) ); + SvPV_nolen(GvSV(gv)), cp, HvNAME(stash)) ); if (!SvPOK(GvSV(gv)) || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), FALSE))) @@ -1356,10 +1355,10 @@ SV* Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) { MAGIC *mg; - CV *cv; + CV *cv=NULL; CV **cvp=NULL, **ocvp=NULL; - AMT *amtp, *oamtp; - int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0; + AMT *amtp=NULL, *oamtp=NULL; + int fl=0, off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0; int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; HV* stash; if (!(AMGf_noleft & flags) && SvAMAGIC(left) @@ -1647,7 +1646,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) CATCH_SET(oldcatch); if (postpr) { - int ans; + int ans=0; switch (method) { case le_amg: case sle_amg: diff --git a/hints/irix_6.sh b/hints/irix_6.sh index 6f4ca17881..bac68c312e 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -282,6 +282,20 @@ set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' shift libswanted="$*" +# +# XXX -- This isn't right, since you still don't want perl itself +# linked with -ldb, even if you *do* build the DB_File extension. +# Linking perl with -ldb will prevent you from building the +# Sybase::DBlib extension, due to a conflict between dbopen() in both +# libdb.so and libsybdb.so. +# +case "$i_db" in +undef) + set `echo X "$libswanted "|sed -e 's/ db / /'` + shift + libswanted="$*" ;; +esac + cat > UU/usethreads.cbu <<'EOCBU' # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. diff --git a/lib/autouse.pm b/lib/autouse.pm index d320195dd5..8057d18f65 100644 --- a/lib/autouse.pm +++ b/lib/autouse.pm @@ -119,7 +119,7 @@ will work and is the equivalent to: use Module qw(func3); -Its not a very useful feature and has been deprecated. +It is not a very useful feature and has been deprecated. =end _deprecated diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index 2327d3d818..a843737164 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -36,7 +36,9 @@ sub SWASHNEW { } { - $list ||= ($caller ne 'main' && eval { $caller->$type(); }) + $list ||= + ( exists &{"${caller}::${type}"} && + eval { $caller->$type() } ) || do "$file.pl" || do "$encoding/$file.pl" || do "$encoding/Is/${type}.pl" @@ -20,6 +20,9 @@ # ifndef NGROUPS # define NGROUPS 32 # endif +# ifdef I_GRP +# include <grp.h> +# endif #endif static void restore_magic(pTHXo_ void *p); @@ -372,9 +375,11 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) if (i > 0 && DO_UTF8(PL_reg_sv)) { char *b = rx->subbeg; - i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i)); + if (b) + i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i)); } - sv_setiv(sv,i); + + sv_setiv(sv, i); } } return 0; @@ -627,7 +632,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) getrx: if (i >= 0) { - bool was_tainted; + bool was_tainted = FALSE; if (PL_tainting) { was_tainted = PL_tainted; PL_tainted = FALSE; @@ -1038,7 +1043,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) { register char *s; I32 i; - SV** svp; + SV** svp = 0; STRLEN len; s = MgPV(mg,len); @@ -2195,7 +2200,7 @@ Perl_sighandler(int sig) dSP; GV *gv = Nullgv; HV *st; - SV *sv, *tSv = PL_Sv; + SV *sv = Nullsv, *tSv = PL_Sv; CV *cv = Nullcv; OP *myop = PL_op; U32 flags = 0; @@ -2660,7 +2660,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) U32 max = 0; I32 bits; I32 havefinal = 0; - U32 final; + U32 final = 0; I32 from_utf = o->op_private & OPpTRANS_FROM_UTF; I32 to_utf = o->op_private & OPpTRANS_TO_UTF; U8* tsave = NULL; @@ -6295,7 +6295,7 @@ Perl_ck_sort(pTHX_ OP *o) simplify_sort(o); firstkid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (o->op_flags & OPf_STACKED) { /* may have been cleared */ - OP *k; + OP *k = NULL; OP *kid = cUNOPx(firstkid)->op_first; /* get past null */ if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) { @@ -965,7 +965,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) AV* comppadlist; register SV *sv; register char *s; - char *cddir = Nullch; + char *popts, *cddir = Nullch; sv_setpvn(PL_linestr,"",0); sv = newSVpvn("",0); /* first used for -I flags */ @@ -1190,8 +1190,9 @@ print \" \\@INC:\\n @INC\\n\";"); #ifndef SECURE_INTERNAL_GETENV !PL_tainting && #endif - (s = PerlEnv_getenv("PERL5OPT"))) + (popts = PerlEnv_getenv("PERL5OPT"))) { + s = savepv(popts); while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') @@ -1680,7 +1681,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) LOGOP myop; /* fake syntax tree node */ UNOP method_op; I32 oldmark; - I32 retval; + I32 retval = 0; I32 oldscope; bool oldcatch = CATCH_GET; int ret; @@ -1868,7 +1869,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) dSP; UNOP myop; /* fake syntax tree node */ I32 oldmark = SP - PL_stack_base; - I32 retval; + I32 retval = 0; I32 oldscope; int ret; OP* oldop = PL_op; @@ -2891,7 +2891,7 @@ enum { /* pass one of these to get_vtbl */ #define HINT_INTEGER 0x00000001 #define HINT_STRICT_REFS 0x00000002 /* #define HINT_notused4 0x00000004 */ -#define HINT_BYTE 0x00000008 +#define HINT_BYTES 0x00000008 /* #define HINT_notused10 0x00000010 */ /* Note: 20,40,80 used for NATIVE_HINTS */ @@ -408,7 +408,6 @@ perlio_mg_set(pTHX_ SV *sv, MAGIC *mg) IO *io = GvIOn((GV *)SvRV(sv)); PerlIO *ifp = IoIFP(io); PerlIO *ofp = IoOFP(io); - AV *av = (AV *) mg->mg_obj; Perl_warn(aTHX_ "set %"SVf" %p %p %p",sv,io,ifp,ofp); } return 0; @@ -422,7 +421,6 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg) IO *io = GvIOn((GV *)SvRV(sv)); PerlIO *ifp = IoIFP(io); PerlIO *ofp = IoOFP(io); - AV *av = (AV *) mg->mg_obj; Perl_warn(aTHX_ "get %"SVf" %p %p %p",sv,io,ifp,ofp); } return 0; @@ -739,7 +737,6 @@ PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg) /* Pop back to bottom layer */ if (f && *f) { - int code = 0; PerlIO_flush(f); while (!(PerlIOBase(f)->tab->kind & PERLIO_K_RAW)) { @@ -814,7 +811,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) { PerlIO *top = f; PerlIOl *l; - while (l = *top) + while ((l = *top)) { if (PerlIOBase(top)->tab == &PerlIO_crlf) { @@ -1016,7 +1013,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int { AV *layera; IV n; - PerlIO_funcs *tab; + PerlIO_funcs *tab = NULL; if (f && *f) { /* This is "reopen" - it is not tested as perl does not use it yet */ @@ -1563,8 +1560,10 @@ IV PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg) { PerlIOl *l = PerlIOBase(f); +#if 0 const char *omode = mode; char temp[8]; +#endif PerlIO_funcs *tab = PerlIOBase(f)->tab; l->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE| PERLIO_F_TRUNCATE|PERLIO_F_APPEND); @@ -1933,7 +1932,6 @@ Off_t PerlIOUnix_tell(PerlIO *f) { dTHX; - Off_t posn = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR); return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR); } @@ -2491,7 +2489,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int f = (*tab->Open)(aTHX_ tab, layers, n-2, mode,fd,imode,perm,NULL,narg,args); if (f) { - PerlIOBuf *b = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,PerlIOArg),PerlIOBuf); + PerlIO_push(aTHX_ f,self,mode,PerlIOArg); fd = PerlIO_fileno(f); #if O_BINARY != O_TEXT /* do something about failing setmode()? --jhi */ @@ -3312,7 +3310,6 @@ PerlIOMmap_map(PerlIO *f) { dTHX; PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); - PerlIOBuf *b = &m->base; IV flags = PerlIOBase(f)->flags; IV code = 0; if (m->len) diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index 4acd3d93a1..0d23e24893 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -42,17 +42,7 @@ are consequently slower. If precision is important, such as when dealing with money, it's good to work with integers and then divide at the last possible moment. For example, work in pennies (1995) instead of dollars and cents -(19.95) and divide by 100 at the end. In fact, if you are dividing by -100, you don't even need to really divide-- just split of the -fractional parts and insert the '.' (or whichever is your decimal -separator) in between, e.g. - - sub d100 { - $_[0] =~ /(.*?)(.(?:.)?)$/; - sprintf("%d.%02d", $1||0, $2); - } - -and then display all your numbers like this: C<d100($number)> +(19.95) and divide by 100 at the end. To get rid of the superfluous digits, just use a format (eg, C<printf("%.2f", 19.95)>) to get the required precision. @@ -1093,13 +1093,13 @@ PP(pp_modulo) { dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { - UV left; - UV right; + UV left = 0; + UV right = 0; bool left_neg; bool right_neg; bool use_double = 0; - NV dright; - NV dleft; + NV dright = 0.0; + NV dleft = 0.0; if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); @@ -1265,8 +1265,8 @@ PP(pp_subtract) /* Unless the left argument is integer in range we are going to have to use NV maths. Hence only attempt to coerce the right argument if we know the left is integer. */ - register UV auv; - bool auvok; + register UV auv = 0; + bool auvok = FALSE; bool a_valid = 0; if (!useleft) { @@ -2716,7 +2716,7 @@ PP(pp_substr) { dSP; dTARGET; SV *sv; - I32 len; + I32 len = 0; STRLEN curlen; STRLEN utf8_curlen; I32 pos; @@ -3001,7 +3001,7 @@ PP(pp_chr) (void)SvUPGRADE(TARG,SVt_PV); - if (value > 255 && !IN_BYTE) { + if (value > 255 && !IN_BYTES) { SvGROW(TARG, UNISKIP(value)+1); tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value); SvCUR_set(TARG, tmps - SvPVX(TARG)); @@ -4117,7 +4117,7 @@ PP(pp_unpack) register char *patend = pat + llen; I32 datumtype; register I32 len; - register I32 bits; + register I32 bits = 0; register char *str; /* These must not be in registers: */ @@ -4137,8 +4137,8 @@ PP(pp_unpack) float afloat; double adouble; I32 checksum = 0; - register U32 culong; - NV cdouble; + register U32 culong = 0; + NV cdouble = 0.0; int commas = 0; int star; #ifdef PERL_NATINT_PACK @@ -312,18 +312,18 @@ PP(pp_formline) register char *s; register char *send; register I32 arg; - register SV *sv; - char *item; - I32 itemsize; - I32 fieldsize; + register SV *sv = Nullsv; + char *item = Nullch; + I32 itemsize = 0; + I32 fieldsize = 0; I32 lines = 0; bool chopspace = (strchr(PL_chopset, ' ') != Nullch); - char *chophere; - char *linemark; + char *chophere = Nullch; + char *linemark = Nullch; NV value; - bool gotsome; + bool gotsome = FALSE; STRLEN len; - STRLEN fudge = SvCUR(tmpForm) * (IN_BYTE ? 1 : 3) + 1; + STRLEN fudge = SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1; bool item_is_utf = FALSE; if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { @@ -887,7 +887,7 @@ PP(pp_sort) register I32 max; HV *stash; GV *gv; - CV *cv; + CV *cv = 0; I32 gimme = GIMME; OP* nextop = PL_op->op_next; I32 overloading = 0; @@ -3016,7 +3016,7 @@ PP(pp_require) SV *sv; char *name; STRLEN len; - char *tryname; + char *tryname = Nullch; SV *namesv = Nullsv; SV** svp; I32 gimme = GIMME_V; @@ -3589,14 +3589,14 @@ S_doparseform(pTHX_ SV *sv) STRLEN len; register char *s = SvPV_force(sv, len); register char *send = s + len; - register char *base; + register char *base = Nullch; register I32 skipspaces = 0; - bool noblank; - bool repeat; + bool noblank = FALSE; + bool repeat = FALSE; bool postspace = FALSE; U16 *fops; register U16 *fpc; - U16 *linepc; + U16 *linepc = 0; register I32 arg; bool ischop; @@ -395,8 +395,8 @@ PP(pp_add) /* Unless the left argument is integer in range we are going to have to use NV maths. Hence only attempt to coerce the right argument if we know the left is integer. */ - register UV auv; - bool auvok; + register UV auv = 0; + bool auvok = FALSE; bool a_valid = 0; if (!useleft) { @@ -1628,7 +1628,7 @@ PP(pp_helem) U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; - I32 preeminent; + I32 preeminent = 0; if (SvTYPE(hv) == SVt_PVHV) { if (PL_op->op_private & OPpLVAL_INTRO) @@ -2991,7 +2991,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) HV* stash; char* name; STRLEN namelen; - char* packname; + char* packname = 0; STRLEN packlen; name = SvPV(meth, namelen); @@ -1535,7 +1535,7 @@ PP(pp_sysread) io = GvIO(gv); if (!io || !IoIFP(io)) goto say_undef; - if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTE) { + if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) { buffer = SvPVutf8_force(bufsv, blen); /* UTF8 may not have been set if they are all low bytes */ SvUTF8_on(bufsv); @@ -1663,7 +1663,7 @@ PP(pp_sysread) SvCUR_set(bufsv, count+(buffer - SvPVX(bufsv))); *SvEND(bufsv) = '\0'; (void)SvPOK_only(bufsv); - if (fp_utf8 && !IN_BYTE) { + if (fp_utf8 && !IN_BYTES) { /* Look at utf8 we got back and count the characters */ char *bend = buffer + count; while (buffer < bend) { @@ -949,7 +949,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg flags &= ~SCF_DO_STCLASS; } else if (strchr((char*)PL_varies,OP(scan))) { - I32 mincount, maxcount, minnext, deltanext, fl; + I32 mincount, maxcount, minnext, deltanext, fl = 0; I32 f = flags, pos_before = 0; regnode *oscan = scan; struct regnode_charclass_class this_class; @@ -1260,7 +1260,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg } } else if (strchr((char*)PL_simple,OP(scan))) { - int value; + int value = 0; if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state,data); @@ -1914,7 +1914,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) if ((!r->anchored_substr || r->anchored_offset) && stclass_flag && !(data.start_class->flags & ANYOF_EOS) && !cl_is_anything(data.start_class)) { - SV *sv; I32 n = add_data(pRExC_state, 1, "f"); New(1006, RExC_rx->data->data[n], 1, @@ -1925,10 +1924,11 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->regstclass = (regnode*)RExC_rx->data->data[n]; r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */ PL_regdata = r->data; /* for regprop() */ - DEBUG_r((sv = sv_newmortal(), - regprop(sv, (regnode*)data.start_class), - PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n", - SvPVX(sv)))); + DEBUG_r({ SV *sv = sv_newmortal(); + regprop(sv, (regnode*)data.start_class); + PerlIO_printf(Perl_debug_log, + "synthetic stclass `%s'.\n", + SvPVX(sv));}); } /* A temporary algorithm prefers floated substr to fixed one to dig more info. */ @@ -1966,7 +1966,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->check_substr = r->anchored_substr = r->float_substr = Nullsv; if (!(data.start_class->flags & ANYOF_EOS) && !cl_is_anything(data.start_class)) { - SV *sv; I32 n = add_data(pRExC_state, 1, "f"); New(1006, RExC_rx->data->data[n], 1, @@ -1976,10 +1975,11 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) struct regnode_charclass_class); r->regstclass = (regnode*)RExC_rx->data->data[n]; r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */ - DEBUG_r((sv = sv_newmortal(), - regprop(sv, (regnode*)data.start_class), - PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n", - SvPVX(sv)))); + DEBUG_r({ SV* sv = sv_newmortal(); + regprop(sv, (regnode*)data.start_class); + PerlIO_printf(Perl_debug_log, + "synthetic stclass `%s'.\n", + SvPVX(sv));}); } } @@ -3265,9 +3265,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) register regnode *ret; STRLEN numlen; IV namedclass; - char *rangebegin; + char *rangebegin = 0; bool need_class = 0; - SV *listsv; + SV *listsv = Nullsv; register char *e; UV n; bool optimize_invert = TRUE; @@ -360,17 +360,16 @@ char * Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *strend, U32 flags, re_scream_pos_data *data) { - register I32 start_shift; + register I32 start_shift = 0; /* Should be nonnegative! */ - register I32 end_shift; + register I32 end_shift = 0; register char *s; register SV *check; char *strbeg; char *t; I32 ml_anch; - char *tmp; register char *other_last = Nullch; /* other substr checked before this */ - char *check_at; /* check substr found at this pos */ + char *check_at = Nullch; /* check substr found at this pos */ #ifdef DEBUGGING char *i_strpos = strpos; #endif @@ -778,7 +777,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1); if (!s) { #ifdef DEBUGGING - char *what; + char *what = 0; #endif if (endpos == strend) { DEBUG_r( PerlIO_printf(Perl_debug_log, @@ -839,13 +838,17 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, DEBUG_r( what = "floating" ); goto hop_and_restart; } - DEBUG_r( if (t != s) - PerlIO_printf(Perl_debug_log, + if (t != s) { + DEBUG_r(PerlIO_printf(Perl_debug_log, "By STCLASS: moving %ld --> %ld\n", - (long)(t - i_strpos), (long)(s - i_strpos)); - else - PerlIO_printf(Perl_debug_log, - "Does not contradict STCLASS...\n") ); + (long)(t - i_strpos), (long)(s - i_strpos)) + ); + } + else { + DEBUG_r(PerlIO_printf(Perl_debug_log, + "Does not contradict STCLASS...\n"); + ); + } } giveup: DEBUG_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n", @@ -963,7 +966,8 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta else { U8 *r = reghop3((U8*)s, -1, (U8*)startpos); - tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0); + if (s > (char*)r) + tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0); } tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0); @@ -1006,7 +1010,8 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta else { U8 *r = reghop3((U8*)s, -1, (U8*)startpos); - tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0); + if (s > (char*)r) + tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0); } tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0); @@ -1596,9 +1601,10 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * s++; } } - DEBUG_r(did_match || + DEBUG_r(if (!did_match) PerlIO_printf(Perl_debug_log, - "Did not find anchored character...\n")); + "Did not find anchored character...\n") + ); } /*SUPPRESS 560*/ else if (do_utf8 == (UTF!=0) && @@ -1662,14 +1668,16 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } } } - DEBUG_r(did_match || - PerlIO_printf(Perl_debug_log, "Did not find %s substr `%s%.*s%s'%s...\n", + DEBUG_r(if (!did_match) + PerlIO_printf(Perl_debug_log, + "Did not find %s substr `%s%.*s%s'%s...\n", ((must == prog->anchored_substr) ? "anchored" : "floating"), PL_colors[0], (int)(SvCUR(must) - (SvTAIL(must)!=0)), SvPVX(must), - PL_colors[1], (SvTAIL(must) ? "$" : ""))); + PL_colors[1], (SvTAIL(must) ? "$" : "")) + ); goto phooey; } else if ((c = prog->regstclass)) { @@ -1960,13 +1968,15 @@ S_regmatch(pTHX_ regnode *prog) register I32 nextchr; /* renamed nextchr - nextchar colides with function of same name */ register I32 n; /* no or next */ - register I32 ln; /* len or last */ - register char *s; /* operand or save */ + register I32 ln = 0; /* len or last */ + register char *s = Nullch; /* operand or save */ register char *locinput = PL_reginput; - register I32 c1, c2, paren; /* case fold search, parenth */ + register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */ int minmod = 0, sw = 0, logical = 0; I32 unwind = 0; +#if 0 I32 firstcp = PL_savestack_ix; +#endif register bool do_utf8 = DO_UTF8(PL_reg_sv); #ifdef DEBUGGING @@ -2935,7 +2945,6 @@ S_regmatch(pTHX_ regnode *prog) inner = NEXTOPER(scan); do_branch: { - CHECKPOINT lastcp; c1 = OP(scan); if (OP(next) != c1) /* No choice. */ next = inner; /* Avoid recursion. */ @@ -3774,7 +3783,7 @@ S_regrepeat(pTHX_ regnode *p, I32 max) STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) { - register char *scan; + register char *scan = Nullch; register char *start; register char *loceol = PL_regeol; I32 l = 0; @@ -3067,7 +3067,7 @@ Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok) if (fail_ok) return FALSE; #ifdef USE_BYTES_DOWNGRADES - else if (IN_BYTE) { + else if (IN_BYTES) { U8 *d = s; U8 *e = (U8 *) SvEND(sv); int first = 1; @@ -3677,7 +3677,8 @@ Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN else { /* len is STRLEN which is unsigned, need to copy to signed */ IV iv = len; - assert(iv >= 0); + if (iv < 0) + Perl_croak(aTHX_ "panic: sv_setpvn called with negative strlen"); } (void)SvUPGRADE(sv, SVt_PV); @@ -4892,7 +4893,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) pv2 = SvPV(sv2, cur2); /* do not utf8ize the comparands as a side-effect */ - if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) { + if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) { bool is_utf8 = TRUE; /* UTF-8ness differs */ if (PL_hints & HINT_UTF8_DISTINCT) @@ -4959,7 +4960,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2) pv2 = SvPV(sv2, cur2); /* do not utf8ize the comparands as a side-effect */ - if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) { + if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) { if (PL_hints & HINT_UTF8_DISTINCT) return SvUTF8(sv1) ? 1 : -1; @@ -5124,7 +5125,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) register STDCHAR rslast; register STDCHAR *bp; register I32 cnt; - I32 i; + I32 i = 0; SV_CHECK_THINKFIRST(sv); (void)SvUPGRADE(sv, SVt_PV); @@ -6990,7 +6991,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV STRLEN origlen; I32 svix = 0; static char nullstr[] = "(null)"; - SV *argsv; + SV *argsv = Nullsv; /* no matter what, this is a string now */ (void)SvPV_force(sv, origlen); @@ -7058,7 +7059,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV STRLEN veclen = 0; char c; int i; - unsigned base; + unsigned base = 0; IV iv; UV uv; NV nv; @@ -7264,7 +7265,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV uv = args ? va_arg(*args, int) : SvIVx(argsv); if ((uv > 255 || (!UNI_IS_INVARIANT(uv) && SvUTF8(sv))) - && !IN_BYTE) { + && !IN_BYTES) { eptr = (char*)utf8buf; elen = uvchr_to_utf8((U8*)eptr, uv) - utf8buf; is_utf = TRUE; diff --git a/t/lib/md5-file.t b/t/lib/md5-file.t index 7d57da06dc..c786a5f4e5 100644 --- a/t/lib/md5-file.t +++ b/t/lib/md5-file.t @@ -16,7 +16,7 @@ my $EXPECT; if (ord('A') == 193) { # EBCDIC $EXPECT = <<EOT; 95a81f17a8e6c2273aecac12d8c4cb90 ext/Digest/MD5/MD5.pm -e9e70adad1215b8fa43b52508f425ae9 ext/Digest/MD5/MD5.xs +9cecc5dbb27bd64b98f61f558b4db378 ext/Digest/MD5/MD5.xs EOT } else { # ASCII $EXPECT = <<EOT; diff --git a/t/op/cmp.t b/t/op/cmp.t index 243aabec7d..c6d72f13eb 100755 --- a/t/op/cmp.t +++ b/t/op/cmp.t @@ -37,7 +37,7 @@ $uv_bigi |= 0x0; $expect = 6 * ($#FOO+2) * ($#FOO+1); print "1..$expect\n"; -sub nok { +sub nok ($$$$$$$$) { my ($test, $left, $threeway, $right, $result, $i, $j, $boolean) = @_; $result = defined $result ? "'$result'" : 'undef'; print "not ok $test # ($left <=> $right) gives: $result \$i=$i \$j=$j, $boolean disagrees\n"; @@ -79,7 +79,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - nok ($ok, $i3. '<=>', $j3, $cmp, $i, $j, '=='); + nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '=='); } $ok++; if (!defined($cmp) ? !($i5 > $j5) @@ -90,7 +90,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - nok ($ok, $i3. '<=>', $j3, $cmp, $i, $j, '>'); + nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '>'); } $ok++; if (!defined($cmp) ? !($i6 >= $j6) @@ -101,7 +101,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - nok ($ok, $i3. '<=>', $j3, $cmp, $i, $j, '>='); + nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '>='); } $ok++; # OK, so the docs are wrong it seems. NaN != NaN @@ -113,7 +113,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - nok ($ok, $i3. '<=>', $j3, $cmp, $i, $j, '!='); + nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '!='); } $ok++; if (!defined($cmp) ? !($i8 <= $j8) @@ -124,7 +124,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - nok ($ok, $i3. '<=>', $j3, $cmp, $i, $j, '<='); + nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<='); } $ok++; $cmp = $i9 cmp $j9; diff --git a/t/pragma/autouse.t b/t/pragma/autouse.t index ecc1289167..0a2d68003f 100644 --- a/t/pragma/autouse.t +++ b/t/pragma/autouse.t @@ -48,11 +48,9 @@ use autouse 'Carp' => qw(carp croak); # Test that autouse's lazy module loading works. We assume that nothing # involved in this test uses Text::Soundex, which is pretty safe. -use File::Spec; use autouse 'Text::Soundex' => qw(soundex); -my $mod_file = File::Spec->catfile(qw(Text Soundex.pm)); -$mod_file = VMS::Filespec::unixify($mod_file) if $^O eq 'VMS'; +my $mod_file = 'Text/Soundex.pm'; # just fine and portable for %INC ok( !exists $INC{$mod_file} ); ok( soundex('Basset'), 'B230' ); ok( exists $INC{$mod_file} ); diff --git a/t/run/runenv.t b/t/run/runenv.t index a59ad26f35..55c48f03b3 100644 --- a/t/run/runenv.t +++ b/t/run/runenv.t @@ -14,13 +14,15 @@ BEGIN { } } +use Test; + +plan tests => 10; + my $STDOUT = './results-0'; my $STDERR = './results-1'; my $PERL = './perl'; my $FAILURE_CODE = 119; -print "1..9\n"; - # Run perl with specified environment and arguments returns a list. # First element is true iff Perl's stdout and stderr match the # supplied $stdout and $stderr argument strings exactly. @@ -70,14 +72,9 @@ sub it_didnt_work { } sub try { - my $testno = shift; my ($success, $reason) = runperl(@_); - if ($success) { - print "ok $testno\n"; - } else { - $reason =~ s/\n/\\n/g; - print "not ok $testno # $reason\n"; - } + $reason =~ s/\n/\\n/g if defined $reason; + ok( !!$success, 1, $reason ); } # PERL5OPT Command-line options (switches). Switches in @@ -90,25 +87,24 @@ sub try { # -T, tainting will be enabled, and any # subsequent options ignored. -my $T = 1; -try($T++, {PERL5OPT => '-w'}, ['-e', 'print $::x'], +try({PERL5OPT => '-w'}, ['-e', 'print $::x'], "", qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n}); -try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'], +try({PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'], "", ""); -try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $x'], +try({PERL5OPT => '-Mstrict'}, ['-e', 'print $x'], "", qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); # Fails in 5.6.0 -try($T++, {PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'], +try({PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'], "", qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n}); # Fails in 5.6.0 -try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], +try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], "", <<ERROR Name "main::x" used only once: possible typo at -e line 1. @@ -117,7 +113,7 @@ ERROR ); # Fails in 5.6.0 -try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], +try({PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'], "", <<ERROR Name "main::x" used only once: possible typo at -e line 1. @@ -125,21 +121,24 @@ Use of uninitialized value in print at -e line 1. ERROR ); -try($T++, {PERL5OPT => '-MExporter'}, ['-e0'], +try({PERL5OPT => '-MExporter'}, ['-e0'], "", ""); # Fails in 5.6.0 -try($T++, {PERL5OPT => '-MExporter -MExporter'}, ['-e0'], +try({PERL5OPT => '-MExporter -MExporter'}, ['-e0'], "", ""); -try($T++, {PERL5OPT => '-Mstrict -Mwarnings'}, +try({PERL5OPT => '-Mstrict -Mwarnings'}, ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'], "ok", ""); -print "# ", $T-1, " tests total.\n"; +try({PERL5OPT => '-w -w'}, + ['-e', 'print $ENV{PERL5OPT}'], + '-w -w', + ''); END { 1 while unlink $STDOUT; @@ -184,9 +184,8 @@ int yyactlevel = -1; STATIC void S_tokereport(pTHX_ char *thing, char* s, I32 rv) { - SV *report; DEBUG_T({ - report = newSVpv(thing, 0); + SV* report = newSVpv(thing, 0); Perl_sv_catpvf(aTHX_ report, ":line %d:%"IVdf":", CopLINE(PL_curcop), (IV)rv); @@ -538,7 +537,7 @@ S_skipspace(pTHX_ register char *s) for (;;) { STRLEN prevlen; SSize_t oldprevlen, oldoldprevlen; - SSize_t oldloplen, oldunilen; + SSize_t oldloplen = 0, oldunilen = 0; while (s < PL_bufend && isSPACE(*s)) { if (*s++ == '\n' && PL_in_eval && !PL_rsfp) incline(s); @@ -3868,7 +3867,7 @@ Perl_yylex(pTHX) CLINE; yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0)); yylval.opval->op_private = OPpCONST_BARE; - if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len)) + if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len)) SvUTF8_on(((SVOP*)yylval.opval)->op_sv); TERM(WORD); } @@ -4029,7 +4028,7 @@ Perl_yylex(pTHX) if (*s == '=' && s[1] == '>') { CLINE; sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf); - if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len)) + if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len)) SvUTF8_on(((SVOP*)yylval.opval)->op_sv); TERM(WORD); } @@ -4205,7 +4204,7 @@ Perl_yylex(pTHX) } #endif #ifdef PERLIO_LAYERS - if (UTF && !IN_BYTE) + if (UTF && !IN_BYTES) PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8"); #endif PL_rsfp = Nullfp; @@ -4994,7 +4993,7 @@ Perl_yylex(pTHX) really_sub: { char tmpbuf[sizeof PL_tokenbuf]; - SSize_t tboffset; + SSize_t tboffset = 0; expectation attrful; bool have_name, have_proto; int key = tmp; @@ -6533,7 +6532,7 @@ retval: Renew(SvPVX(tmpstr), SvLEN(tmpstr), char); } SvREFCNT_dec(herewas); - if (UTF && !IN_BYTE && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr))) + if (UTF && !IN_BYTES && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr))) SvUTF8_on(tmpstr); PL_lex_stuff = tmpstr; yylval.ival = op_type; @@ -7231,8 +7230,8 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) */ if (!floatit) { - IV iv; - UV uv; + IV iv = 0; + UV uv = 0; errno = 0; if (*PL_tokenbuf == '-') iv = Strtol(PL_tokenbuf, (char**)NULL, 10); diff --git a/universal.c b/universal.c index 3e14a68bd7..ca69243ca6 100644 --- a/universal.c +++ b/universal.c @@ -405,6 +405,10 @@ XS(XS_utf8_native_to_unicode) { dXSARGS; UV uv = SvUV(ST(0)); + + if (items > 1) + Perl_croak(aTHX_ "Usage: utf8::native_to_unicode(sv)"); + ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv))); XSRETURN(1); } @@ -413,6 +417,10 @@ XS(XS_utf8_unicode_to_native) { dXSARGS; UV uv = SvUV(ST(0)); + + if (items > 1) + Perl_croak(aTHX_ "Usage: utf8::unicode_to_native(sv)"); + ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv))); XSRETURN(1); } @@ -243,7 +243,7 @@ Most code should use utf8_to_uvchr() rather than call this directly. UV Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) { - UV uv = *s, ouv; + UV uv = *s, ouv = 0; STRLEN len = 1; bool dowarn = ckWARN_d(WARN_UTF8); STRLEN expectlen = 0; @@ -507,7 +507,7 @@ Perl_utf8_length(pTHX_ U8 *s, U8 *e) U8 t = UTF8SKIP(s); if (e - s < t) - Perl_croak(aTHX_ "panic: utf8_length: s=%p (%02X) e=%p l=%d - unaligned end",s,*s,e,t); + Perl_croak(aTHX_ "panic: utf8_length: unaligned end"); s += t; len++; } @@ -111,10 +111,10 @@ END_EXTERN_C * (that is, the two high bits are set). Otherwise we risk loading in the * heavy-duty SWASHINIT and SWASHGET routines unnecessarily. */ -#define isIDFIRST_lazy_if(p,c) ((IN_BYTE || (!c || (*((U8*)p) < 0xc0))) \ +#define isIDFIRST_lazy_if(p,c) ((IN_BYTES || (!c || (*((U8*)p) < 0xc0))) \ ? isIDFIRST(*(p)) \ : isIDFIRST_utf8((U8*)p)) -#define isALNUM_lazy_if(p,c) ((IN_BYTE || (!c || (*((U8*)p) < 0xc0))) \ +#define isALNUM_lazy_if(p,c) ((IN_BYTES || (!c || (*((U8*)p) < 0xc0))) \ ? isALNUM(*(p)) \ : isALNUM_utf8((U8*)p)) @@ -129,8 +129,8 @@ END_EXTERN_C #define UTF8_MAXLEN 13 /* how wide can a single UTF8 encoded character become */ /* #define IN_UTF8 (PL_curcop->op_private & HINT_UTF8) */ -#define IN_BYTE (PL_curcop->op_private & HINT_BYTE) -#define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTE) +#define IN_BYTES (PL_curcop->op_private & HINT_BYTES) +#define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES) #define UTF8_ALLOW_EMPTY 0x0001 #define UTF8_ALLOW_CONTINUATION 0x0002 diff --git a/utfebcdic.h b/utfebcdic.h index 0dd73d2bb0..2c56006ff6 100644 --- a/utfebcdic.h +++ b/utfebcdic.h @@ -234,10 +234,10 @@ END_EXTERN_C * unnecessarily. */ -#define isIDFIRST_lazy_if(p,c) ((IN_BYTE || (!c || UTF8_IS_INVARIANT(*p))) \ +#define isIDFIRST_lazy_if(p,c) ((IN_BYTES || (!c || UTF8_IS_INVARIANT(*p))) \ ? isIDFIRST(*(p)) \ : isIDFIRST_utf8((U8*)p)) -#define isALNUM_lazy_if(p,c) ((IN_BYTE || (!c || UTF8_IS_INVARIANT(*p))) \ +#define isALNUM_lazy_if(p,c) ((IN_BYTES || (!c || UTF8_IS_INVARIANT(*p))) \ ? isALNUM(*(p)) \ : isALNUM_utf8((U8*)p)) @@ -2345,8 +2345,6 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args) } if (pid == 0) { /* Child */ - GV* tmpgv; - int fd; #undef THIS #undef THAT #define THIS that @@ -2368,10 +2366,10 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args) } #if !defined(HAS_FCNTL) || !defined(F_SETFD) /* No automatic close - do it by hand */ -#ifndef NOFILE -#define NOFILE 20 -#endif - for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) { +# ifndef NOFILE +# define NOFILE 20 +# endif + for (int fd = PL_maxsysfd + 1; fd < NOFILE; fd++) { if (fd != pp[1]) PerlLIO_close(fd); } @@ -2750,7 +2748,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) Pid_t pid; Pid_t pid2; bool close_failed; - int saved_errno; + int saved_errno = 0; #ifdef VMS int saved_vaxc_errno; #endif @@ -2806,13 +2804,14 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) I32 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) { + if (!pid) + return -1; +#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) + { SV *sv; SV** svp; char spid[TYPE_CHARS(int)]; - if (!pid) - return -1; -#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) if (pid > 0) { sprintf(spid, "%"IVdf, (IV)pid); svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE); @@ -2834,6 +2833,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD); return pid; } + } } #endif #ifdef HAS_WAITPID diff --git a/x2p/a2py.c b/x2p/a2py.c index 3976c860c5..5642b3673b 100644 --- a/x2p/a2py.c +++ b/x2p/a2py.c @@ -61,7 +61,6 @@ main(register int argc, register char **argv, register char **env) for (argc--,argv++; argc; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) break; - reswitch: switch (argv[0][1]) { #ifdef DEBUGGING case 'D': @@ -212,11 +211,12 @@ yylex(void) retry: #if YYDEBUG - if (yydebug) + if (yydebug) { if (strchr(s,'\n')) fprintf(stderr,"Tokener at %s",s); else fprintf(stderr,"Tokener at %s\n",s); + } #endif switch (*s) { default: @@ -1226,7 +1226,7 @@ fixfargs(int name, int arg, int prevargs) { int type; STR *str; - int numargs; + int numargs = 0; if (!arg) return prevargs; @@ -221,7 +221,7 @@ str_replace(register STR *str, register STR *nstr) str->str_len = nstr->str_len; str->str_cur = nstr->str_cur; str->str_pok = nstr->str_pok; - if (str->str_nok = nstr->str_nok) + if ((str->str_nok = nstr->str_nok)) str->str_nval = nstr->str_nval; safefree((char*)nstr); } diff --git a/x2p/walk.c b/x2p/walk.c index 59ac8a9f3d..10546db197 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -52,7 +52,7 @@ walk(int useval, int level, register int node, int *numericptr, int minprec) STR *tmp2str; STR *tmp3str; char *t; - char *d, *s; + char *d, *s = 0; int numarg; int numeric = FALSE; STR *fstr; @@ -750,7 +750,7 @@ sub Pick {\n\ subretnum |= numarg; s = Nullch; t = tmp2str->str_ptr; - while (t = instr(t,"return ")) + while ((t = instr(t,"return "))) s = t++; if (s) { i = 0; @@ -1463,7 +1463,7 @@ sub Pick {\n\ if (!s) fatal("Illegal for loop: %s",d); *s++ = '\0'; - for (t = s; i = *t; t++) { + for (t = s; (i = *t); t++) { i &= 127; if (i == '}' || i == ']') break; @@ -127,6 +127,9 @@ XS(XS_attributes_bootstrap) dXSARGS; char *file = __FILE__; + if( items > 0 ) + Perl_croak(aTHX_ "Usage: bootstrap"); + newXSproto("attributes::_warn_reserved", XS_attributes__warn_reserved, file, ""); newXS("attributes::_modify_attrs", XS_attributes__modify_attrs, file); newXSproto("attributes::_guess_stash", XS_attributes__guess_stash, file, "$"); |