Change 30292 by [EMAIL PROTECTED] on 2007/02/14 17:29:10
Integrate:
[ 28273]
Subject: [PATCH] literal string macros
From: Marcus Holland-Moritz <[EMAIL PROTECTED]>
Date: Mon, 22 May 2006 13:39:33 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 29486]
No need to upgrade if all we're going to do is return.
[ 29872]
Given that we now do the tests in S_visit() to avoid calling the
helper function when skippable, no need to retain those tests
inside the helper functions do_clean_objs() and do_clean_named_objs().
[ 29983]
Neither gv_fetchpvn_flags() nor hv_fetch() need a NUL terminated
string, so don't bother allocating buffer space or adding a NUL.
[ 29987]
Convert the last remaining 256 byte "small"bufs to 128 bytes.
(The actual size doesn't matter, as the buffers are only there to
save a malloc() for the common, short, case. Coverage reports suggest
that we aren't actually testing the long case. Yet - will fix this)
[ 30000]
As we're not passing over (or copying in) a NUL, don't need that extra
byte for it, so correct the < to <= so that we use the smallbuf
whenever possible.
[ 30015]
Stop S_incline needing to temporarily write a '\0' into its passed-in
buffer. (Requires adding gv_fetchfile_flags(), savesharedpvn() and
CopFILE_setn() to provide pointer/length versions of APIs)
[ 30024]
A test to exercise the smallbuf overflow code in S_incline, and a
refactoring of that code to use only one 128 char array, not two.
[ 30064]
Add av_create_and_push() and av_create_and_unshift_one() to refactor
out two repeated idioms.
[ 30101]
A few more places where we know the length for sv_setpv() or sv_catpv()
[ 30229]
Un-TODO tests avec change #30228
Affected files ...
... //depot/maint-5.8/perl/av.c#42 integrate
... //depot/maint-5.8/perl/cop.h#36 integrate
... //depot/maint-5.8/perl/doio.c#104 integrate
... //depot/maint-5.8/perl/embed.fnc#209 integrate
... //depot/maint-5.8/perl/embed.h#157 integrate
... //depot/maint-5.8/perl/global.sym#60 integrate
... //depot/maint-5.8/perl/gv.c#99 integrate
... //depot/maint-5.8/perl/handy.h#49 integrate
... //depot/maint-5.8/perl/mg.c#149 integrate
... //depot/maint-5.8/perl/op.c#199 integrate
... //depot/maint-5.8/perl/perl.c#205 integrate
... //depot/maint-5.8/perl/pod/perlapi.pod#98 integrate
... //depot/maint-5.8/perl/pp_ctl.c#174 integrate
... //depot/maint-5.8/perl/proto.h#201 integrate
... //depot/maint-5.8/perl/sv.c#343 integrate
... //depot/maint-5.8/perl/t/comp/parser.t#18 integrate
... //depot/maint-5.8/perl/toke.c#166 integrate
... //depot/maint-5.8/perl/util.c#146 integrate
Differences ...
==== //depot/maint-5.8/perl/av.c#42 (text) ====
Index: perl/av.c
--- perl/av.c#41~29993~ 2007-01-26 01:15:17.000000000 -0800
+++ perl/av.c 2007-02-14 09:29:10.000000000 -0800
@@ -502,6 +502,24 @@
}
/*
+
+=for apidoc av_create_and_push
+
+Push an SV onto the end of the array, creating the array if necessary.
+A small internal helper function to remove a commonly duplicated idiom.
+
+=cut
+*/
+
+void
+Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
+{
+ if (!*avp)
+ *avp = newAV();
+ av_push(*avp, val);
+}
+
+/*
=for apidoc av_push
Pushes an SV onto the end of the array. The array will grow automatically
@@ -581,6 +599,26 @@
}
/*
+
+=for apidoc av_create_and_unshift_one
+
+Unshifts an SV onto the beginning of the array, creating the array if
+necessary.
+A small internal helper function to remove a commonly duplicated idiom.
+
+=cut
+*/
+
+SV **
+Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
+{
+ if (!*avp)
+ *avp = newAV();
+ av_unshift(*avp, 1);
+ return av_store(*avp, 0, val);
+}
+
+/*
=for apidoc av_unshift
Unshift the given number of C<undef> values onto the beginning of the
==== //depot/maint-5.8/perl/cop.h#36 (text) ====
Index: perl/cop.h
--- perl/cop.h#35~30290~ 2007-02-14 08:13:48.000000000 -0800
+++ perl/cop.h 2007-02-14 09:29:10.000000000 -0800
@@ -236,8 +236,10 @@
# ifdef NETWARE
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepv((pv),(l)))
# else
# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
+# define CopFILE_setn(c,pv,l) ((c)->cop_file = savesharedpvn((pv),(l)))
# endif
# define CopFILESV(c) (CopFILE(c) \
@@ -268,6 +270,7 @@
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+# define CopFILE_setn(c,pv,l) CopFILEGV_set((c),
gv_fetchfile_flags((pv),(l),0))
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
# define CopFILEAVx(c) (GvAV(CopFILEGV(c)))
==== //depot/maint-5.8/perl/doio.c#104 (text) ====
Index: perl/doio.c
--- perl/doio.c#103~30058~ 2007-01-29 08:46:38.000000000 -0800
+++ perl/doio.c 2007-02-14 09:29:10.000000000 -0800
@@ -708,10 +708,9 @@
if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
IoFLAGS(io) &= ~IOf_START;
if (PL_inplace) {
- if (!PL_argvout_stack)
- PL_argvout_stack = newAV();
assert(PL_defoutgv);
- av_push(PL_argvout_stack, SvREFCNT_inc_simple_NN(PL_defoutgv));
+ Perl_av_create_and_push(aTHX_ &PL_argvout_stack,
+ SvREFCNT_inc_simple_NN(PL_defoutgv));
}
}
if (PL_filemode & (S_ISUID|S_ISGID)) {
==== //depot/maint-5.8/perl/embed.fnc#209 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#208~30290~ 2007-02-14 08:13:48.000000000 -0800
+++ perl/embed.fnc 2007-02-14 09:29:10.000000000 -0800
@@ -114,11 +114,13 @@
ApdR |I32 |av_len |NN AV* ar
ApdR |AV* |av_make |I32 size|NN SV** svp
Apd |SV* |av_pop |NULLOK AV* ar
+ApdoxM |void |av_create_and_push|NN AV **const avp|NN SV *const val
Apd |void |av_push |NULLOK AV* ar|NN SV* val
p |void |av_reify |NN AV* ar
ApdR |SV* |av_shift |NULLOK AV* ar
Apd |SV** |av_store |NULLOK AV* ar|I32 key|NULLOK SV* val
Apd |void |av_undef |NULLOK AV* ar
+ApdoxM |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val
Apd |void |av_unshift |NULLOK AV* ar|I32 num
pR |OP* |bind_match |I32 type|NN OP* left|NN OP* pat
pR |OP* |block_end |I32 floor|NULLOK OP* seq
@@ -291,6 +293,8 @@
Apmb |void |gv_efullname3 |NN SV* sv|NN GV* gv|NULLOK const char* prefix
Ap |void |gv_efullname4 |NN SV* sv|NN GV* gv|NULLOK const char*
prefix|bool keepmain
Ap |GV* |gv_fetchfile |NN const char* name
+Ap |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\
+ |const U32 flags
Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN
len|I32 level
Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char*
name|STRLEN len|I32 level
Apdmb |GV* |gv_fetchmethod |NULLOK HV* stash|NN const char* name
@@ -682,6 +686,7 @@
Apda |char* |savepv |NULLOK const char* pv
Apda |char* |savepvn |NULLOK const char* pv|I32 len
Apda |char* |savesharedpv |NULLOK const char* pv
+Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len
Ap |void |savestack_grow
Ap |void |savestack_grow_cnt |I32 need
Ap |void |save_aelem |NN AV* av|I32 idx|NN SV **sptr
@@ -1378,7 +1383,7 @@
s |void |checkcomma |NN const char *s|NN const char *name \
|NN const char *what
s |void |force_ident |NN const char *s|int kind
-s |void |incline |NN char *s
+s |void |incline |NN const char *s
s |int |intuit_method |NN char *s|NULLOK GV *gv|NULLOK CV *cv
s |int |intuit_more |NN char *s
s |I32 |lop |I32 f|int x|NN char *s
==== //depot/maint-5.8/perl/embed.h#157 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#156~30290~ 2007-02-14 08:13:48.000000000 -0800
+++ perl/embed.h 2007-02-14 09:29:10.000000000 -0800
@@ -284,6 +284,7 @@
#define gv_efullname Perl_gv_efullname
#define gv_efullname4 Perl_gv_efullname4
#define gv_fetchfile Perl_gv_fetchfile
+#define gv_fetchfile_flags Perl_gv_fetchfile_flags
#define gv_fetchmeth Perl_gv_fetchmeth
#define gv_fetchmeth_autoload Perl_gv_fetchmeth_autoload
#define gv_fetchmethod_autoload Perl_gv_fetchmethod_autoload
@@ -710,6 +711,7 @@
#define savepv Perl_savepv
#define savepvn Perl_savepvn
#define savesharedpv Perl_savesharedpv
+#define savesharedpvn Perl_savesharedpvn
#define savestack_grow Perl_savestack_grow
#define savestack_grow_cnt Perl_savestack_grow_cnt
#define save_aelem Perl_save_aelem
@@ -2386,6 +2388,7 @@
#define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b)
#define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d)
#define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a)
+#define gv_fetchfile_flags(a,b,c) Perl_gv_fetchfile_flags(aTHX_ a,b,c)
#define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d)
#define gv_fetchmeth_autoload(a,b,c,d) Perl_gv_fetchmeth_autoload(aTHX_
a,b,c,d)
#define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_
a,b,c)
@@ -2810,6 +2813,7 @@
#define savepv(a) Perl_savepv(aTHX_ a)
#define savepvn(a,b) Perl_savepvn(aTHX_ a,b)
#define savesharedpv(a) Perl_savesharedpv(aTHX_ a)
+#define savesharedpvn(a,b) Perl_savesharedpvn(aTHX_ a,b)
#define savestack_grow() Perl_savestack_grow(aTHX)
#define savestack_grow_cnt(a) Perl_savestack_grow_cnt(aTHX_ a)
#define save_aelem(a,b,c) Perl_save_aelem(aTHX_ a,b,c)
==== //depot/maint-5.8/perl/global.sym#60 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#59~30181~ 2007-02-09 09:20:56.000000000 -0800
+++ perl/global.sym 2007-02-14 09:29:10.000000000 -0800
@@ -139,6 +139,7 @@
Perl_gv_efullname3
Perl_gv_efullname4
Perl_gv_fetchfile
+Perl_gv_fetchfile_flags
Perl_gv_fetchmeth
Perl_gv_fetchmeth_autoload
Perl_gv_fetchmethod
@@ -386,6 +387,7 @@
Perl_savepv
Perl_savepvn
Perl_savesharedpv
+Perl_savesharedpvn
Perl_savestack_grow
Perl_savestack_grow_cnt
Perl_save_aelem
==== //depot/maint-5.8/perl/gv.c#99 (text) ====
Index: perl/gv.c
--- perl/gv.c#98~30110~ 2007-02-03 11:00:21.000000000 -0800
+++ perl/gv.c 2007-02-14 09:29:10.000000000 -0800
@@ -103,30 +103,38 @@
GV *
Perl_gv_fetchfile(pTHX_ const char *name)
{
- char smallbuf[256];
+ return gv_fetchfile_flags(name, strlen(name), 0);
+}
+
+GV *
+Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen,
+ const U32 flags)
+{
+ char smallbuf[128];
char *tmpbuf;
- STRLEN tmplen;
+ const STRLEN tmplen = namelen + 2;
GV *gv;
+ PERL_UNUSED_ARG(flags);
+
if (!PL_defstash)
return NULL;
- tmplen = strlen(name) + 2;
- if (tmplen < sizeof smallbuf)
+ if (tmplen <= sizeof smallbuf)
tmpbuf = smallbuf;
else
- Newx(tmpbuf, tmplen + 1, char);
+ Newx(tmpbuf, tmplen, char);
/* This is where the debugger's %{"::_<$filename"} hash is created */
tmpbuf[0] = '_';
tmpbuf[1] = '<';
- memcpy(tmpbuf + 2, name, tmplen - 1);
+ memcpy(tmpbuf + 2, name, namelen);
gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
if (!isGV(gv)) {
gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
#ifdef PERL_DONT_CREATE_GVSV
- GvSV(gv) = newSVpvn(name, tmplen - 2);
+ GvSV(gv) = newSVpvn(name, namelen);
#else
- sv_setpvn(GvSV(gv), name, tmplen - 2);
+ sv_setpvn(GvSV(gv), name, namelen);
#endif
if (PERLDB_LINE)
hv_magic(GvHVn(gv_AVadd(gv)), NULL, PERL_MAGIC_dbfile);
@@ -713,14 +721,13 @@
HV *stash;
GV *tmpgv;
- if (namelen + 3 < sizeof smallbuf)
+ if (namelen + 2 <= sizeof smallbuf)
tmpbuf = smallbuf;
else
- Newx(tmpbuf, namelen + 3, char);
+ Newx(tmpbuf, namelen + 2, char);
Copy(name,tmpbuf,namelen,char);
tmpbuf[namelen++] = ':';
tmpbuf[namelen++] = ':';
- tmpbuf[namelen] = '\0';
tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, create, SVt_PVHV);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
@@ -808,14 +815,13 @@
char smallbuf[128];
char *tmpbuf;
- if (len + 3 < (I32)sizeof (smallbuf))
+ if (len + 2 <= (I32)sizeof (smallbuf))
tmpbuf = smallbuf;
else
- Newx(tmpbuf, len+3, char);
+ Newx(tmpbuf, len+2, char);
Copy(name, tmpbuf, len, char);
tmpbuf[len++] = ':';
tmpbuf[len++] = ':';
- tmpbuf[len] = '\0';
gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
gv = gvp ? *gvp : NULL;
if (gv && gv != (GV*)&PL_sv_undef) {
==== //depot/maint-5.8/perl/handy.h#49 (text) ====
Index: perl/handy.h
--- perl/handy.h#48~30261~ 2007-02-13 09:58:37.000000000 -0800
+++ perl/handy.h 2007-02-14 09:29:10.000000000 -0800
@@ -236,6 +236,44 @@
#define Ctl(ch) ((ch) & 037)
+/*
+=head1 SV-Body Allocation
+
+=for apidoc Ama|SV*|newSVpvs|const char* s
+Like C<newSVpvn>, but takes a literal string instead of a string/length pair.
+
+=for apidoc Ama|SV*|newSVpvs_share|const char* s
+Like C<newSVpvn_share>, but takes a literal string instead of a string/length
+pair and omits the hash parameter.
+
+=for apidoc Am|SV*|sv_catpvs|SV* sv|const char* s
+Like C<sv_catpvn>, but takes a literal string instead of a string/length pair.
+
+=for apidoc Am|SV*|sv_setpvs|SV* sv|const char* s
+Like C<sv_setpvn>, but takes a literal string instead of a string/length pair.
+
+=head1 Memory Management
+
+=for apidoc Ama|char*|savepvs|const char* s
+Like C<savepvn>, but takes a literal string instead of a string/length pair.
+
+=head1 GV Functions
+
+=for apidoc Am|HV*|gv_stashpvs|const char* name|I32 create
+Like C<gv_stashpvn>, but takes a literal string instead of a string/length
pair.
+
+=head1 Hash Manipulation Functions
+
+=for apidoc Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval
+Like C<hv_fetch>, but takes a literal string instead of a string/length pair.
+
+=for apidoc Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val
+Like C<hv_store>, but takes a literal string instead of a string/length pair
+and omits the hash parameter.
+
+=cut
+*/
+
/* concatenating with "" ensures that only literal strings are accepted as
argument */
#define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
@@ -248,10 +286,12 @@
#define newSVpvs(str) Perl_newSVpvn(aTHX_ STR_WITH_LEN(str))
#define newSVpvs_share(str) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(str), 0)
#define sv_catpvs(sv, str) Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str),
SV_GMAGIC)
+#define sv_setpvs(sv, str) Perl_sv_setpvn(aTHX_ sv, STR_WITH_LEN(str))
#define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str))
#define gv_stashpvs(str, create) Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str),
create)
#define gv_fetchpvs(namebeg, add, sv_type) Perl_gv_fetchpvn_flags(aTHX_
STR_WITH_LEN(namebeg), add, sv_type)
#define hv_fetchs(hv,key,lval) Perl_hv_fetch(aTHX_ hv, STR_WITH_LEN(key), lval)
+#define hv_stores(hv,key,val) Perl_hv_store(aTHX_ hv, STR_WITH_LEN(key), val,
0)
/*
==== //depot/maint-5.8/perl/mg.c#149 (text) ====
Index: perl/mg.c
--- perl/mg.c#148~30232~ 2007-02-12 08:27:14.000000000 -0800
+++ perl/mg.c 2007-02-14 09:29:10.000000000 -0800
@@ -1238,7 +1238,7 @@
#endif
/* cache state so we don't fetch it again */
if(sigstate == (Sighandler_t) SIG_IGN)
- sv_setpv(sv,"IGNORE");
+ sv_setpvs(sv,"IGNORE");
else
sv_setsv(sv,&PL_sv_undef);
PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
==== //depot/maint-5.8/perl/op.c#199 (text) ====
Index: perl/op.c
--- perl/op.c#198~30291~ 2007-02-14 08:37:49.000000000 -0800
+++ perl/op.c 2007-02-14 09:29:10.000000000 -0800
@@ -4214,7 +4214,7 @@
if (gv)
gv_efullname3(name = sv_newmortal(), (GV *)gv, NULL);
- sv_setpv(msg, "Prototype mismatch:");
+ sv_setpvs(msg, "Prototype mismatch:");
if (name)
Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, (void*)name);
if (SvPOK(cv))
@@ -4641,10 +4641,8 @@
SAVECOPFILE(&PL_compiling);
SAVECOPLINE(&PL_compiling);
- if (!PL_beginav)
- PL_beginav = newAV();
DEBUG_x( dump_sub(gv) );
- av_push(PL_beginav, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_beginav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
call_list(oldscope, PL_beginav);
@@ -4653,30 +4651,22 @@
LEAVE;
}
else if (strEQ(s, "END") && !PL_error_count) {
- if (!PL_endav)
- PL_endav = newAV();
DEBUG_x( dump_sub(gv) );
- av_unshift(PL_endav, 1);
- av_store(PL_endav, 0, (SV*)cv);
+ Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "CHECK") && !PL_error_count) {
- if (!PL_checkav)
- PL_checkav = newAV();
DEBUG_x( dump_sub(gv) );
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK
block");
- av_unshift(PL_checkav, 1);
- av_store(PL_checkav, 0, (SV*)cv);
+ Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "INIT") && !PL_error_count) {
- if (!PL_initav)
- PL_initav = newAV();
DEBUG_x( dump_sub(gv) );
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT
block");
- av_push(PL_initav, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
}
@@ -4872,33 +4862,23 @@
goto done;
if (strEQ(s, "BEGIN")) {
- if (!PL_beginav)
- PL_beginav = newAV();
- av_push(PL_beginav, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_beginav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "END")) {
- if (!PL_endav)
- PL_endav = newAV();
- av_unshift(PL_endav, 1);
- av_store(PL_endav, 0, (SV*)cv);
+ Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "CHECK")) {
- if (!PL_checkav)
- PL_checkav = newAV();
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK
block");
- av_unshift(PL_checkav, 1);
- av_store(PL_checkav, 0, (SV*)cv);
+ Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
else if (strEQ(s, "INIT")) {
- if (!PL_initav)
- PL_initav = newAV();
if (PL_main_start && ckWARN(WARN_VOID))
Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT
block");
- av_push(PL_initav, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
}
}
==== //depot/maint-5.8/perl/perl.c#205 (text) ====
Index: perl/perl.c
--- perl/perl.c#204~30291~ 2007-02-14 08:37:49.000000000 -0800
+++ perl/perl.c 2007-02-14 09:29:10.000000000 -0800
@@ -367,8 +367,8 @@
sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
#ifdef USE_ITHREADS
- PL_regex_padav = newAV();
- av_push(PL_regex_padav,(SV*)newAV()); /* First entry is an array of
empty elements */
+ /* First entry is an array of empty elements */
+ Perl_av_create_and_push(aTHX_ &PL_regex_padav,(SV*)newAV());
PL_regex_pad = AvARRAY(PL_regex_padav);
#endif
#ifdef USE_REENTRANT_API
@@ -1870,10 +1870,7 @@
{
SV *opts_prog;
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_push(PL_preambleav,
- newSVpvs("use Config;"));
+ Perl_av_create_and_push(aTHX_ &PL_preambleav, newSVpvs("use
Config;"));
if (*++s != ':') {
STRLEN opts;
@@ -2134,10 +2131,8 @@
#ifdef USE_SITECUSTOMIZE
if (!minus_f) {
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_unshift(PL_preambleav, 1);
- (void)av_store(PL_preambleav, 0, Perl_newSVpvf(aTHX_ "BEGIN { do
'%s/sitecustomize.pl' }", SITELIB_EXP));
+ (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
+ Perl_newSVpvf(aTHX_ "BEGIN { do
'%s/sitecustomize.pl' }", SITELIB_EXP));
}
#endif
@@ -3328,9 +3323,7 @@
sv_catpvs(sv, "\0)");
}
s += strlen(s);
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_push(PL_preambleav, sv);
+ Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
}
else
Perl_croak(aTHX_ "Missing argument to -%c", *(s-1));
@@ -5274,15 +5267,11 @@
if (PL_savebegin) {
if (paramList == PL_beginav) {
/* save PL_beginav for compiler */
- if (! PL_beginav_save)
- PL_beginav_save = newAV();
- av_push(PL_beginav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_beginav_save, (SV*)cv);
}
else if (paramList == PL_checkav) {
/* save PL_checkav for compiler */
- if (! PL_checkav_save)
- PL_checkav_save = newAV();
- av_push(PL_checkav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_checkav_save, (SV*)cv);
}
} else {
SAVEFREESV(cv);
==== //depot/maint-5.8/perl/pod/perlapi.pod#98 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#97~30290~ 2007-02-14 08:13:48.000000000 -0800
+++ perl/pod/perlapi.pod 2007-02-14 09:29:10.000000000 -0800
@@ -1348,6 +1348,16 @@
=for hackers
Found in file gv.c
+=item gv_stashpvs
+X<gv_stashpvs>
+
+Like C<gv_stashpvn>, but takes a literal string instead of a string/length
pair.
+
+ HV* gv_stashpvs(const char* name, I32 create)
+
+=for hackers
+Found in file handy.h
+
=item gv_stashsv
X<gv_stashsv>
@@ -1647,6 +1657,16 @@
=for hackers
Found in file hv.c
+=item hv_fetchs
+X<hv_fetchs>
+
+Like C<hv_fetch>, but takes a literal string instead of a string/length pair.
+
+ SV** hv_fetchs(HV* tb, const char* key, I32 lval)
+
+=for hackers
+Found in file handy.h
+
=item hv_fetch_ent
X<hv_fetch_ent>
@@ -1814,6 +1834,17 @@
=for hackers
Found in file hv.c
+=item hv_stores
+X<hv_stores>
+
+Like C<hv_store>, but takes a literal string instead of a string/length pair
+and omits the hash parameter.
+
+ SV** hv_stores(HV* tb, const char* key, NULLOK SV* val)
+
+=for hackers
+Found in file handy.h
+
=item hv_store_ent
X<hv_store_ent>
@@ -2238,6 +2269,16 @@
=for hackers
Found in file util.c
+=item savepvs
+X<savepvs>
+
+Like C<savepvn>, but takes a literal string instead of a string/length pair.
+
+ char* savepvs(const char* s)
+
+=for hackers
+Found in file handy.h
+
=item savesharedpv
X<savesharedpv>
@@ -2249,6 +2290,18 @@
=for hackers
Found in file util.c
+=item savesharedpvn
+X<savesharedpvn>
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+ char* savesharedpvn(const char *const pv, const STRLEN len)
+
+=for hackers
+Found in file util.c
+
=item savesvpv
X<savesvpv>
@@ -4181,6 +4234,9 @@
Increments the reference count of the given SV.
+All of the following SvREFCNT_inc* macros are optimized versions of
+SvREFCNT_inc, and can be replaced with SvREFCNT_inc.
+
SV* SvREFCNT_inc(SV* sv)
=for hackers
@@ -4233,6 +4289,19 @@
=for hackers
Found in file sv.h
+=item SvREFCNT_inc_simple_void_NN
+X<SvREFCNT_inc_simple_void_NN>
+
+Same as SvREFCNT_inc, but can only be used if you don't need the return
+value, and you know that I<sv> is not NULL. The macro doesn't need
+to return a meaningful value, or check for NULLness, so it's smaller
+and faster.
+
+ SV* SvREFCNT_inc_simple_void_NN(SV* sv)
+
+=for hackers
+Found in file sv.h
+
=item SvREFCNT_inc_void
X<SvREFCNT_inc_void>
@@ -4688,6 +4757,27 @@
=for hackers
Found in file sv.c
+=item newSVpvs
+X<newSVpvs>
+
+Like C<newSVpvn>, but takes a literal string instead of a string/length pair.
+
+ SV* newSVpvs(const char* s)
+
+=for hackers
+Found in file handy.h
+
+=item newSVpvs_share
+X<newSVpvs_share>
+
+Like C<newSVpvn_share>, but takes a literal string instead of a string/length
+pair and omits the hash parameter.
+
+ SV* newSVpvs_share(const char* s)
+
+=for hackers
+Found in file handy.h
+
=item newSVrv
X<newSVrv>
@@ -4938,6 +5028,16 @@
=for hackers
Found in file sv.c
+=item sv_catpvs
+X<sv_catpvs>
+
+Like C<sv_catpvn>, but takes a literal string instead of a string/length pair.
+
+ SV* sv_catpvs(SV* sv, const char* s)
+
+=for hackers
+Found in file handy.h
+
=item sv_catpv_mg
X<sv_catpv_mg>
@@ -5515,6 +5615,16 @@
=for hackers
Found in file sv.c
+=item sv_setpvs
+X<sv_setpvs>
+
+Like C<sv_setpvn>, but takes a literal string instead of a string/length pair.
+
+ SV* sv_setpvs(SV* sv, const char* s)
+
+=for hackers
+Found in file handy.h
+
=item sv_setpv_mg
X<sv_setpv_mg>
==== //depot/maint-5.8/perl/pp_ctl.c#174 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#173~30241~ 2007-02-12 12:43:49.000000000 -0800
+++ perl/pp_ctl.c 2007-02-14 09:29:10.000000000 -0800
@@ -2849,7 +2849,7 @@
}
else {
if (!*msg) {
- sv_setpv(ERRSV, "Compilation error");
+ sv_setpvs(ERRSV, "Compilation error");
}
}
#ifdef USE_5005THREADS
==== //depot/maint-5.8/perl/proto.h#201 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#200~30290~ 2007-02-14 08:13:48.000000000 -0800
+++ perl/proto.h 2007-02-14 09:29:10.000000000 -0800
@@ -103,12 +103,14 @@
PERL_CALLCONV SV* Perl_av_pop(pTHX_ AV* ar);
PERL_CALLCONV void Perl_av_push(pTHX_ AV* ar, SV* val);
+PERL_CALLCONV void Perl_av_create_and_push(pTHX_ AV **const avp, SV *const
val);
PERL_CALLCONV void Perl_av_reify(pTHX_ AV* ar);
PERL_CALLCONV SV* Perl_av_shift(pTHX_ AV* ar)
__attribute__warn_unused_result__;
PERL_CALLCONV SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val);
PERL_CALLCONV void Perl_av_undef(pTHX_ AV* ar);
+PERL_CALLCONV SV** Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV
*const val);
PERL_CALLCONV void Perl_av_unshift(pTHX_ AV* ar, I32 num);
PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat)
__attribute__warn_unused_result__;
@@ -368,6 +370,7 @@
/* PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char*
prefix); */
PERL_CALLCONV void Perl_gv_efullname4(pTHX_ SV* sv, GV* gv, const char*
prefix, bool keepmain);
PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name);
+PERL_CALLCONV GV* Perl_gv_fetchfile_flags(pTHX_ const char *const name,
const STRLEN len, const U32 flags);
PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name,
STRLEN len, I32 level);
PERL_CALLCONV GV* Perl_gv_fetchmeth_autoload(pTHX_ HV* stash, const char*
name, STRLEN len, I32 level);
/* PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name);
*/
@@ -1086,6 +1089,10 @@
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV char* Perl_savesharedpvn(pTHX_ const char *const pv, const
STRLEN len)
+ __attribute__malloc__
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV void Perl_savestack_grow(pTHX);
PERL_CALLCONV void Perl_savestack_grow_cnt(pTHX_ I32 need);
PERL_CALLCONV void Perl_save_aelem(pTHX_ AV* av, I32 idx, SV **sptr);
@@ -1966,7 +1973,7 @@
STATIC void S_checkcomma(pTHX_ const char *s, const char *name, const char
*what);
STATIC void S_force_ident(pTHX_ const char *s, int kind);
-STATIC void S_incline(pTHX_ char *s);
+STATIC void S_incline(pTHX_ const char *s);
STATIC int S_intuit_method(pTHX_ char *s, GV *gv, CV *cv);
STATIC int S_intuit_more(pTHX_ char *s);
STATIC I32 S_lop(pTHX_ I32 f, int x, char *s);
==== //depot/maint-5.8/perl/sv.c#343 (text) ====
Index: perl/sv.c
--- perl/sv.c#342~30291~ 2007-02-14 08:37:49.000000000 -0800
+++ perl/sv.c 2007-02-14 09:29:10.000000000 -0800
@@ -402,9 +402,9 @@
static void
do_clean_objs(pTHX_ SV *sv)
{
- SV* rv;
+ SV *const rv = SvRV(sv);
- if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
+ if (SvOBJECT(rv)) {
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "),
sv_dump(sv)));
if (SvWEAKREF(sv)) {
sv_del_backref(sv);
@@ -426,7 +426,7 @@
static void
do_clean_named_objs(pTHX_ SV *sv)
{
- if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
+ if (GvGP(sv)) {
if ((
#ifdef PERL_DONT_CREATE_GVSV
GvSV(sv) &&
==== //depot/maint-5.8/perl/t/comp/parser.t#18 (text) ====
Index: perl/t/comp/parser.t
--- perl/t/comp/parser.t#17~29996~ 2007-01-26 01:54:13.000000000 -0800
+++ perl/t/comp/parser.t 2007-02-14 09:29:10.000000000 -0800
@@ -9,7 +9,7 @@
}
require "./test.pl";
-plan( tests => 56 );
+plan( tests => 92 );
eval '[EMAIL PROTECTED];';
like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '[EMAIL
PROTECTED]' );
@@ -194,3 +194,81 @@
eval q{ s/x/#/e };
is( $@, '', 'comments in s///e' );
+
+# Add new tests HERE:
+
+# More awkward tests for #line. Keep these at the end, as they will screw
+# with sane line reporting for any other test failures
+
+sub check ($$$) {
+ my ($file, $line, $name) = @_;
+ my (undef, $got_file, $got_line) = caller;
+ like ($got_file, $file, "file of $name");
+ is ($got_line, $line, "line of $name");
+}
+
+#line 3
+check(qr/parser\.t$/, 3, "bare line");
+
+# line 5
+check(qr/parser\.t$/, 5, "bare line with leading space");
+
+#line 7
+check(qr/parser\.t$/, 7, "trailing space still valid");
+
+# line 11
+check(qr/parser\.t$/, 11, "leading and trailing");
+
+# line 13
+check(qr/parser\.t$/, 13, "leading tab");
+
+#line 17
+check(qr/parser\.t$/, 17, "middle tab");
+
+#line 19
+check(qr/parser\.t$/, 19, "loadsaspaces");
+
+#line 23 KASHPRITZA
+check(qr/^KASHPRITZA$/, 23, "bare filename");
+
+#line 29 "KAHEEEE"
+check(qr/^KAHEEEE$/, 29, "filename in quotes");
+
+#line 31 "CLINK CLOINK BZZT"
+check(qr/^CLINK CLOINK BZZT$/, 31, "filename with spaces in quotes");
+
+#line 37 "THOOM THOOM"
+check(qr/^THOOM THOOM$/, 37, "filename with tabs in quotes");
+
+#line 41 "GLINK PLINK GLUNK DINK"
+check(qr/^GLINK PLINK GLUNK DINK$/, 41, "a space after the quotes");
+
+#line 43 "BBFRPRAFPGHPP
+check(qr/^"BBFRPRAFPGHPP$/, 43, "actually missing a quote is still valid");
+
+#line 47 bang eth
+check(qr/^"BBFRPRAFPGHPP$/, 46, "but spaces aren't allowed without quotes");
+
+eval <<'EOSTANZA'; die $@ if $@;
+#line 51 "With wonderful deathless ditties|We build up the world's great
cities,|And out of a fabulous story|We fashion an empire's glory:|One man with
a dream, at pleasure,|Shall go forth and conquer a crown;|And three with a new
song's measure|Can trample a kingdom down."
+check(qr/^With.*down\.$/, 51, "Overflow the second small buffer check");
+EOSTANZA
+
+# And now, turn on the debugger flag for long names
+$^P = 0x100;
+
+#line 53 "For we are afar with the dawning|And the suns that are not yet
high,|And out of the infinite morning|Intrepid you hear us cry-|How, spite of
your human scorning,|Once more God's future draws nigh,|And already goes forth
the warning|That ye of the past must die."
+check(qr/^For we.*must die\.$/, 53, "Our long line is set up");
+
+eval <<'EOT'; die $@ if $@;
+#line 59 " "
+check(qr/^ $/, 59, "Overflow the first small buffer check only");
+EOT
+
+eval <<'EOSTANZA'; die $@ if $@;
+#line 61 "Great hail! we cry to the comers|From the dazzling unknown
shore;|Bring us hither your sun and your summers;|And renew our world as of
yore;|You shall teach us your song's new numbers,|And things that we dreamed
not before:|Yea, in spite of a dreamer who slumbers,|And a singer who sings no
more."
+check(qr/^Great hail!.*no more\.$/, 61, "Overflow both small buffer checks");
+EOSTANZA
+
+__END__
+# Don't add new tests HERE. See note above
==== //depot/maint-5.8/perl/toke.c#166 (text) ====
Index: perl/toke.c
--- perl/toke.c#165~30291~ 2007-02-14 08:37:49.000000000 -0800
+++ perl/toke.c 2007-02-14 09:29:10.000000000 -0800
@@ -653,12 +653,11 @@
*/
STATIC void
-S_incline(pTHX_ char *s)
+S_incline(pTHX_ const char *s)
{
- char *t;
- char *n;
- char *e;
- char ch;
+ const char *t;
+ const char *n;
+ const char *e;
CopLINE_inc(PL_curcop);
if (*s++ != '#')
@@ -698,34 +697,48 @@
if (*e != '\n' && *e != '\0')
return; /* false alarm */
- ch = *t;
- *t = '\0';
if (t - s > 0) {
+ const STRLEN len = t - s;
#ifndef USE_ITHREADS
const char * const cf = CopFILE(PL_curcop);
STRLEN tmplen = cf ? strlen(cf) : 0;
if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
/* must copy *{"::_<(eval N)[oldfilename:L]"}
* to *{"::_<newfilename"} */
- char smallbuf[256], smallbuf2[256];
- char *tmpbuf, *tmpbuf2;
- GV **gvp, *gv2;
- STRLEN tmplen2 = strlen(s);
- if (tmplen + 3 < sizeof smallbuf)
+ /* However, the long form of evals is only turned on by the
+ debugger - usually they're "(eval %lu)" */
+ char smallbuf[128];
+ char *tmpbuf;
+ GV **gvp;
+ STRLEN tmplen2 = len;
+ if (tmplen + 2 <= sizeof smallbuf)
tmpbuf = smallbuf;
else
- Newx(tmpbuf, tmplen + 3, char);
- if (tmplen2 + 3 < sizeof smallbuf2)
- tmpbuf2 = smallbuf2;
- else
- Newx(tmpbuf2, tmplen2 + 3, char);
- tmpbuf[0] = tmpbuf2[0] = '_';
- tmpbuf[1] = tmpbuf2[1] = '<';
- memcpy(tmpbuf + 2, cf, ++tmplen);
- memcpy(tmpbuf2 + 2, s, ++tmplen2);
- ++tmplen; ++tmplen2;
+ Newx(tmpbuf, tmplen + 2, char);
+ tmpbuf[0] = '_';
+ tmpbuf[1] = '<';
+ memcpy(tmpbuf + 2, cf, tmplen);
+ tmplen += 2;
gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
if (gvp) {
+ char *tmpbuf2;
+ GV *gv2;
+
+ if (tmplen2 + 2 <= sizeof smallbuf)
+ tmpbuf2 = smallbuf;
+ else
+ Newx(tmpbuf2, tmplen2 + 2, char);
+
+ if (tmpbuf2 != smallbuf || tmpbuf != smallbuf) {
+ /* Either they malloc'd it, or we malloc'd it,
+ so no prefix is present in ours. */
+ tmpbuf2[0] = '_';
+ tmpbuf2[1] = '<';
+ }
+
+ memcpy(tmpbuf2 + 2, s, tmplen2);
+ tmplen2 += 2;
+
gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
if (!isGV(gv2)) {
gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
@@ -734,15 +747,15 @@
GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
}
+
+ if (tmpbuf2 != smallbuf) Safefree(tmpbuf2);
}
if (tmpbuf != smallbuf) Safefree(tmpbuf);
- if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
}
#endif
CopFILE_free(PL_curcop);
- CopFILE_set(PL_curcop, s);
+ CopFILE_setn(PL_curcop, s, len);
}
- *t = ch;
CopLINE_set(PL_curcop, atoi(n)-1);
}
@@ -814,7 +827,7 @@
{
/* end of file. Add on the -p or -n magic */
if (PL_minus_p) {
- sv_setpv(PL_linestr,
+ sv_setpvs(PL_linestr,
";}continue{print or die qq(-p destination: $!\\n);}");
PL_minus_n = PL_minus_p = 0;
}
@@ -5504,8 +5517,8 @@
/* remember buffer pos'n for later force_word */
tboffset = s - PL_oldbufptr;
d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
- if (strchr(tmpbuf, ':'))
- sv_setpv(PL_subname, tmpbuf);
+ if (memchr(tmpbuf, ':', len))
+ sv_setpvn(PL_subname, tmpbuf, len);
else {
sv_setsv(PL_subname,PL_curstname);
sv_catpvs(PL_subname,"::");
==== //depot/maint-5.8/perl/util.c#146 (text) ====
Index: perl/util.c
--- perl/util.c#145~30226~ 2007-02-12 06:48:32.000000000 -0800
+++ perl/util.c 2007-02-14 09:29:10.000000000 -0800
@@ -941,6 +941,27 @@
}
/*
+=for apidoc savesharedpvn
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+=cut
+*/
+char *
+Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
+{
+ char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
+ assert(pv);
+ if (!newaddr) {
+ return write_no_mem();
+ }
+ newaddr[len] = '\0';
+ return (char*)memcpy(newaddr, pv, len);
+}
+
+/*
=for apidoc savesvpv
A version of C<savepv()>/C<savepvn()> which gets the string to duplicate from
End of Patch.
