From: Gurusamy Sarathy Date: Sun, 29 Nov 1998 16:08:03 +0000 (+0000) Subject: another threads reliability fix: serialize writes to thr->threadsv X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d8e6c8d50eaf50f663a5fd184404c73944226e0;p=p5sagit%2Fp5-mst-13.2.git another threads reliability fix: serialize writes to thr->threadsv avoid most uses of PL_na (which is much more inefficient than a simple local); update docs to suit; PL_na now being thr->Tna may be a minor compatibility issue for extensions--will require dTHR outside of XSUBs (those get automatic dTHR) p4raw-id: //depot/perl@2387 --- diff --git a/XSUB.h b/XSUB.h index 4165868..dbe0c39 100644 --- a/XSUB.h +++ b/XSUB.h @@ -57,8 +57,8 @@ #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ - SV *tmpsv; \ - char *vn = Nullch, *module = SvPV(ST(0),PL_na); \ + SV *tmpsv; STRLEN n_a; \ + char *vn = Nullch, *module = SvPV(ST(0),n_a); \ if (items >= 2) /* version supplied as bootstrap arg */ \ tmpsv = ST(1); \ else { \ @@ -69,7 +69,7 @@ tmpsv = perl_get_sv(form("%s::%s", module, \ vn = "VERSION"), FALSE); \ } \ - if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na)))) \ + if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \ croak("%s object version %s does not match %s%s%s%s %_", \ module, XS_VERSION, \ vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 4d0d9fd..07eb80e 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -134,6 +134,7 @@ do_aspawn (SV *really,SV **mark,SV **sp) dTHR; int rc; char **a,*tmps,**argv; + STRLEN n_a; if (sp<=mark) return -1; @@ -141,7 +142,7 @@ do_aspawn (SV *really,SV **mark,SV **sp) while (++mark <= sp) if (*mark) - *a++ = SvPVx(*mark, PL_na); + *a++ = SvPVx(*mark, n_a); else *a++ = ""; *a = Nullch; @@ -152,7 +153,7 @@ do_aspawn (SV *really,SV **mark,SV **sp) ) /* will swawnvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ - if (really && *(tmps = SvPV(really, PL_na))) + if (really && *(tmps = SvPV(really, n_a))) rc=spawnvp (P_WAIT,tmps,argv); else rc=spawnvp (P_WAIT,argv[0],argv); diff --git a/doio.c b/doio.c index 0cdf87d..f624dca 100644 --- a/doio.c +++ b/doio.c @@ -552,7 +552,7 @@ nextargv(register GV *gv) } else PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n", - SvPV(sv, PL_na), Strerror(errno)); + SvPV(sv, oldlen), Strerror(errno)); } if (PL_inplace) { (void)do_close(PL_argvoutgv,FALSE); @@ -941,6 +941,7 @@ my_stat(ARGSproto) else { SV* sv = POPs; char *s; + STRLEN n_a; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; @@ -951,7 +952,7 @@ my_stat(ARGSproto) goto do_fstat; } - s = SvPV(sv, PL_na); + s = SvPV(sv, n_a); PL_statgv = Nullgv; sv_setpv(PL_statname, s); PL_laststype = OP_STAT; @@ -967,6 +968,7 @@ my_lstat(ARGSproto) { djSP; SV *sv; + STRLEN n_a; if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); if (cGVOP->op_gv == PL_defgv) { @@ -981,13 +983,13 @@ my_lstat(ARGSproto) PL_statgv = Nullgv; sv = POPs; PUTBACK; - sv_setpv(PL_statname,SvPV(sv, PL_na)); + sv_setpv(PL_statname,SvPV(sv, n_a)); #ifdef HAS_LSTAT - PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache); + PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache); #else - PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache); + PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache); #endif - if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n')) + if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) warner(WARN_NEWLINE, PL_warn_nl, "lstat"); return PL_laststatval; } @@ -997,6 +999,7 @@ do_aexec(SV *really, register SV **mark, register SV **sp) { register char **a; char *tmps; + STRLEN n_a; if (sp > mark) { dTHR; @@ -1004,14 +1007,14 @@ do_aexec(SV *really, register SV **mark, register SV **sp) a = PL_Argv; while (++mark <= sp) { if (*mark) - *a++ = SvPVx(*mark, PL_na); + *a++ = SvPVx(*mark, n_a); else *a++ = ""; } *a = Nullch; if (*PL_Argv[0] != '/') /* will execvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ - if (really && *(tmps = SvPV(really, PL_na))) + if (really && *(tmps = SvPV(really, n_a))) PerlProc_execvp(tmps,PL_Argv); else PerlProc_execvp(PL_Argv[0],PL_Argv); @@ -1142,6 +1145,7 @@ apply(I32 type, register SV **mark, register SV **sp) char *what; char *s; SV **oldmark = mark; + STRLEN n_a; #define APPLY_TAINT_PROPER() \ STMT_START { \ @@ -1167,7 +1171,7 @@ apply(I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, PL_na); + char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_chmod(name, val)) tot--; @@ -1184,7 +1188,7 @@ apply(I32 type, register SV **mark, register SV **sp) APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, PL_na); + char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_chown(name, val, val2)) tot--; @@ -1204,7 +1208,7 @@ nothing in the core. APPLY_TAINT_PROPER(); if (mark == sp) break; - s = SvPVx(*++mark, PL_na); + s = SvPVx(*++mark, n_a); if (isUPPER(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; @@ -1274,7 +1278,7 @@ nothing in the core. APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - s = SvPVx(*mark, PL_na); + s = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PL_euid || PL_unsafe) { if (UNLINK(s)) @@ -1319,7 +1323,7 @@ nothing in the core. APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - char *name = SvPVx(*mark, PL_na); + char *name = SvPVx(*mark, n_a); APPLY_TAINT_PROPER(); if (PerlLIO_utime(name, &utbuf)) tot--; diff --git a/doop.c b/doop.c index 2a032d9..22495e6 100644 --- a/doop.c +++ b/doop.c @@ -921,7 +921,8 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right) len = leftlen < rightlen ? leftlen : rightlen; lensave = len; if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { - dc = SvPV_force(sv, PL_na); + STRLEN n_a; + dc = SvPV_force(sv, n_a); if (SvCUR(sv) < len) { dc = SvGROW(sv, len + 1); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); diff --git a/dump.c b/dump.c index 85cdddb..44a9142 100644 --- a/dump.c +++ b/dump.c @@ -146,7 +146,7 @@ char * sv_peek(SV *sv) { SV *t = sv_newmortal(); - STRLEN prevlen; + STRLEN n_a; int unref = 0; sv_setpvn(t, "", 0); @@ -289,7 +289,7 @@ sv_peek(SV *sv) while (unref--) sv_catpv(t, ")"); } - return SvPV(t, PL_na); + return SvPV(t, n_a); } void @@ -362,6 +362,7 @@ void do_op_dump(I32 level, PerlIO *file, OP *o) { dTHR; + STRLEN n_a; dump_indent(level, file, "{\n"); level++; if (o->op_seq) @@ -500,7 +501,7 @@ do_op_dump(I32 level, PerlIO *file, OP *o) ENTER; SAVEFREESV(tmpsv); gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); - dump_indent(level, file, "GV = %s\n", SvPV(tmpsv, PL_na)); + dump_indent(level, file, "GV = %s\n", SvPV(tmpsv, n_a)); LEAVE; } else @@ -736,6 +737,7 @@ do_sv_dump(I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, char *s; U32 flags; U32 type; + STRLEN n_a; if (!sv) { dump_indent(level, file, "SV = 0\n"); @@ -1020,7 +1022,7 @@ do_sv_dump(I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, break; case SVt_PVCV: if (SvPOK(sv)) - dump_indent(level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,PL_na)); + dump_indent(level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a)); /* FALL THROUGH */ case SVt_PVFM: do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); diff --git a/ext/B/B.xs b/ext/B/B.xs index 5943e12..678bbbd 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -267,7 +267,8 @@ static SV * cchar(SV *sv) { SV *sstr = newSVpv("'", 0); - char *s = SvPV(sv, PL_na); + STRLEN n_a; + char *s = SvPV(sv, n_a); if (*s == '\'') sv_catpv(sstr, "\\'"); diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 5856f4f..aa76cb9 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -593,6 +593,7 @@ SV * sv ; DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; void * openinfo = NULL ; INFO * info = &RETVAL->info ; + STRLEN n_a; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ Zero(RETVAL, 1, DB_File_type) ; @@ -734,11 +735,11 @@ SV * sv ; #endif svp = hv_fetch(action, "bfname", 6, FALSE); if (svp && SvOK(*svp)) { - char * ptr = SvPV(*svp,PL_na) ; + char * ptr = SvPV(*svp,n_a) ; #ifdef DB_VERSION_MAJOR - name = (char*) PL_na ? ptr : NULL ; + name = (char*) n_a ? ptr : NULL ; #else - info->db_RE_bfname = (char*) (PL_na ? ptr : NULL) ; + info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ; #endif } else @@ -754,7 +755,7 @@ SV * sv ; { int value ; if (SvPOK(*svp)) - value = (int)*SvPV(*svp, PL_na) ; + value = (int)*SvPV(*svp, n_a) ; else value = SvIV(*svp) ; @@ -772,7 +773,7 @@ SV * sv ; if (svp && SvOK(*svp)) { if (SvPOK(*svp)) - info->db_RE_bval = (u_char)*SvPV(*svp, PL_na) ; + info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ; else info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ; DB_flags(info->flags, DB_DELIMITER) ; @@ -1116,9 +1117,10 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H { char * name = (char *) NULL ; SV * sv = (SV *) NULL ; + STRLEN n_a; if (items >= 3 && SvOK(ST(2))) - name = (char*) SvPV(ST(2), PL_na) ; + name = (char*) SvPV(ST(2), n_a) ; if (items == 6) sv = ST(5) ; @@ -1248,6 +1250,7 @@ unshift(db, ...) int i ; int One ; DB * Db = db->dbp ; + STRLEN n_a; DBT_flags(key) ; DBT_flags(value) ; @@ -1261,8 +1264,8 @@ unshift(db, ...) #endif for (i = items-1 ; i > 0 ; --i) { - value.data = SvPV(ST(i), PL_na) ; - value.size = PL_na ; + value.data = SvPV(ST(i), n_a) ; + value.size = n_a ; One = 1 ; key.data = &One ; key.size = sizeof(int) ; @@ -1345,6 +1348,7 @@ push(db, ...) DBT value ; DB * Db = db->dbp ; int i ; + STRLEN n_a; DBT_flags(key) ; DBT_flags(value) ; @@ -1360,8 +1364,8 @@ push(db, ...) { ++ (* (int*)key.data) ; - value.data = SvPV(ST(i), PL_na) ; - value.size = PL_na ; + value.data = SvPV(ST(i), n_a) ; + value.size = n_a ; RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ; if (RETVAL != 0) break; @@ -1369,8 +1373,8 @@ push(db, ...) #else for (i = items - 1 ; i > 0 ; --i) { - value.data = SvPV(ST(i), PL_na) ; - value.size = PL_na ; + value.data = SvPV(ST(i), n_a) ; + value.size = n_a ; RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ; if (RETVAL != 0) break; diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 2b547f0..dfa8a3e 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -172,6 +172,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) I32 i, psize; char *result; char **p; + STRLEN n_a; /* Do not load what is already loaded into this process */ if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) @@ -182,7 +183,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) p = (char **) safemalloc(psize * sizeof(char*)); p[0] = path; for(i=1; img_ptr: (AMT *) NULL; AMT amt; + STRLEN n_a; if (mg && amtp->was_ok_am == PL_amagic_generation && amtp->was_ok_sub == PL_sub_generation) @@ -1066,7 +1067,7 @@ Gv_AMupdate(HV *stash) default: if (!SvROK(sv)) { if (!SvOK(sv)) break; - gv = gv_fetchmethod(stash, SvPV(sv, PL_na)); + gv = gv_fetchmethod(stash, SvPV(sv, n_a)); if (gv) cv = GvCV(gv); break; } @@ -1127,7 +1128,7 @@ Gv_AMupdate(HV *stash) GV *ngv; DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", - SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) ); + SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) ); if (!SvPOK(GvSV(gv)) || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), FALSE))) diff --git a/malloc.c b/malloc.c index add79bb..d99b059 100644 --- a/malloc.c +++ b/malloc.c @@ -726,6 +726,7 @@ emergency_sbrk(MEM_SIZE size) SV *sv; char *pv; int have = 0; + STRLEN n_a; if (emergency_buffer_size) { add_to_chain(emergency_buffer, emergency_buffer_size, 0); @@ -741,7 +742,7 @@ emergency_sbrk(MEM_SIZE size) return (char *)-1; /* Now die die die... */ } /* Got it, now detach SvPV: */ - pv = SvPV(sv, PL_na); + pv = SvPV(sv, n_a); /* Check alignment: */ if (((UV)(pv - sizeof(union overhead))) & ((1<op_private = i; else @@ -1344,10 +1351,11 @@ magic_setglob(SV *sv, MAGIC *mg) { register char *s; GV* gv; + STRLEN n_a; if (!SvOK(sv)) return 0; - s = SvPV(sv, PL_na); + s = SvPV(sv, n_a); if (*s == '*' && s[1]) s++; gv = gv_fetchpv(s,TRUE, SVt_PVGV); @@ -1547,6 +1555,7 @@ vivify_defelem(SV *sv) return; if (mg->mg_obj) { SV *ahv = LvTARG(sv); + STRLEN n_a; if (SvTYPE(ahv) == SVt_PVHV) { HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0); if (he) @@ -1558,7 +1567,7 @@ vivify_defelem(SV *sv) value = *svp; } if (!value || value == &PL_sv_undef) - croak(PL_no_helem, SvPV(mg->mg_obj, PL_na)); + croak(PL_no_helem, SvPV(mg->mg_obj, n_a)); } else { AV* av = (AV*)LvTARG(sv); @@ -1695,7 +1704,7 @@ magic_set(SV *sv, MAGIC *mg) if (PL_inplace) Safefree(PL_inplace); if (SvOK(sv)) - PL_inplace = savepv(SvPV(sv,PL_na)); + PL_inplace = savepv(SvPV(sv,len)); else PL_inplace = Nullch; break; @@ -1703,7 +1712,7 @@ magic_set(SV *sv, MAGIC *mg) if (PL_osname) Safefree(PL_osname); if (SvOK(sv)) - PL_osname = savepv(SvPV(sv,PL_na)); + PL_osname = savepv(SvPV(sv,len)); else PL_osname = Nullch; break; @@ -1733,12 +1742,12 @@ magic_set(SV *sv, MAGIC *mg) break; case '^': Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); - IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na)); + IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '~': Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); - IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na)); + IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '=': @@ -1795,7 +1804,7 @@ magic_set(SV *sv, MAGIC *mg) case '#': if (PL_ofmt) Safefree(PL_ofmt); - PL_ofmt = savepv(SvPV(sv,PL_na)); + PL_ofmt = savepv(SvPV(sv,len)); break; case '[': PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); @@ -1903,7 +1912,7 @@ magic_set(SV *sv, MAGIC *mg) case ')': #ifdef HAS_SETGROUPS { - char *p = SvPV(sv, PL_na); + char *p = SvPV(sv, len); Groups_t gary[NGROUPS]; SET_NUMERIC_STANDARD(); @@ -1951,7 +1960,7 @@ magic_set(SV *sv, MAGIC *mg) PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ':': - PL_chopset = SvPV_force(sv,PL_na); + PL_chopset = SvPV_force(sv,len); break; case '0': if (!PL_origalen) { diff --git a/op.c b/op.c index 85ed393..e82a45c 100644 --- a/op.c +++ b/op.c @@ -56,9 +56,10 @@ static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); STATIC char* gv_ename(GV *gv) { + STRLEN n_a; SV* tmpsv = sv_newmortal(); gv_efullname3(tmpsv, gv, Nullch); - return SvPV(tmpsv,PL_na); + return SvPV(tmpsv,n_a); } STATIC OP * @@ -549,11 +550,15 @@ find_threadsv(char *name) if (!p) return NOT_IN_PAD; key = p - PL_threadsv_names; + MUTEX_LOCK(&thr->mutex); svp = av_fetch(thr->threadsv, key, FALSE); - if (!svp) { + if (svp) + MUTEX_UNLOCK(&thr->mutex); + else { SV *sv = NEWSV(0, 0); av_store(thr->threadsv, key, sv); thr->threadsvp = AvARRAY(thr->threadsv); + MUTEX_UNLOCK(&thr->mutex); /* * Some magic variables used to be automagically initialised * in gv_fetchpv. Those which are now per-thread magicals get @@ -1130,6 +1135,7 @@ mod(OP *o, I32 type) dTHR; OP *kid; SV *sv; + STRLEN n_a; if (!o || PL_error_count) return o; @@ -1257,7 +1263,7 @@ mod(OP *o, I32 type) PL_modcount++; if (!type) croak("Can't localize lexical variable %s", - SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na)); + SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a)); break; #ifdef USE_THREADS @@ -3430,13 +3436,15 @@ newLOOPEX(I32 type, OP *label) { dTHR; OP *o; + STRLEN n_a; + if (type != OP_GOTO || label->op_type == OP_CONST) { /* "last()" means "last" */ if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) o = newOP(type, OPf_SPECIAL); else { o = newPVOP(type, 0, savepv(label->op_type == OP_CONST - ? SvPVx(((SVOP*)label)->op_sv, PL_na) + ? SvPVx(((SVOP*)label)->op_sv, n_a) : "")); } op_free(label); @@ -3770,10 +3778,11 @@ CV * newSUB(I32 floor, OP *o, OP *proto, OP *block) { dTHR; - char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch; + STRLEN n_a; + char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV); - char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch; + char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch; register CV *cv=0; I32 ix; @@ -3880,7 +3889,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) else { /* force display of errors found but not reported */ sv_catpv(ERRSV, not_safe); - croak("%s", SvPVx(ERRSV, PL_na)); + croak("%s", SvPVx(ERRSV, n_a)); } } } @@ -4123,9 +4132,10 @@ newFORM(I32 floor, OP *o, OP *block) char *name; GV *gv; I32 ix; + STRLEN n_a; if (o) - name = SvPVx(cSVOPo->op_sv, PL_na); + name = SvPVx(cSVOPo->op_sv, n_a); else name = "STDOUT"; gv = gv_fetchpv(name,TRUE, SVt_PVFM); @@ -4474,6 +4484,7 @@ ck_rvconst(register OP *o) int iscv; GV *gv; SV *kidsv = kid->op_sv; + STRLEN n_a; /* Is it a constant from cv_const_sv()? */ if (SvROK(kidsv) && SvREADONLY(kidsv)) { @@ -4512,7 +4523,7 @@ ck_rvconst(register OP *o) croak("Constant is not %s reference", badtype); return o; } - name = SvPV(kidsv, PL_na); + name = SvPV(kidsv, n_a); if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) { char *badthing = Nullch; switch (o->op_type) { @@ -4575,8 +4586,9 @@ ck_ftst(OP *o) SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { + STRLEN n_a; OP *newop = newGVOP(type, OPf_REF, - gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO)); + gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO)); op_free(o); return newop; } @@ -4611,6 +4623,7 @@ ck_fun(OP *o) } if (o->op_flags & OPf_KIDS) { + STRLEN n_a; tokid = &cLISTOPo->op_first; kid = cLISTOPo->op_first; if (kid->op_type == OP_PUSHMARK || @@ -4640,7 +4653,7 @@ ck_fun(OP *o) case OA_AVREF: if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na); + char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVAV) )); if (ckWARN(WARN_SYNTAX)) @@ -4659,7 +4672,7 @@ ck_fun(OP *o) case OA_HVREF: if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na); + char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVHV) )); if (ckWARN(WARN_SYNTAX)) @@ -4691,7 +4704,7 @@ ck_fun(OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { OP *newop = newGVOP(OP_GV, 0, - gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE, + gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE, SVt_PVIO) ); op_free(kid); kid = newop; @@ -5140,6 +5153,7 @@ ck_subr(OP *o) GV *namegv = 0; int optional = 0; I32 arg = 0; + STRLEN n_a; for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ; if (cvop->op_type == OP_RV2CV) { @@ -5151,7 +5165,7 @@ ck_subr(OP *o) cv = GvCVu(tmpop->op_sv); if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) { namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv); - proto = SvPV((SV*)cv, PL_na); + proto = SvPV((SV*)cv, n_a); } } } @@ -5243,7 +5257,7 @@ ck_subr(OP *o) default: oops: croak("Malformed prototype for %s: %s", - gv_ename(namegv), SvPV((SV*)cv, PL_na)); + gv_ename(namegv), SvPV((SV*)cv, n_a)); } } else @@ -5287,6 +5301,8 @@ peep(register OP *o) { dTHR; register OP* oldop = 0; + STRLEN n_a; + if (!o || o->op_seq) return; ENTER; @@ -5449,7 +5465,7 @@ peep(register OP *o) indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); if (!indsvp) { croak("No such field \"%s\" in variable %s of type %s", - key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname))); + key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); } ind = SvIV(*indsvp); if (ind < 1) diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs index 2d13f3e..60266f4 100644 --- a/os2/OS2/REXX/REXX.xs +++ b/os2/OS2/REXX/REXX.xs @@ -96,7 +96,8 @@ exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler) } if (rc || SvTRUE(GvSV(PL_errgv))) { if (SvTRUE(GvSV(PL_errgv))) { - die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), PL_na)) ; + STRLEN n_a; + die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ; } die ("REXX compartment returned non-zero status %li", rc); } diff --git a/os2/os2.c b/os2/os2.c index ce1f209..6b814de 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -162,7 +162,8 @@ int os2_cond_wait(perl_cond *c, perl_mutex *m) { int rc; - if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET)) + STRLEN n_a; + if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET)) croak("panic: COND_WAIT-reset: rc=%i", rc); if (m) MUTEX_UNLOCK(m); if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT)) @@ -475,6 +476,7 @@ char *inicmd; char **argsp = fargs; char nargs = 4; int force_shell; + STRLEN n_a; if (flag == P_WAIT) flag = P_NOWAIT; @@ -489,7 +491,7 @@ char *inicmd; ) /* will spawnvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ /* We should check PERL_SH* and PERLLIB_* as well? */ - if (!really || !*(tmps = SvPV(really, PL_na))) + if (!really || !*(tmps = SvPV(really, n_a))) tmps = PL_Argv[0]; reread: @@ -794,6 +796,7 @@ register SV **sp; char *tmps = NULL; int rc; int flag = P_WAIT, trueflag, err, secondtry = 0; + STRLEN n_a; if (sp > mark) { New(1301,PL_Argv, sp - mark + 3, char*); @@ -806,7 +809,7 @@ register SV **sp; while (++mark <= sp) { if (*mark) - *a++ = SvPVx(*mark, PL_na); + *a++ = SvPVx(*mark, n_a); else *a++ = ""; } @@ -1184,8 +1187,9 @@ XS(XS_File__Copy_syscopy) if (items < 2 || items > 3) croak("Usage: File::Copy::syscopy(src,dst,flag=0)"); { - char * src = (char *)SvPV(ST(0),PL_na); - char * dst = (char *)SvPV(ST(1),PL_na); + STRLEN n_a; + char * src = (char *)SvPV(ST(0),n_a); + char * dst = (char *)SvPV(ST(1),n_a); U32 flag; int RETVAL, rc; @@ -1214,6 +1218,7 @@ mod2fname(sv) AV *av; SV *svp; char *s; + STRLEN n_a; if (!SvROK(sv)) croak("Not a reference given to mod2fname"); sv = SvRV(sv); @@ -1224,7 +1229,7 @@ mod2fname(sv) if (avlen < 0) croak("Empty array reference given to mod2fname"); - s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na); + s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); strncpy(fname, s, 8); len = strlen(s); if (len < 6) pos = len; @@ -1234,7 +1239,7 @@ mod2fname(sv) } avlen --; while (avlen >= 0) { - s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na); + s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); while (*s) { sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */ } @@ -1473,9 +1478,10 @@ XS(XS_OS2_Errors2Drive) if (items != 1) croak("Usage: OS2::Errors2Drive(drive)"); { + STRLEN n_a; SV *sv = ST(0); int suppress = SvOK(sv); - char *s = suppress ? SvPV(sv, PL_na) : NULL; + char *s = suppress ? SvPV(sv, n_a) : NULL; char drive = (s ? *s : 0); unsigned long rc; @@ -1660,7 +1666,8 @@ XS(XS_Cwd_sys_chdir) if (items != 1) croak("Usage: Cwd::sys_chdir(path)"); { - char * path = (char *)SvPV(ST(0),PL_na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_chdir(path); @@ -1676,7 +1683,8 @@ XS(XS_Cwd_change_drive) if (items != 1) croak("Usage: Cwd::change_drive(d)"); { - char d = (char)*SvPV(ST(0),PL_na); + STRLEN n_a; + char d = (char)*SvPV(ST(0),n_a); bool RETVAL; RETVAL = change_drive(d); @@ -1692,7 +1700,8 @@ XS(XS_Cwd_sys_is_absolute) if (items != 1) croak("Usage: Cwd::sys_is_absolute(path)"); { - char * path = (char *)SvPV(ST(0),PL_na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_is_absolute(path); @@ -1708,7 +1717,8 @@ XS(XS_Cwd_sys_is_rooted) if (items != 1) croak("Usage: Cwd::sys_is_rooted(path)"); { - char * path = (char *)SvPV(ST(0),PL_na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_is_rooted(path); @@ -1724,7 +1734,8 @@ XS(XS_Cwd_sys_is_relative) if (items != 1) croak("Usage: Cwd::sys_is_relative(path)"); { - char * path = (char *)SvPV(ST(0),PL_na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); bool RETVAL; RETVAL = sys_is_relative(path); @@ -1755,7 +1766,8 @@ XS(XS_Cwd_sys_abspath) if (items < 1 || items > 2) croak("Usage: Cwd::sys_abspath(path, dir = NULL)"); { - char * path = (char *)SvPV(ST(0),PL_na); + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); char * dir; char p[MAXPATHLEN]; char * RETVAL; @@ -1763,7 +1775,7 @@ XS(XS_Cwd_sys_abspath) if (items < 2) dir = NULL; else { - dir = (char *)SvPV(ST(1),PL_na); + dir = (char *)SvPV(ST(1),n_a); } if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) { path += 2; @@ -1903,7 +1915,8 @@ XS(XS_Cwd_extLibpath_set) if (items < 1 || items > 2) croak("Usage: Cwd::extLibpath_set(s, type = 0)"); { - char * s = (char *)SvPV(ST(0),PL_na); + STRLEN n_a; + char * s = (char *)SvPV(ST(0),n_a); bool type; U32 rc; bool RETVAL; diff --git a/perl.c b/perl.c index 991f514..b2ffcc9 100644 --- a/perl.c +++ b/perl.c @@ -1448,8 +1448,10 @@ perl_eval_pv(char *p, I32 croak_on_error) sv = POPs; PUTBACK; - if (croak_on_error && SvTRUE(ERRSV)) - croak(SvPVx(ERRSV, PL_na)); + if (croak_on_error && SvTRUE(ERRSV)) { + STRLEN n_a; + croak(SvPVx(ERRSV, n_a)); + } return sv; } @@ -2138,6 +2140,7 @@ validate_suid(char *validarg, char *scriptname, int fdscript) croak("Can't stat script \"%s\"",PL_origfilename); if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) { I32 len; + STRLEN n_a; #ifdef IAMSUID #ifndef HAS_SETREUID @@ -2210,12 +2213,12 @@ validate_suid(char *validarg, char *scriptname, int fdscript) PL_doswitches = FALSE; /* -s is insecure in suid */ PL_curcop->cop_line++; if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch || - strnNE(SvPV(PL_linestr,PL_na),"#!",2) ) /* required even on Sys V */ + strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */ croak("No #! line"); - s = SvPV(PL_linestr,PL_na)+2; + s = SvPV(PL_linestr,n_a)+2; if (*s == ' ') s++; while (!isSPACE(*s)) s++; - for (s2 = s; (s2 > SvPV(PL_linestr,PL_na)+2 && + for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 && (isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ; if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */ croak("Not a perl script"); @@ -2754,7 +2757,7 @@ incpush(char *p, int addsubdirs) char *unix; STRLEN len; - if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) { + if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) { len = strlen(unix); while (unix[len-1] == '/') len--; /* Cosmetic */ sv_usepvn(libdir,unix,len); @@ -2762,7 +2765,7 @@ incpush(char *p, int addsubdirs) else PerlIO_printf(PerlIO_stderr(), "Failed to unixify @INC element \"%s\"\n", - SvPV(libdir,PL_na)); + SvPV(libdir,len)); #endif /* .../archname/version if -d .../archname/version/auto */ sv_setsv(subdir, libdir); diff --git a/perly.c b/perly.c index a13d388..50494a3 100644 --- a/perly.c +++ b/perly.c @@ -1771,7 +1771,7 @@ case 56: break; case 57: #line 302 "perly.y" -{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na); +{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) CvUNIQUE_on(PL_compcv); diff --git a/perly.y b/perly.y index 78378b6..88eee99 100644 --- a/perly.y +++ b/perly.y @@ -304,7 +304,7 @@ startformsub: /* NULL */ /* start a format subroutine scope */ { $$ = start_subparse(TRUE, 0); } ; -subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, PL_na); +subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) CvUNIQUE_on(PL_compcv); diff --git a/pod/perlcall.pod b/pod/perlcall.pod index c239cfe..e3e02de 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -971,7 +971,8 @@ and some C to call it /* Check the eval first */ if (SvTRUE(ERRSV)) { - printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ; + STRLEN n_a; + printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ; POPs ; } else @@ -1013,7 +1014,8 @@ The code if (SvTRUE(ERRSV)) { - printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ; + STRLEN n_a; + printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ; POPs ; } diff --git a/pod/perlembed.pod b/pod/perlembed.pod index c09d6e3..1314350 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -285,6 +285,7 @@ the first, a C from the second, and a C from the third. main (int argc, char **argv, char **env) { + STRLEN n_a; char *embedding[] = { "", "-e", "0" }; my_perl = perl_alloc(); @@ -303,7 +304,7 @@ the first, a C from the second, and a C from the third. /** Treat $a as a string **/ perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE); - printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), PL_na)); + printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a)); perl_destruct(my_perl); perl_free(my_perl); @@ -325,8 +326,9 @@ possible and in most cases a better strategy to fetch the return value from I instead. Example: ... + STRLEN n_a; SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE); - printf("%s\n", SvPV(val,PL_na)); + printf("%s\n", SvPV(val,n_a)); ... This way, we avoid namespace pollution by not creating global @@ -371,6 +373,7 @@ been wrapped here): { dSP; SV* retval; + STRLEN n_a; PUSHMARK(SP); perl_eval_sv(sv, G_SCALAR); @@ -380,7 +383,7 @@ been wrapped here): PUTBACK; if (croak_on_error && SvTRUE(ERRSV)) - croak(SvPVx(ERRSV, PL_na)); + croak(SvPVx(ERRSV, n_a)); return retval; } @@ -395,9 +398,10 @@ been wrapped here): I32 match(SV *string, char *pattern) { SV *command = NEWSV(1099, 0), *retval; + STRLEN n_a; sv_setpvf(command, "my $string = '%s'; $string =~ %s", - SvPV(string,PL_na), pattern); + SvPV(string,n_a), pattern); retval = my_perl_eval_sv(command, TRUE); SvREFCNT_dec(command); @@ -416,9 +420,10 @@ been wrapped here): I32 substitute(SV **string, char *pattern) { SV *command = NEWSV(1099, 0), *retval; + STRLEN n_a; sv_setpvf(command, "$string = '%s'; ($string =~ %s)", - SvPV(*string,PL_na), pattern); + SvPV(*string,n_a), pattern); retval = my_perl_eval_sv(command, TRUE); SvREFCNT_dec(command); @@ -439,9 +444,10 @@ been wrapped here): { SV *command = NEWSV(1099, 0); I32 num_matches; + STRLEN n_a; sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)", - SvPV(string,PL_na), pattern); + SvPV(string,n_a), pattern); my_perl_eval_sv(command, TRUE); SvREFCNT_dec(command); @@ -459,6 +465,7 @@ been wrapped here): AV *match_list; I32 num_matches, i; SV *text = NEWSV(1099,0); + STRLEN n_a; perl_construct(my_perl); perl_parse(my_perl, NULL, 3, embedding, NULL); @@ -480,7 +487,7 @@ been wrapped here): printf("matches: m/(wi..)/g found %d matches...\n", num_matches); for (i = 0; i < num_matches; i++) - printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),PL_na)); + printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),n_a)); printf("\n"); /** Remove all vowels from text **/ @@ -488,7 +495,7 @@ been wrapped here): if (num_matches) { printf("substitute: s/[aeiou]//gi...%d substitutions made.\n", num_matches); - printf("Now text is: %s\n\n", SvPV(text,PL_na)); + printf("Now text is: %s\n\n", SvPV(text,n_a)); } /** Attempt a substitution **/ @@ -726,6 +733,7 @@ with L whenever possible. char *args[] = { "", DO_CLEAN, NULL }; char filename [1024]; int exitstatus = 0; + STRLEN n_a; if((perl = perl_alloc()) == NULL) { fprintf(stderr, "no memory!"); @@ -747,7 +755,7 @@ with L whenever possible. /* check $@ */ if(SvTRUE(ERRSV)) - fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,PL_na)); + fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,n_a)); } } diff --git a/pod/perlguts.pod b/pod/perlguts.pod index b835b59..38d7569 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -95,7 +95,8 @@ or string. In the C macro, the length of the string returned is placed into the variable C (this is a macro, so you do I use C<&len>). If you do not -care what the length of the data is, use the global variable C. Remember, +care what the length of the data is, use the global variable C, though +this is rather less efficient than using a local variable. Remember, however, that Perl allows arbitrary strings of data that may both contain NULs and might not be terminated by a NUL. @@ -1636,7 +1637,7 @@ the SV which holds the name of the sub being debugged. This is the C variable which corresponds to Perl's $DB::sub variable. See C. The sub name can be found by - SvPV( GvSV( PL_DBsub ), PL_na ) + SvPV( GvSV( PL_DBsub ), len ) =item PL_DBtrace @@ -1856,7 +1857,8 @@ Returns the key slot of the hash entry as a C value, doing any necessary dereferencing of possibly C keys. The length of the string is placed in C (this is a macro, so do I use C<&len>). If you do not care about what the length of the key is, -you may use the global variable C. Remember though, that hash +you may use the global variable C, though this is rather less +efficient than using a local variable. Remember though, that hash keys in perl are free to contain embedded nulls, so using C or similar is not a good way to find the length of hash keys. This is very similar to the C macro described elsewhere in @@ -2179,8 +2181,9 @@ the type. Can do overlapping moves. See also C. =item PL_na -A variable which may be used with C to tell Perl to calculate the -string length. +A convenience variable which is typically used with C when one doesn't +care about the length of the string. It is usually more efficient to +declare a local variable and use that instead. =item New @@ -3008,8 +3011,7 @@ Checks the B setting. Use C. =item SvPV Returns a pointer to the string in the SV, or a stringified form of the SV -if the SV does not contain a string. If C is C then Perl will -handle the length on its own. Handles 'get' magic. +if the SV does not contain a string. Handles 'get' magic. char* SvPV (SV* sv, int len ) diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 2e02247..89ddf3e 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -553,9 +553,10 @@ The XS code, with ellipsis, follows. time_t timep = NO_INIT PREINIT: char *host = "localhost"; + STRLEN n_a; CODE: if( items > 1 ) - host = (char *)SvPV(ST(1), PL_na); + host = (char *)SvPV(ST(1), n_a); RETVAL = rpcb_gettime( host, &timep ); OUTPUT: timep @@ -786,9 +787,10 @@ prototypes. PROTOTYPE: $;$ PREINIT: char *host = "localhost"; + STRLEN n_a; CODE: if( items > 1 ) - host = (char *)SvPV(ST(1), PL_na); + host = (char *)SvPV(ST(1), n_a); RETVAL = rpcb_gettime( host, &timep ); OUTPUT: timep diff --git a/pp.c b/pp.c index 21a5dd3..004ba8c 100644 --- a/pp.c +++ b/pp.c @@ -226,6 +226,7 @@ PP(pp_rv2gv) else { if (SvTYPE(sv) != SVt_PVGV) { char *sym; + STRLEN n_a; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -240,7 +241,7 @@ PP(pp_rv2gv) warner(WARN_UNINITIALIZED, PL_warn_uninit); RETSETUNDEF; } - sym = SvPV(sv, PL_na); + sym = SvPV(sv, n_a); if (PL_op->op_private & HINT_STRICT_REFS) DIE(PL_no_symref, sym, "a symbol"); sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); @@ -271,6 +272,7 @@ PP(pp_rv2sv) else { GV *gv = (GV*)sv; char *sym; + STRLEN n_a; if (SvTYPE(gv) != SVt_PVGV) { if (SvGMAGICAL(sv)) { @@ -286,7 +288,7 @@ PP(pp_rv2sv) warner(WARN_UNINITIALIZED, PL_warn_uninit); RETSETUNDEF; } - sym = SvPV(sv, PL_na); + sym = SvPV(sv, n_a); if (PL_op->op_private & HINT_STRICT_REFS) DIE(PL_no_symref, sym, "a SCALAR"); gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV); @@ -544,9 +546,10 @@ PP(pp_gelem) SV *tmpRef; char *elem; djSP; - + STRLEN n_a; + sv = POPs; - elem = SvPV(sv, PL_na); + elem = SvPV(sv, n_a); gv = (GV*)POPs; tmpRef = Nullsv; sv = Nullsv; @@ -1797,8 +1800,9 @@ PP(pp_hex) djSP; dTARGET; char *tmps; I32 argtype; + STRLEN n_a; - tmps = POPp; + tmps = POPpx; XPUSHu(scan_hex(tmps, 99, &argtype)); RETURN; } @@ -1809,8 +1813,9 @@ PP(pp_oct) UV value; I32 argtype; char *tmps; + STRLEN n_a; - tmps = POPp; + tmps = POPpx; while (*tmps && isSPACE(*tmps)) tmps++; if (*tmps == '0') @@ -1922,7 +1927,8 @@ PP(pp_substr) if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { if (SvROK(sv)) { - SvPV_force(sv,PL_na); + STRLEN n_a; + SvPV_force(sv,n_a); if (ckWARN(WARN_SUBSTR)) warner(WARN_SUBSTR, "Attempt to use reference as lvalue in substr"); @@ -2131,7 +2137,8 @@ PP(pp_ord) { djSP; dTARGET; UV value; - U8 *tmps = (U8*)POPp; + STRLEN n_a; + U8 *tmps = (U8*)POPpx; I32 retlen; if (IN_UTF8 && (*tmps & 0x80)) @@ -2174,12 +2181,13 @@ PP(pp_chr) PP(pp_crypt) { djSP; dTARGET; dPOPTOPssrl; + STRLEN n_a; #ifdef HAS_CRYPT - char *tmps = SvPV(left, PL_na); + char *tmps = SvPV(left, n_a); #ifdef FCRYPT - sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na))); + sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a))); #else - sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na))); + sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a))); #endif #else DIE( @@ -2231,7 +2239,7 @@ PP(pp_ucfirst) sv = TARG; SETs(sv); } - s = (U8*)SvPV_force(sv, PL_na); + s = (U8*)SvPV_force(sv, slen); if (*s) { if (PL_op->op_private & OPpLOCALE) { TAINT; @@ -2287,7 +2295,7 @@ PP(pp_lcfirst) sv = TARG; SETs(sv); } - s = (U8*)SvPV_force(sv, PL_na); + s = (U8*)SvPV_force(sv, slen); if (*s) { if (PL_op->op_private & OPpLOCALE) { TAINT; @@ -2658,8 +2666,10 @@ PP(pp_hslice) svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0); } if (lval) { - if (!svp || *svp == &PL_sv_undef) - DIE(PL_no_helem, SvPV(keysv, PL_na)); + if (!svp || *svp == &PL_sv_undef) { + STRLEN n_a; + DIE(PL_no_helem, SvPV(keysv, n_a)); + } if (PL_op->op_private & OPpLVAL_INTRO) save_helem(hv, keysv, svp); } @@ -3699,6 +3709,7 @@ PP(pp_unpack) } else if (++bytes >= sizeof(UV)) { /* promote to string */ char *t; + STRLEN n_a; sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv); while (s < strend) { @@ -3708,7 +3719,7 @@ PP(pp_unpack) break; } } - t = SvPV(sv, PL_na); + t = SvPV(sv, n_a); while (*t == '0') t++; sv_chop(sv, t); @@ -3956,8 +3967,9 @@ doencodes(register SV *sv, register char *s, register I32 len) STATIC SV * is_an_int(char *s, STRLEN l) { + STRLEN n_a; SV *result = newSVpv("", l); - char *result_c = SvPV(result, PL_na); /* convenience */ + char *result_c = SvPV(result, n_a); /* convenience */ char *out = result_c; bool skip = 1; bool ignore = 0; @@ -4462,6 +4474,7 @@ PP(pp_pack) if (fromstr == &PL_sv_undef) aptr = NULL; else { + STRLEN n_a; /* XXX better yet, could spirit away the string to * a safe spot and hang on to it until the result * of pack() (and all copies of the result) are @@ -4471,9 +4484,9 @@ PP(pp_pack) warner(WARN_UNSAFE, "Attempt to pack pointer to temporary value"); if (SvPOK(fromstr) || SvNIOK(fromstr)) - aptr = SvPV(fromstr,PL_na); + aptr = SvPV(fromstr,n_a); else - aptr = SvPV_force(fromstr,PL_na); + aptr = SvPV_force(fromstr,n_a); } sv_catpvn(cat, (char*)&aptr, sizeof(char*)); } diff --git a/pp.h b/pp.h index 5fbffb8..6402002 100644 --- a/pp.h +++ b/pp.h @@ -58,14 +58,16 @@ #define RETURNX(x) return x, PUTBACK, NORMAL #define POPs (*sp--) -#define POPp (SvPVx(POPs, PL_na)) +#define POPp (SvPVx(POPs, PL_na)) /* deprecated */ +#define POPpx (SvPVx(POPs, n_a)) #define POPn (SvNVx(POPs)) #define POPi ((IV)SvIVx(POPs)) #define POPu ((UV)SvUVx(POPs)) #define POPl ((long)SvIVx(POPs)) #define TOPs (*sp) -#define TOPp (SvPV(TOPs, PL_na)) +#define TOPp (SvPV(TOPs, PL_na)) /* deprecated */ +#define TOPpx (SvPV(TOPs, n_a)) #define TOPn (SvNV(TOPs)) #define TOPi ((IV)SvIV(TOPs)) #define TOPu ((UV)SvUV(TOPs)) diff --git a/pp_ctl.c b/pp_ctl.c index fbfcab5..1cdf8be 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -872,10 +872,11 @@ PP(pp_sort) if (*up = *++MARK) { /* Weed out nulls. */ SvTEMP_off(*up); if (!PL_sortcop && !SvPOK(*up)) { + STRLEN n_a; if (SvAMAGIC(*up)) overloading = 1; else - (void)sv_2pv(*up, &PL_na); + (void)sv_2pv(*up, &n_a); } up++; } @@ -1006,11 +1007,11 @@ PP(pp_flop) } else { SV *final = sv_mortalcopy(right); - STRLEN len; + STRLEN len, n_a; char *tmps = SvPV(final, len); sv = sv_mortalcopy(left); - SvPV_force(sv,PL_na); + SvPV_force(sv,n_a); while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); if (strEQ(SvPVX(sv),tmps)) @@ -1233,6 +1234,7 @@ OP * die_where(char *message) { dSP; + STRLEN n_a; if (PL_in_eval) { I32 cxix; register PERL_CONTEXT *cx; @@ -1268,7 +1270,7 @@ die_where(char *message) sv_setpv(ERRSV, message); } else - message = SvPVx(ERRSV, PL_na); + message = SvPVx(ERRSV, n_a); while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) { dounwind(-1); @@ -1295,14 +1297,14 @@ die_where(char *message) LEAVE; if (optype == OP_REQUIRE) { - char* msg = SvPVx(ERRSV, PL_na); + char* msg = SvPVx(ERRSV, n_a); DIE("%s", *msg ? msg : "Compilation failed in require"); } return pop_return(); } } if (!message) - message = SvPVx(ERRSV, PL_na); + message = SvPVx(ERRSV, n_a); PerlIO_printf(PerlIO_stderr(), "%s",message); PerlIO_flush(PerlIO_stderr()); my_failure_exit(); @@ -1480,11 +1482,12 @@ PP(pp_reset) { djSP; char *tmps; + STRLEN n_a; if (MAXARG < 1) tmps = ""; else - tmps = POPp; + tmps = POPpx; sv_reset(tmps, PL_curcop->cop_stash); PUSHs(&PL_sv_yes); RETURN; @@ -1940,6 +1943,7 @@ PP(pp_goto) label = 0; if (PL_op->op_flags & OPf_STACKED) { SV *sv = POPs; + STRLEN n_a; /* This egregious kludge implements goto &subroutine */ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { @@ -2189,7 +2193,7 @@ PP(pp_goto) } } else - label = SvPV(sv,PL_na); + label = SvPV(sv,n_a); } else if (PL_op->op_flags & OPf_SPECIAL) { if (! do_dump) @@ -2338,7 +2342,8 @@ PP(pp_cswitch) if (PL_multiline) PL_op = PL_op->op_next; /* can't assume anything */ else { - match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255; + STRLEN n_a; + match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255; match -= cCOP->uop.scop.scop_offset; if (match < 0) match = 0; @@ -2577,6 +2582,7 @@ doeval(int gimme, OP** startop) I32 gimme; PERL_CONTEXT *cx; I32 optype = 0; /* Might be reset by POPEVAL. */ + STRLEN n_a; PL_op = saveop; if (PL_eval_root) { @@ -2592,10 +2598,10 @@ doeval(int gimme, OP** startop) lex_end(); LEAVE; if (optype == OP_REQUIRE) { - char* msg = SvPVx(ERRSV, PL_na); + char* msg = SvPVx(ERRSV, n_a); DIE("%s", *msg ? msg : "Compilation failed in require"); } else if (startop) { - char* msg = SvPVx(ERRSV, PL_na); + char* msg = SvPVx(ERRSV, n_a); POPBLOCK(cx,PL_curpm); POPEVAL(cx); @@ -2668,13 +2674,14 @@ PP(pp_require) SV** svp; I32 gimme = G_SCALAR; PerlIO *tryrsfp = 0; + STRLEN n_a; sv = POPs; if (SvNIOKp(sv) && !SvPOKp(sv)) { SET_NUMERIC_STANDARD(); if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv)) DIE("Perl %s required--this is only version %s, stopped", - SvPV(sv,PL_na),PL_patchlevel); + SvPV(sv,n_a),PL_patchlevel); RETPUSHYES; } name = SvPV(sv, len); @@ -2717,7 +2724,7 @@ PP(pp_require) { namesv = NEWSV(806, 0); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); + char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a); #ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, Nullch)) == Nullch) @@ -2753,7 +2760,7 @@ PP(pp_require) sv_catpv(msg, " (did you run h2ph?)"); sv_catpv(msg, " (@INC contains:"); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); + char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a); sv_setpvf(dirmsgsv, " %s", dir); sv_catsv(msg, dirmsgsv); } diff --git a/pp_hot.c b/pp_hot.c index 733b6b0..a3e893f 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -322,6 +322,7 @@ PP(pp_print) IO *io; register PerlIO *fp; MAGIC *mg; + STRLEN n_a; if (PL_op->op_flags & OPf_STACKED) gv = (GV*)*++MARK; @@ -353,7 +354,7 @@ PP(pp_print) if (ckWARN(WARN_UNOPENED)) { SV* sv = sv_newmortal(); gv_fullname3(sv, gv, Nullch); - warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na)); + warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a)); } SETERRNO(EBADF,RMS$_IFI); @@ -365,10 +366,10 @@ PP(pp_print) gv_fullname3(sv, gv, Nullch); if (IoIFP(io)) warner(WARN_IO, "Filehandle %s opened only for input", - SvPV(sv,PL_na)); + SvPV(sv,n_a)); else if (ckWARN(WARN_CLOSED)) warner(WARN_CLOSED, "print on closed filehandle %s", - SvPV(sv,PL_na)); + SvPV(sv,n_a)); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -447,6 +448,7 @@ PP(pp_rv2av) if (SvTYPE(sv) != SVt_PVGV) { char *sym; + STRLEN n_a; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -465,7 +467,7 @@ PP(pp_rv2av) } RETSETUNDEF; } - sym = SvPV(sv,PL_na); + sym = SvPV(sv,n_a); if (PL_op->op_private & HINT_STRICT_REFS) DIE(PL_no_symref, sym, "an ARRAY"); gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV); @@ -536,6 +538,7 @@ PP(pp_rv2hv) if (SvTYPE(sv) != SVt_PVGV) { char *sym; + STRLEN n_a; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -554,7 +557,7 @@ PP(pp_rv2hv) } RETSETUNDEF; } - sym = SvPV(sv,PL_na); + sym = SvPV(sv,n_a); if (PL_op->op_private & HINT_STRICT_REFS) DIE(PL_no_symref, sym, "a HASH"); gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV); @@ -1389,8 +1392,10 @@ PP(pp_helem) if (!svp || *svp == &PL_sv_undef) { SV* lv; SV* key2; - if (!defer) - DIE(PL_no_helem, SvPV(keysv, PL_na)); + if (!defer) { + STRLEN n_a; + DIE(PL_no_helem, SvPV(keysv, n_a)); + } lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; @@ -2018,6 +2023,7 @@ PP(pp_entersub) default: if (!SvROK(sv)) { char *sym; + STRLEN n_a; if (sv == &PL_sv_yes) { /* unfound import, ignore */ if (hasargs) @@ -2029,7 +2035,7 @@ PP(pp_entersub) sym = SvPOKp(sv) ? SvPVX(sv) : Nullch; } else - sym = SvPV(sv, PL_na); + sym = SvPV(sv, n_a); if (!sym) DIE(PL_no_usym, "a subroutine"); if (PL_op->op_private & HINT_STRICT_REFS) @@ -2524,7 +2530,7 @@ PP(pp_method) } } - name = SvPV(TOPs, PL_na); + name = SvPV(TOPs, packlen); sv = *(PL_stack_base + TOPMARK + 1); if (SvGMAGICAL(sv)) diff --git a/pp_sys.c b/pp_sys.c index b3de2f8..35d6f6f 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -298,7 +298,8 @@ PP(pp_backtick) { djSP; dTARGET; PerlIO *fp; - char *tmps = POPp; + STRLEN n_a; + char *tmps = POPpx; I32 gimme = GIMME_V; TAINT_PROPER("``"); @@ -384,7 +385,8 @@ PP(pp_glob) #if 0 /* XXX never used! */ PP(pp_indread) { - PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO); + STRLEN n_a; + PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO); return do_readline(); } #endif @@ -399,21 +401,22 @@ PP(pp_warn) { djSP; dMARK; char *tmps; + STRLEN n_a; if (SP - MARK != 1) { dTARGET; do_join(TARG, &PL_sv_no, MARK, SP); - tmps = SvPV(TARG, PL_na); + tmps = SvPV(TARG, n_a); SP = MARK + 1; } else { - tmps = SvPV(TOPs, PL_na); + tmps = SvPV(TOPs, n_a); } if (!tmps || !*tmps) { SV *error = ERRSV; (void)SvUPGRADE(error, SVt_PV); if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...caught"); - tmps = SvPV(error, PL_na); + tmps = SvPV(error, n_a); } if (!tmps || !*tmps) tmps = "Warning: something's wrong"; @@ -427,15 +430,16 @@ PP(pp_die) char *tmps; SV *tmpsv = Nullsv; char *pat = "%s"; + STRLEN n_a; if (SP - MARK != 1) { dTARGET; do_join(TARG, &PL_sv_no, MARK, SP); - tmps = SvPV(TARG, PL_na); + tmps = SvPV(TARG, n_a); SP = MARK + 1; } else { tmpsv = TOPs; - tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, PL_na); + tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a); } if (!tmps || !*tmps) { SV *error = ERRSV; @@ -465,7 +469,7 @@ PP(pp_die) else { if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...propagated"); - tmps = SvPV(error, PL_na); + tmps = SvPV(error, n_a); } } if (!tmps || !*tmps) @@ -660,6 +664,7 @@ PP(pp_tie) char *methname; int how = 'P'; U32 items; + STRLEN n_a; varsv = *++MARK; switch(SvTYPE(varsv)) { @@ -696,7 +701,7 @@ PP(pp_tie) stash = gv_stashsv(*MARK, FALSE); if (!stash || !(gv = gv_fetchmethod(stash, methname))) { DIE("Can't locate object method \"%s\" via package \"%s\"", - methname, SvPV(*MARK,PL_na)); + methname, SvPV(*MARK,n_a)); } ENTER; PUSHSTACKi(PERLSI_MAGIC); @@ -835,6 +840,7 @@ PP(pp_sselect) struct timeval *tbuf = &timebuf; I32 growsize; char *fd_sets[4]; + STRLEN n_a; #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 I32 masksize; I32 offset; @@ -903,7 +909,7 @@ PP(pp_sselect) continue; } else if (!SvPOK(sv)) - SvPV_force(sv,PL_na); /* force string conversion */ + SvPV_force(sv,n_a); /* force string conversion */ j = SvLEN(sv); if (j < growsize) { Sv_Grow(sv, growsize); @@ -1230,6 +1236,7 @@ PP(pp_prtf) PerlIO *fp; SV *sv; MAGIC *mg; + STRLEN n_a; if (PL_op->op_flags & OPf_STACKED) gv = (GV*)*++MARK; @@ -1260,7 +1267,7 @@ PP(pp_prtf) if (!(io = GvIO(gv))) { if (ckWARN(WARN_UNOPENED)) { gv_fullname3(sv, gv, Nullch); - warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na)); + warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a)); } SETERRNO(EBADF,RMS$_IFI); goto just_say_no; @@ -1270,10 +1277,10 @@ PP(pp_prtf) gv_fullname3(sv, gv, Nullch); if (IoIFP(io)) warner(WARN_IO, "Filehandle %s opened only for input", - SvPV(sv,PL_na)); + SvPV(sv,n_a)); else if (ckWARN(WARN_CLOSED)) warner(WARN_CLOSED, "printf on closed filehandle %s", - SvPV(sv,PL_na)); + SvPV(sv,n_a)); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1643,11 +1650,12 @@ PP(pp_truncate) Off_t len = (Off_t)POPn; int result = 1; GV *tmpgv; + STRLEN n_a; SETERRNO(0,0); #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP) if (PL_op->op_flags & OPf_SPECIAL) { - tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO); + tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO); do_ftruncate: TAINT_PROPER("truncate"); if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || @@ -1661,6 +1669,7 @@ PP(pp_truncate) else { SV *sv = POPs; char *name; + STRLEN n_a; if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; /* *main::FRED for example */ @@ -1671,7 +1680,7 @@ PP(pp_truncate) goto do_ftruncate; } - name = SvPV(sv, PL_na); + name = SvPV(sv, n_a); TAINT_PROPER("truncate"); #ifdef HAS_TRUNCATE if (truncate(name, len) < 0) @@ -2149,8 +2158,9 @@ PP(pp_ssockopt) char *buf; int aint; if (SvPOKp(sv)) { - buf = SvPV(sv, PL_na); - len = PL_na; + STRLEN l; + buf = SvPV(sv, l); + len = l; } else { aint = (int)SvIV(sv); @@ -2263,6 +2273,7 @@ PP(pp_stat) GV *tmpgv; I32 gimme; I32 max = 13; + STRLEN n_a; if (PL_op->op_flags & OPf_REF) { tmpgv = cGVOP->op_gv; @@ -2287,17 +2298,17 @@ PP(pp_stat) tmpgv = (GV*)SvRV(sv); goto do_fstat; } - sv_setpv(PL_statname, SvPV(sv,PL_na)); + sv_setpv(PL_statname, SvPV(sv,n_a)); PL_statgv = Nullgv; #ifdef HAS_LSTAT PL_laststype = PL_op->op_type; if (PL_op->op_type == OP_LSTAT) - PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, PL_na), &PL_statcache); + PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache); else #endif - PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache); + PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache); if (PL_laststatval < 0) { - if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, PL_na), '\n')) + if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n')) warner(WARN_NEWLINE, PL_warn_nl, "stat"); max = 0; } @@ -2349,8 +2360,9 @@ PP(pp_ftrread) I32 result; djSP; #if defined(HAS_ACCESS) && defined(R_OK) + STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { - result = access(TOPp, R_OK); + result = access(TOPpx, R_OK); if (result == 0) RETPUSHYES; if (result < 0) @@ -2375,8 +2387,9 @@ PP(pp_ftrwrite) I32 result; djSP; #if defined(HAS_ACCESS) && defined(W_OK) + STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { - result = access(TOPp, W_OK); + result = access(TOPpx, W_OK); if (result == 0) RETPUSHYES; if (result < 0) @@ -2401,8 +2414,9 @@ PP(pp_ftrexec) I32 result; djSP; #if defined(HAS_ACCESS) && defined(X_OK) + STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { - result = access(TOPp, X_OK); + result = access(TOPpx, X_OK); if (result == 0) RETPUSHYES; if (result < 0) @@ -2427,8 +2441,9 @@ PP(pp_fteread) I32 result; djSP; #ifdef PERL_EFF_ACCESS_R_OK + STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS_R_OK(TOPp); + result = PERL_EFF_ACCESS_R_OK(TOPpx); if (result == 0) RETPUSHYES; if (result < 0) @@ -2453,8 +2468,9 @@ PP(pp_ftewrite) I32 result; djSP; #ifdef PERL_EFF_ACCESS_W_OK + STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS_W_OK(TOPp); + result = PERL_EFF_ACCESS_W_OK(TOPpx); if (result == 0) RETPUSHYES; if (result < 0) @@ -2479,8 +2495,9 @@ PP(pp_fteexec) I32 result; djSP; #ifdef PERL_EFF_ACCESS_X_OK + STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS_X_OK(TOPp); + result = PERL_EFF_ACCESS_X_OK(TOPpx); if (result == 0) RETPUSHYES; if (result < 0) @@ -2701,6 +2718,7 @@ PP(pp_fttty) int fd; GV *gv; char *tmps = Nullch; + STRLEN n_a; if (PL_op->op_flags & OPf_REF) gv = cGVOP->op_gv; @@ -2709,7 +2727,7 @@ PP(pp_fttty) else if (SvROK(TOPs) && isGV(SvRV(TOPs))) gv = (GV*)SvRV(POPs); else - gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO); + gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO); if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); @@ -2741,6 +2759,7 @@ PP(pp_fttext) register IO *io; register SV *sv; GV *gv; + STRLEN n_a; if (PL_op->op_flags & OPf_REF) gv = cGVOP->op_gv; @@ -2804,14 +2823,14 @@ PP(pp_fttext) really_filename: PL_statgv = Nullgv; PL_laststatval = -1; - sv_setpv(PL_statname, SvPV(sv, PL_na)); + sv_setpv(PL_statname, SvPV(sv, n_a)); #ifdef HAS_OPEN3 - i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0); + i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0); #else - i = PerlLIO_open(SvPV(sv, PL_na), 0); + i = PerlLIO_open(SvPV(sv, n_a), 0); #endif if (i < 0) { - if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n')) + if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) warner(WARN_NEWLINE, PL_warn_nl, "open"); RETPUSHUNDEF; } @@ -2867,26 +2886,27 @@ PP(pp_chdir) djSP; dTARGET; char *tmps; SV **svp; + STRLEN n_a; if (MAXARG < 1) tmps = Nullch; else - tmps = POPp; + tmps = POPpx; if (!tmps || !*tmps) { svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE); if (svp) - tmps = SvPV(*svp, PL_na); + tmps = SvPV(*svp, n_a); } if (!tmps || !*tmps) { svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE); if (svp) - tmps = SvPV(*svp, PL_na); + tmps = SvPV(*svp, n_a); } #ifdef VMS if (!tmps || !*tmps) { svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE); if (svp) - tmps = SvPV(*svp, PL_na); + tmps = SvPV(*svp, n_a); } #endif TAINT_PROPER("chdir"); @@ -2918,7 +2938,8 @@ PP(pp_chroot) djSP; dTARGET; char *tmps; #ifdef HAS_CHROOT - tmps = POPp; + STRLEN n_a; + tmps = POPpx; TAINT_PROPER("chroot"); PUSHi( chroot(tmps) >= 0 ); RETURN; @@ -2961,9 +2982,10 @@ PP(pp_rename) { djSP; dTARGET; int anum; + STRLEN n_a; - char *tmps2 = POPp; - char *tmps = SvPV(TOPs, PL_na); + char *tmps2 = POPpx; + char *tmps = SvPV(TOPs, n_a); TAINT_PROPER("rename"); #ifdef HAS_RENAME anum = PerlLIO_rename(tmps, tmps2); @@ -2987,8 +3009,9 @@ PP(pp_link) { djSP; dTARGET; #ifdef HAS_LINK - char *tmps2 = POPp; - char *tmps = SvPV(TOPs, PL_na); + STRLEN n_a; + char *tmps2 = POPpx; + char *tmps = SvPV(TOPs, n_a); TAINT_PROPER("link"); SETi( link(tmps, tmps2) >= 0 ); #else @@ -3001,8 +3024,9 @@ PP(pp_symlink) { djSP; dTARGET; #ifdef HAS_SYMLINK - char *tmps2 = POPp; - char *tmps = SvPV(TOPs, PL_na); + STRLEN n_a; + char *tmps2 = POPpx; + char *tmps = SvPV(TOPs, n_a); TAINT_PROPER("symlink"); SETi( symlink(tmps, tmps2) >= 0 ); RETURN; @@ -3018,11 +3042,12 @@ PP(pp_readlink) char *tmps; char buf[MAXPATHLEN]; int len; + STRLEN n_a; #ifndef INCOMPLETE_TAINTS TAINT; #endif - tmps = POPp; + tmps = POPpx; len = readlink(tmps, buf, sizeof buf); EXTEND(SP, 1); if (len < 0) @@ -3131,7 +3156,8 @@ PP(pp_mkdir) #ifndef HAS_MKDIR int oldumask; #endif - char *tmps = SvPV(TOPs, PL_na); + STRLEN n_a; + char *tmps = SvPV(TOPs, n_a); TAINT_PROPER("mkdir"); #ifdef HAS_MKDIR @@ -3149,8 +3175,9 @@ PP(pp_rmdir) { djSP; dTARGET; char *tmps; + STRLEN n_a; - tmps = POPp; + tmps = POPpx; TAINT_PROPER("rmdir"); #ifdef HAS_RMDIR XPUSHi( PerlDir_rmdir(tmps) >= 0 ); @@ -3166,7 +3193,8 @@ PP(pp_open_dir) { djSP; #if defined(Direntry_t) && defined(HAS_READDIR) - char *dirname = POPp; + STRLEN n_a; + char *dirname = POPpx; GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); @@ -3411,10 +3439,11 @@ PP(pp_system) int result; int status; Sigsave_t ihand,qhand; /* place to save signals during system() */ + STRLEN n_a; if (SP - MARK == 1) { if (PL_tainting) { - char *junk = SvPV(TOPs, PL_na); + char *junk = SvPV(TOPs, n_a); TAINT_ENV(); TAINT_PROPER("system"); } @@ -3450,7 +3479,7 @@ PP(pp_system) else if (SP - MARK != 1) value = (I32)do_aexec(Nullsv, MARK, SP); else { - value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na)); + value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a)); } PerlProc__exit(-1); #else /* ! FORK or VMS or OS/2 */ @@ -3461,7 +3490,7 @@ PP(pp_system) else if (SP - MARK != 1) value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP); else { - value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na)); + value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a)); } STATUS_NATIVE_SET(value); do_execfree(); @@ -3475,6 +3504,7 @@ PP(pp_exec) { djSP; dMARK; dORIGMARK; dTARGET; I32 value; + STRLEN n_a; if (PL_op->op_flags & OPf_STACKED) { SV *really = *++MARK; @@ -3495,18 +3525,18 @@ PP(pp_exec) #endif else { if (PL_tainting) { - char *junk = SvPV(*SP, PL_na); + char *junk = SvPV(*SP, n_a); TAINT_ENV(); TAINT_PROPER("exec"); } #ifdef VMS - value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na)); + value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a)); #else # ifdef __OPEN_VM - (void) do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na)); + (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a)); value = 0; # else - value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na)); + value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a)); # endif #endif } @@ -3930,11 +3960,12 @@ PP(pp_ghostent) #endif struct hostent *hent; unsigned long len; + STRLEN n_a; EXTEND(SP, 10); if (which == OP_GHBYNAME) #ifdef HAS_GETHOSTBYNAME - hent = PerlSock_gethostbyname(POPp); + hent = PerlSock_gethostbyname(POPpx); #else DIE(PL_no_sock_func, "gethostbyname"); #endif @@ -4037,10 +4068,11 @@ PP(pp_gnetent) struct netent *PerlSock_getnetent(void); #endif struct netent *nent; + STRLEN n_a; if (which == OP_GNBYNAME) #ifdef HAS_GETNETBYNAME - nent = PerlSock_getnetbyname(POPp); + nent = PerlSock_getnetbyname(POPpx); #else DIE(PL_no_sock_func, "getnetbyname"); #endif @@ -4124,10 +4156,11 @@ PP(pp_gprotoent) struct protoent *PerlSock_getprotoent(void); #endif struct protoent *pent; + STRLEN n_a; if (which == OP_GPBYNAME) #ifdef HAS_GETPROTOBYNAME - pent = PerlSock_getprotobyname(POPp); + pent = PerlSock_getprotobyname(POPpx); #else DIE(PL_no_sock_func, "getprotobyname"); #endif @@ -4206,11 +4239,12 @@ PP(pp_gservent) struct servent *PerlSock_getservent(void); #endif struct servent *sent; + STRLEN n_a; if (which == OP_GSBYNAME) { #ifdef HAS_GETSERVBYNAME - char *proto = POPp; - char *name = POPp; + char *proto = POPpx; + char *name = POPpx; if (proto && !*proto) proto = Nullch; @@ -4222,7 +4256,7 @@ PP(pp_gservent) } else if (which == OP_GSBYPORT) { #ifdef HAS_GETSERVBYPORT - char *proto = POPp; + char *proto = POPpx; unsigned short port = POPu; #ifdef HAS_HTONS @@ -4399,9 +4433,10 @@ PP(pp_gpwent) I32 which = PL_op->op_type; register SV *sv; struct passwd *pwent; + STRLEN n_a; if (which == OP_GPWNAM) - pwent = getpwnam(POPp); + pwent = getpwnam(POPpx); else if (which == OP_GPWUID) pwent = getpwuid(POPi); else @@ -4532,9 +4567,10 @@ PP(pp_ggrent) register char **elem; register SV *sv; struct group *grent; + STRLEN n_a; if (which == OP_GGRNAM) - grent = (struct group *)getgrnam(POPp); + grent = (struct group *)getgrnam(POPpx); else if (which == OP_GGRGID) grent = (struct group *)getgrgid(POPi); else @@ -4626,6 +4662,7 @@ PP(pp_syscall) register I32 i = 0; I32 retval = -1; MAGIC *mg; + STRLEN n_a; if (PL_tainting) { while (++MARK <= SP) { @@ -4648,7 +4685,7 @@ PP(pp_syscall) else if (*MARK == &PL_sv_undef) a[i++] = 0; else - a[i++] = (unsigned long)SvPV_force(*MARK, PL_na); + a[i++] = (unsigned long)SvPV_force(*MARK, n_a); if (i > 15) break; } diff --git a/run.c b/run.c index c38df7f..3c1c3a2 100644 --- a/run.c +++ b/run.c @@ -73,6 +73,7 @@ debop(OP *o) { #ifdef DEBUGGING SV *sv; + STRLEN n_a; deb("%s", PL_op_name[o->op_type]); switch (o->op_type) { case OP_CONST: @@ -83,7 +84,7 @@ debop(OP *o) if (cGVOPo->op_gv) { sv = NEWSV(0,0); gv_fullname3(sv, cGVOPo->op_gv, Nullch); - PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na)); + PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a)); SvREFCNT_dec(sv); } else diff --git a/sv.c b/sv.c index 95c75da..fdeed68 100644 --- a/sv.c +++ b/sv.c @@ -3843,6 +3843,7 @@ sv_2io(SV *sv) { IO* io; GV* gv; + STRLEN n_a; switch (SvTYPE(sv)) { case SVt_PVIO: @@ -3859,13 +3860,13 @@ sv_2io(SV *sv) croak(PL_no_usym, "filehandle"); if (SvROK(sv)) return sv_2io(SvRV(sv)); - gv = gv_fetchpv(SvPV(sv,PL_na), FALSE, SVt_PVIO); + gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO); if (gv) io = GvIO(gv); else io = 0; if (!io) - croak("Bad filehandle: %s", SvPV(sv,PL_na)); + croak("Bad filehandle: %s", SvPV(sv,n_a)); break; } return io; @@ -3876,6 +3877,7 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref) { GV *gv; CV *cv; + STRLEN n_a; if (!sv) return *gvp = Nullgv, Nullcv; @@ -3917,7 +3919,7 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref) else if (isGV(sv)) gv = (GV*)sv; else - gv = gv_fetchpv(SvPV(sv, PL_na), lref, SVt_PVCV); + gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV); *gvp = gv; if (!gv) return Nullcv; @@ -3934,7 +3936,7 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref) Nullop); LEAVE; if (!GvCVu(gv)) - croak("Unable to create sub named \"%s\"", SvPV(sv,PL_na)); + croak("Unable to create sub named \"%s\"", SvPV(sv,n_a)); } return GvCVu(gv); } diff --git a/t/op/pwent.t b/t/op/pwent.t index 1365588..4316b17 100755 --- a/t/op/pwent.t +++ b/t/op/pwent.t @@ -78,7 +78,7 @@ foreach (sort keys %seen) { if ($times > 1) { # Multiply defined users are rarely intentional. local $" = ", "; - warn "# User '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n"; + print "# User '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n"; delete $suspect{$_}; } } diff --git a/taint.c b/taint.c index 5a88699..655cec8 100644 --- a/taint.c +++ b/taint.c @@ -89,9 +89,10 @@ taint_env(void) svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE); if (svp && *svp && SvTAINTED(*svp)) { dTHR; /* just for taint */ + STRLEN n_a; bool was_tainted = PL_tainted; - char *t = SvPV(*svp, PL_na); - char *e = t + PL_na; + char *t = SvPV(*svp, n_a); + char *e = t + n_a; PL_tainted = was_tainted; if (t < e && isALNUM(*t)) t++; diff --git a/toke.c b/toke.c index e91fa8c..090a56b 100644 --- a/toke.c +++ b/toke.c @@ -1452,8 +1452,10 @@ filter_add(filter_t funcp, SV *datasv) if (!SvUPGRADE(datasv, SVt_PVIO)) die("Can't upgrade filter_add data to SVt_PVIO"); IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */ - if (filter_debug) - warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na)); + if (filter_debug) { + STRLEN n_a; + warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a)); + } av_unshift(PL_rsfp_filters, 1); av_store(PL_rsfp_filters, 0, datasv) ; return(datasv); @@ -1529,9 +1531,11 @@ filter_read(int idx, SV *buf_sv, int maxlen) } /* Get function pointer hidden within datasv */ funcp = (filter_t)IoDIRP(datasv); - if (filter_debug) + if (filter_debug) { + STRLEN n_a; warn("filter_read %d: via function %p (%s)\n", - idx, funcp, SvPV(datasv,PL_na)); + idx, funcp, SvPV(datasv,n_a)); + } /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ @@ -2965,6 +2969,7 @@ int yylex(PERL_YYLEX_PARAM_DECL) case 'z': case 'Z': keylookup: { + STRLEN n_a; gv = Nullgv; gvp = 0; @@ -3161,7 +3166,7 @@ int yylex(PERL_YYLEX_PARAM_DECL) if (gv && GvCVu(gv)) { CV *cv; if ((cv = GvCV(gv)) && SvPOK(cv)) - PL_last_proto = SvPV((SV*)cv, PL_na); + PL_last_proto = SvPV((SV*)cv, n_a); for (d = s + 1; *d == ' ' || *d == '\t'; d++) ; if (*d == ')' && (sv = cv_const_sv(cv))) { s = d + 1; @@ -4119,7 +4124,7 @@ int yylex(PERL_YYLEX_PARAM_DECL) PL_lex_stuff = Nullsv; } - if (*SvPV(PL_subname,PL_na) == '?') { + if (*SvPV(PL_subname,n_a) == '?') { sv_setpv(PL_subname,"__ANON__"); TOKEN(ANONSUB); } diff --git a/universal.c b/universal.c index d0ef90d..4f76d92 100644 --- a/universal.c +++ b/universal.c @@ -113,12 +113,13 @@ XS(XS_UNIVERSAL_isa) dXSARGS; SV *sv; char *name; + STRLEN n_a; if (items != 2) croak("Usage: UNIVERSAL::isa(reference, kind)"); sv = ST(0); - name = (char *)SvPV(ST(1),PL_na); + name = (char *)SvPV(ST(1),n_a); ST(0) = boolSV(sv_derived_from(sv, name)); XSRETURN(1); @@ -131,12 +132,13 @@ XS(XS_UNIVERSAL_can) char *name; SV *rv; HV *pkg = NULL; + STRLEN n_a; if (items != 2) croak("Usage: UNIVERSAL::can(object-ref, method)"); sv = ST(0); - name = (char *)SvPV(ST(1),PL_na); + name = (char *)SvPV(ST(1),n_a); rv = &PL_sv_undef; if(SvROK(sv)) { @@ -191,9 +193,11 @@ XS(XS_UNIVERSAL_VERSION) undef = "(undef)"; } - if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) + if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) { + STRLEN n_a; croak("%s version %s required--this is only version %s", - HvNAME(pkg), SvPV(ST(1),PL_na), undef ? undef : SvPV(sv,PL_na)); + HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a)); + } ST(0) = sv; diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c index 6169e70..1185433 100644 --- a/vmesa/vmesa.c +++ b/vmesa/vmesa.c @@ -116,6 +116,7 @@ do_aspawn(SV* really, SV **mark, SV **sp) fdMap[3]; SV *sv, **p_sv; + STRLEN n_a; status = FAIL; if (sp > mark) @@ -126,7 +127,7 @@ do_aspawn(SV* really, SV **mark, SV **sp) while (++mark <= sp) { if (*mark) - *a++ = SvPVx(*mark, PL_na); + *a++ = SvPVx(*mark, n_a); else *a++ = ""; } @@ -142,7 +143,7 @@ do_aspawn(SV* really, SV **mark, SV **sp) /*-----------------------------------------------------*/ if (*PL_Argv[0] != '/') TAINT_ENV(); - if (really && *(tmps = SvPV(really, PL_na))) + if (really && *(tmps = SvPV(really, n_a))) pid = spawnp(tmps, nFd, fdMap, &inherit, (const char **) PL_Argv, (const char **) environ); diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs index 6fa1b29..53b4915 100644 --- a/vms/ext/Stdio/Stdio.xs +++ b/vms/ext/Stdio/Stdio.xs @@ -164,11 +164,12 @@ setdef(...) struct FAB deffab = cc$rms_fab; struct NAM defnam = cc$rms_nam; struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + STRLEN n_a; if (items) { SV *defsv = ST(items-1); /* mimic chdir() */ ST(0) = &PL_sv_undef; if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); } - if (tovmsspec(SvPV(defsv,PL_na),vmsdef) == NULL) { XSRETURN(1); } + if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); } deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef); } else { @@ -232,6 +233,7 @@ vmsopen(spec,...) char *args[8],mode[3] = {'r','\0','\0'}, type = '<'; register int i, myargc; FILE *fp; + STRLEN n_a; if (!spec || !*spec) { SETERRNO(EINVAL,LIB$_INVARG); @@ -250,7 +252,7 @@ vmsopen(spec,...) } else if (*spec == '<') spec++; myargc = items - 1; - for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),PL_na); + for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a); /* This hack brought to you by C's opaque arglist management */ switch (myargc) { case 0: @@ -298,13 +300,14 @@ vmssysopen(spec,mode,perm,...) int i, myargc, fd; FILE *fp; SV *fh; + STRLEN n_a; if (!spec || !*spec) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN_UNDEF; } if (items > 11) croak("too many args"); myargc = items - 3; - for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),PL_na); + for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a); /* More fun with C calls; can't combine with above because args 2,3 of different types in fopen() and open() */ switch (myargc) { diff --git a/vms/perly_c.vms b/vms/perly_c.vms index db1f255..2fc1781 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1775,7 +1775,7 @@ case 56: break; case 57: #line 302 "perly.y" -{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na); +{ STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) CvUNIQUE_on(PL_compcv); diff --git a/vms/vms.c b/vms/vms.c index 6bfbe3c..bc09b08 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -2848,6 +2848,7 @@ setup_argstr(SV *really, SV **mark, SV **sp) register size_t cmdlen = 0; size_t rlen; register SV **idx; + STRLEN n_a; idx = mark; if (really) { @@ -2874,7 +2875,7 @@ setup_argstr(SV *really, SV **mark, SV **sp) while (++mark <= sp) { if (*mark) { strcat(PL_Cmd," "); - strcat(PL_Cmd,SvPVx(*mark,PL_na)); + strcat(PL_Cmd,SvPVx(*mark,n_a)); } } return PL_Cmd; @@ -4407,12 +4408,13 @@ rmsexpand_fromperl(CV *cv) { dXSARGS; char *fspec, *defspec = NULL, *rslt; + STRLEN n_a; if (!items || items > 2) croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])"); - fspec = SvPV(ST(0),PL_na); + fspec = SvPV(ST(0),n_a); if (!fspec || !*fspec) XSRETURN_UNDEF; - if (items == 2) defspec = SvPV(ST(1),PL_na); + if (items == 2) defspec = SvPV(ST(1),n_a); rslt = do_rmsexpand(fspec,NULL,1,defspec,0); ST(0) = sv_newmortal(); @@ -4425,9 +4427,10 @@ vmsify_fromperl(CV *cv) { dXSARGS; char *vmsified; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)"); - vmsified = do_tovmsspec(SvPV(ST(0),PL_na),NULL,1); + vmsified = do_tovmsspec(SvPV(ST(0),n_a),NULL,1); ST(0) = sv_newmortal(); if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified)); XSRETURN(1); @@ -4438,9 +4441,10 @@ unixify_fromperl(CV *cv) { dXSARGS; char *unixified; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)"); - unixified = do_tounixspec(SvPV(ST(0),PL_na),NULL,1); + unixified = do_tounixspec(SvPV(ST(0),n_a),NULL,1); ST(0) = sv_newmortal(); if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified)); XSRETURN(1); @@ -4451,9 +4455,10 @@ fileify_fromperl(CV *cv) { dXSARGS; char *fileified; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)"); - fileified = do_fileify_dirspec(SvPV(ST(0),PL_na),NULL,1); + fileified = do_fileify_dirspec(SvPV(ST(0),n_a),NULL,1); ST(0) = sv_newmortal(); if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified)); XSRETURN(1); @@ -4464,9 +4469,10 @@ pathify_fromperl(CV *cv) { dXSARGS; char *pathified; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)"); - pathified = do_pathify_dirspec(SvPV(ST(0),PL_na),NULL,1); + pathified = do_pathify_dirspec(SvPV(ST(0),n_a),NULL,1); ST(0) = sv_newmortal(); if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified)); XSRETURN(1); @@ -4477,9 +4483,10 @@ vmspath_fromperl(CV *cv) { dXSARGS; char *vmspath; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)"); - vmspath = do_tovmspath(SvPV(ST(0),PL_na),NULL,1); + vmspath = do_tovmspath(SvPV(ST(0),n_a),NULL,1); ST(0) = sv_newmortal(); if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath)); XSRETURN(1); @@ -4490,9 +4497,10 @@ unixpath_fromperl(CV *cv) { dXSARGS; char *unixpath; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)"); - unixpath = do_tounixpath(SvPV(ST(0),PL_na),NULL,1); + unixpath = do_tounixpath(SvPV(ST(0),n_a),NULL,1); ST(0) = sv_newmortal(); if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath)); XSRETURN(1); @@ -4505,6 +4513,7 @@ candelete_fromperl(CV *cv) char fspec[NAM$C_MAXRSS+1], *fsp; SV *mysv; IO *io; + STRLEN n_a; if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)"); @@ -4518,7 +4527,7 @@ candelete_fromperl(CV *cv) fsp = fspec; } else { - if (mysv != ST(0) || !(fsp = SvPV(mysv,PL_na)) || !*fsp) { + if (mysv != ST(0) || !(fsp = SvPV(mysv,n_a)) || !*fsp) { set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); ST(0) = &PL_sv_no; XSRETURN(1); @@ -4540,6 +4549,7 @@ rmscopy_fromperl(CV *cv) unsigned long int sts; SV *mysv; IO *io; + STRLEN n_a; if (items < 2 || items > 3) croak("Usage: File::Copy::rmscopy(from,to[,date_flag])"); @@ -4554,7 +4564,7 @@ rmscopy_fromperl(CV *cv) inp = inspec; } else { - if (mysv != ST(0) || !(inp = SvPV(mysv,PL_na)) || !*inp) { + if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) { set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); ST(0) = &PL_sv_no; XSRETURN(1); @@ -4570,7 +4580,7 @@ rmscopy_fromperl(CV *cv) outp = outspec; } else { - if (mysv != ST(1) || !(outp = SvPV(mysv,PL_na)) || !*outp) { + if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) { set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); ST(0) = &PL_sv_no; XSRETURN(1); diff --git a/win32/win32.c b/win32/win32.c index be5f5e1..e9619d6 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -469,6 +469,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) int status; int flag = P_WAIT; int index = 0; + STRLEN n_a; if (sp <= mark) return -1; @@ -482,7 +483,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) } while (++mark <= sp) { - if (*mark && (str = SvPV(*mark, PL_na))) + if (*mark && (str = SvPV(*mark, n_a))) argv[index++] = str; else argv[index++] = ""; @@ -490,7 +491,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[index++] = 0; status = win32_spawnvp(flag, - (const char*)(really ? SvPV(really,PL_na) : argv[0]), + (const char*)(really ? SvPV(really,n_a) : argv[0]), (const char* const*)argv); if (status < 0 && errno == ENOEXEC) { @@ -503,7 +504,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[sh_items] = w32_perlshell_vec[sh_items]; status = win32_spawnvp(flag, - (const char*)(really ? SvPV(really,PL_na) : argv[0]), + (const char*)(really ? SvPV(really,n_a) : argv[0]), (const char* const*)argv); } @@ -2158,9 +2159,10 @@ static XS(w32_SetCwd) { dXSARGS; + STRLEN n_a; if (items != 1) croak("usage: Win32::SetCurrentDirectory($cwd)"); - if (SetCurrentDirectory(SvPV(ST(0),PL_na))) + if (SetCurrentDirectory(SvPV(ST(0),n_a))) XSRETURN_YES; XSRETURN_NO; @@ -2339,12 +2341,13 @@ XS(w32_Spawn) PROCESS_INFORMATION stProcInfo; STARTUPINFO stStartInfo; BOOL bSuccess = FALSE; + STRLEN n_a; if (items != 3) croak("usage: Win32::Spawn($cmdName, $args, $PID)"); - cmd = SvPV(ST(0),PL_na); - args = SvPV(ST(1), PL_na); + cmd = SvPV(ST(0), n_a); + args = SvPV(ST(1), n_a); memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */ stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */