In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/2c67934f13f40110c09b8c3b95ed2ca21d6f132d?hp=2b393bf410d9f1bf0b80132c4e8b5d6707a139f8>
- Log -----------------------------------------------------------------
commit 2c67934f13f40110c09b8c3b95ed2ca21d6f132d
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 17:08:36 2009 +0000
Note that nothing in core uses Perl_get_cv any more, and why it is hard to
move
it to mathoms.c
M perl.c
commit 3f48f963d8052f436b4eec3a766d77f2675fee9a
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 17:06:14 2009 +0000
Convert db_get_cv() to use get_cvn_flags() as it already knows the length of
the string that it is passing.
M ext/Devel/DProf/DProf.xs
commit b96d8cd966afa49291119752aac86cd1f1de5560
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 16:41:58 2009 +0000
Add get_cvs() as a shortcut for STR_WITH_LEN() and Perl_get_cvn_flags(), and
use it where possible.
M ext/Devel/DProf/DProf.xs
M ext/DynaLoader/dlutils.c
M ext/PerlIO/encoding/encoding.xs
M handy.h
M op.c
M perlio.c
M pp_ctl.c
commit e350d0e0ab968c54f8b39c21d92b151f1f1611d5
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 16:12:06 2009 +0000
In attrs::get(), use Perl_get_cvn_flags() rather than perl_get_cv().
M ext/attrs/attrs.xs
commit 0da0e728710fd7ef615c1a9711842235a554e595
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 15:55:25 2009 +0000
Correct the form of the flags passed to perl_get_cv().
M ext/Devel/DProf/DProf.xs
M ext/DynaLoader/dlutils.c
M perl.c
M pp_ctl.c
commit 8583b25748abc73adb4164e557462c026e44fbbe
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 15:30:05 2009 +0000
Correct the form of the flags passed to perl_get_sv() in threads.xs
M ext/threads/threads.xs
commit 3509f64745dbf50d4fef957b08257584294fd14e
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 15:14:57 2009 +0000
Correct the form of the flags passed to perl_get_sv() in Storable.xs
M ext/Storable/Storable.xs
commit 64ace3f88f559d007c0150d9b048b1db32380208
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 15:03:03 2009 +0000
Update the documentation of get_sv() to note that it calls
Perl_gv_fetchpv(),
and hence the 'create' argument is actually 'flags'. Fix core code and
documentation that used TRUE or FALSE to use 0 or GV_ADD.
M embed.fnc
M ext/Devel/DProf/DProf.xs
M ext/Devel/Peek/Peek.xs
M os2/os2.c
M perl.c
M pod/perl5005delta.pod
M pod/perlapi.pod
M pod/perlembed.pod
M pod/perlguts.pod
M proto.h
M symbian/symbian_utils.cpp
M util.c
commit cbfd0a879b2bf2ade4a309e6d56c08ba19f320e1
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 13:36:08 2009 +0000
Update the documentation of get_av() to note that it calls
Perl_gv_fetchpv(),
and hence the 'create' argument is actually 'flags'. Fix code and
documentation
that used TRUE or FALSE to use 0 or GV_ADD.
M embed.fnc
M ext/B/B.xs
M ext/DynaLoader/dlutils.c
M perl.c
M pod/perlapi.pod
M pod/perlembed.pod
M pod/perlguts.pod
M proto.h
commit 6673a63c63e2a65dbfcc835d6499cc97c449c67b
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Jan 21 12:12:12 2009 +0000
Update the documentation of get_hv() to note that it calls
Perl_gv_fetchpv(),
and hence the 'create' argument is actually 'flags'. Fix code and
documentation
that used TRUE or FALSE to use 0 or GV_ADD.
M embed.fnc
M mg.c
M perl.c
M pod/perlapi.pod
M pod/perlguts.pod
M pp_ctl.c
M proto.h
M utf8.c
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 6 ++--
ext/B/B.xs | 2 +-
ext/Devel/DProf/DProf.xs | 18 ++++++++------
ext/Devel/Peek/Peek.xs | 8 +++---
ext/DynaLoader/dlutils.c | 4 +-
ext/PerlIO/encoding/encoding.xs | 2 +-
ext/Storable/Storable.xs | 32 ++++++++++++------------
ext/attrs/attrs.xs | 5 ++-
ext/threads/threads.xs | 4 +-
handy.h | 2 +
mg.c | 2 +-
op.c | 3 +-
os2/os2.c | 2 +-
perl.c | 49 +++++++++++++++++++++-----------------
perlio.c | 2 +-
pod/perl5005delta.pod | 2 +-
pod/perlapi.pod | 29 ++++++++++++----------
pod/perlembed.pod | 10 ++++----
pod/perlguts.pod | 14 +++++-----
pp_ctl.c | 6 ++--
proto.h | 6 ++--
symbian/symbian_utils.cpp | 2 +-
utf8.c | 2 +-
util.c | 2 +-
24 files changed, 113 insertions(+), 101 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 4a9d6ce..45d8923 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -772,9 +772,9 @@ Ap |void |despatch_signals
Ap |OP * |doref |NN OP *o|I32 type|bool set_op_ref
Apd |SV* |eval_pv |NN const char* p|I32 croak_on_error
Apd |I32 |eval_sv |NN SV* sv|I32 flags
-Apd |SV* |get_sv |NN const char* name|I32 create
-Apd |AV* |get_av |NN const char* name|I32 create
-Apd |HV* |get_hv |NN const char* name|I32 create
+Apd |SV* |get_sv |NN const char *name|I32 flags
+Apd |AV* |get_av |NN const char *name|I32 flags
+Apd |HV* |get_hv |NN const char *name|I32 flags
Apd |CV* |get_cv |NN const char* name|I32 flags
Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags
Ap |int |init_i18nl10n |int printwarn
diff --git a/ext/B/B.xs b/ext/B/B.xs
index eca6f08..186237f 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -596,7 +596,7 @@ PROTOTYPES: DISABLE
BOOT:
{
HV *stash = gv_stashpvn("B", 1, GV_ADD);
- AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
+ AV *export_ok = perl_get_av("B::EXPORT_OK", GV_ADD);
MY_CXT_INIT;
specialsv_list[0] = Nullsv;
specialsv_list[1] = &PL_sv_undef;
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 469ed22..4eef0bc 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -24,7 +24,9 @@ db_get_cv(pTHX_ SV *sv)
cv = INT2PTR(CV*,SvIVX(sv));
} else {
if (SvPOK(sv)) {
- cv = get_cv(SvPVX_const(sv), TRUE);
+ STRLEN len;
+ const char *const name = SvPV(sv, len);
+ cv = get_cvn_flags(name, len, GV_ADD | SvUTF8(sv));
} else if (SvROK(sv)) {
cv = (CV*)SvRV(sv);
} else {
@@ -194,17 +196,17 @@ dprof_times(pTHX_ struct tms *t)
if (!g_frequ) {
if (CheckOSError(DosTmrQueryFreq(&g_frequ)))
- croak("DosTmrQueryFreq: %s", SvPV_nolen(perl_get_sv("!",TRUE)));
+ croak("DosTmrQueryFreq: %s", SvPV_nolen(perl_get_sv("!",GV_ADD)));
else
g_frequ = g_frequ/DPROF_HZ; /* count per tick */
if (CheckOSError(DosTmrQueryTime(&cnt)))
croak("DosTmrQueryTime: %s",
- SvPV_nolen_const(perl_get_sv("!",TRUE)));
+ SvPV_nolen_const(perl_get_sv("!",GV_ADD)));
g_start_cnt = toLongLong(cnt);
}
if (CheckOSError(DosTmrQueryTime(&cnt)))
- croak("DosTmrQueryTime: %s", SvPV_nolen(perl_get_sv("!",TRUE)));
+ croak("DosTmrQueryTime: %s", SvPV_nolen(perl_get_sv("!",GV_ADD)));
t->tms_stime = 0;
return (t->tms_utime = (toLongLong(cnt) - g_start_cnt)/g_frequ);
#else /* !OS2 */
@@ -240,13 +242,13 @@ dprof_times(pTHX_ struct tms *t)
if (!tv0.tv_sec)
if (gettimeofday(&tv0, NULL) < 0)
- croak("gettimeofday: %s", SvPV_nolen_const(perl_get_sv("!",TRUE)));
+ croak("gettimeofday: %s",
SvPV_nolen_const(perl_get_sv("!",GV_ADD)));
if (getrusage(0, &ru) < 0)
- croak("getrusage: %s", SvPV_nolen_const(perl_get_sv("!",TRUE)));
+ croak("getrusage: %s", SvPV_nolen_const(perl_get_sv("!",GV_ADD)));
if (gettimeofday(&tv, NULL) < 0)
- croak("gettimeofday: %s", SvPV_nolen_const(perl_get_sv("!",TRUE)));
+ croak("gettimeofday: %s", SvPV_nolen_const(perl_get_sv("!",GV_ADD)));
t->tms_stime = DPROF_HZ * ru.ru_stime.tv_sec + ru.ru_stime.tv_usec;
t->tms_utime = DPROF_HZ * ru.ru_utime.tv_sec + ru.ru_utime.tv_usec;
@@ -470,7 +472,7 @@ prof_mark(pTHX_ opcode ptype)
static void
test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s)
{
- CV * const cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE);
+ CV * const cv = get_cvs("Devel::DProf::NONESUCH_noxs", 0);
HV * const oldstash = PL_curstash;
struct tms t1, t2;
const U32 ototal = g_total;
diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs
index 0351cc2..68584f7 100644
--- a/ext/Devel/Peek/Peek.xs
+++ b/ext/Devel/Peek/Peek.xs
@@ -338,9 +338,9 @@ SV * sv
I32 lim
PPCODE:
{
- SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE);
+ SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
- SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE);
+ SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
const U16 save_dumpindent = PL_dumpindent;
PL_dumpindent = 2;
do_sv_dump(0, Perl_debug_log, sv, 0, lim,
@@ -354,9 +354,9 @@ I32 lim
PPCODE:
{
long i;
- SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE);
+ SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", 0);
const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0;
- SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE);
+ SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", 0);
const U16 save_dumpindent = PL_dumpindent;
PL_dumpindent = 2;
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index e9dd34a..1ba9a61 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -68,8 +68,8 @@ dl_unload_all_files(pTHX_ void *unused)
AV *dl_librefs;
SV *dl_libref;
- if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
- dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
+ if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) {
+ dl_librefs = get_av("DynaLoader::dl_librefs", 0);
while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
dSP;
ENTER;
diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index f1b0742..dc69819 100644
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -639,7 +639,7 @@ BOOT:
*/
PUSHSTACKi(PERLSI_MAGIC);
SPAGAIN;
- if (!get_cv(OUR_DEFAULT_FB, 0)) {
+ if (!get_cvs(OUR_DEFAULT_FB, 0)) {
#if 0
/* This would just be an irritant now loading works */
Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'");
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 24de05f..2741c7d 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -151,7 +151,7 @@ typedef double NV; /* Older perls lack the
NV type */
#define TRACEME(x)
\
STMT_START {
\
- if (SvTRUE(perl_get_sv("Storable::DEBUGME", TRUE))) \
+ if (SvTRUE(perl_get_sv("Storable::DEBUGME", GV_ADD))) \
{ PerlIO_stdoutf x; PerlIO_stdoutf("\n"); } \
} STMT_END
#else
@@ -401,7 +401,7 @@ typedef struct stcxt {
#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
#define dSTCXT_SV
\
- SV *perinterp_sv = perl_get_sv(MY_VERSION, FALSE)
+ SV *perinterp_sv = perl_get_sv(MY_VERSION, 0)
#else /* >= perl5.004_68 */
#define dSTCXT_SV
\
SV *perinterp_sv = *hv_fetch(PL_modglobal, \
@@ -2332,7 +2332,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
if (
!(cxt->optype & ST_CLONE) && (cxt->canonical == 1 ||
(cxt->canonical < 0 && (cxt->canonical =
- (SvTRUE(perl_get_sv("Storable::canonical", TRUE)) ? 1 :
0))))
+ (SvTRUE(perl_get_sv("Storable::canonical", GV_ADD)) ? 1
: 0))))
) {
/*
* Storing in order, sorted by key.
@@ -2619,7 +2619,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
if (
cxt->deparse == 0 ||
(cxt->deparse < 0 && !(cxt->deparse =
- SvTRUE(perl_get_sv("Storable::Deparse", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::Deparse", GV_ADD)) ? 1 :
0))
) {
return store_other(aTHX_ cxt, (SV*)cv);
}
@@ -3397,7 +3397,7 @@ static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
if (
cxt->forgive_me == 0 ||
(cxt->forgive_me < 0 && !(cxt->forgive_me =
- SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 :
0))
+ SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1
: 0))
)
CROAK(("Can't store %s items", sv_reftype(sv, FALSE)));
@@ -3689,7 +3689,7 @@ static int magic_write(pTHX_ stcxt_t *cxt)
length = sizeof (network_file_header);
} else {
#ifdef USE_56_INTERWORK_KLUDGE
- if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+ if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
header = file_header_56;
length = sizeof (file_header_56);
} else
@@ -4913,7 +4913,7 @@ static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, const
char *cname)
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -4942,7 +4942,7 @@ static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, const
char *cname)
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -5273,7 +5273,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const
char *cname)
if (hash_flags & SHV_RESTRICTED) {
if (cxt->derestrict < 0)
cxt->derestrict
- = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::downgrade_restricted",
GV_ADD))
? 1 : 0);
if (cxt->derestrict == 0)
RESTRICTED_HASH_CROAK();
@@ -5342,7 +5342,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const
char *cname)
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -5443,14 +5443,14 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char
*cname)
*/
if (cxt->eval == NULL) {
- cxt->eval = perl_get_sv("Storable::Eval", TRUE);
+ cxt->eval = perl_get_sv("Storable::Eval", GV_ADD);
SvREFCNT_inc(cxt->eval);
}
if (!SvTRUE(cxt->eval)) {
if (
cxt->forgive_me == 0 ||
(cxt->forgive_me < 0 && !(cxt->forgive_me =
- SvTRUE(perl_get_sv("Storable::forgive_me",
TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::forgive_me",
GV_ADD)) ? 1 : 0))
) {
CROAK(("Can't eval, please set $Storable::Eval to a
true value"));
} else {
@@ -5465,7 +5465,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char
*cname)
SAVETMPS;
if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
- SV* errsv = get_sv("@", TRUE);
+ SV* errsv = get_sv("@", GV_ADD);
sv_setpvn(errsv, "", 0); /* clear $@ */
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVsv(sub)));
@@ -5777,7 +5777,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
if (cxt->accept_future_minor < 0)
cxt->accept_future_minor
= (SvTRUE(perl_get_sv("Storable::accept_future_minor",
- TRUE))
+ GV_ADD))
? 1 : 0);
if (cxt->accept_future_minor == 1)
croak_now = 0; /* Don't croak yet. */
@@ -5814,7 +5814,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
#ifdef USE_56_INTERWORK_KLUDGE
/* No point in caching this in the context as we only need it once per
retrieve, and we need to recheck it each read. */
- if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+ if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
if ((c != (sizeof (byteorderstr_56) - 1))
|| memNE(buf, byteorderstr_56, c))
CROAK(("Byte order is not compatible"));
@@ -5948,7 +5948,7 @@ static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname)
if (cxt->accept_future_minor < 0)
cxt->accept_future_minor
= (SvTRUE(perl_get_sv("Storable::accept_future_minor",
- TRUE))
+ GV_ADD))
? 1 : 0);
if (cxt->accept_future_minor == 1) {
CROAK(("Storable binary image v%d.%d contains data of type %d.
"
diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs
index e3ba012..c7fce19 100644
--- a/ext/attrs/attrs.xs
+++ b/ext/attrs/attrs.xs
@@ -52,8 +52,9 @@ SV * sub
sub = Nullsv;
}
else {
- const char * const name = SvPV_nolen(sub);
- sub = (SV*)perl_get_cv(name, FALSE);
+ STRLEN len;
+ const char * const name = SvPV(sub, len);
+ sub = (SV*)get_cvn_flags(name, len, SvUTF8(sub));
}
if (!sub)
croak("invalid subroutine reference or name");
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index cb461cc..a15f7ec 100644
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -356,7 +356,7 @@ S_good_stack_size(pTHX_ IV stack_size)
# endif
if ((long)MY_POOL.page_size < 0) {
if (errno) {
- SV * const error = get_sv("@", FALSE);
+ SV * const error = get_sv("@", 0);
(void)SvUPGRADE(error, SVt_PV);
Perl_croak(aTHX_ "PANIC: sysconf: %s", SvPV_nolen(error));
} else {
@@ -870,7 +870,7 @@ ithread_create(...)
/* threads->create() */
classname = (char *)SvPV_nolen(ST(0));
stack_size = MY_POOL.default_stack_size;
- thread_exit_only = get_sv("threads::thread_exit_only", TRUE);
+ thread_exit_only = get_sv("threads::thread_exit_only", GV_ADD);
exit_opt = (SvTRUE(thread_exit_only))
? PERL_ITHR_THREAD_EXIT_ONLY : 0;
}
diff --git a/handy.h b/handy.h
index e82a644..75080cb 100644
--- a/handy.h
+++ b/handy.h
@@ -327,6 +327,8 @@ and omits the hash parameter.
((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \
(HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), 0))
+#define get_cvs(str, flags) \
+ Perl_get_cvn_flags(aTHX_ STR_WITH_LEN(str), (flags))
/*
=head1 Miscellaneous Functions
diff --git a/mg.c b/mg.c
index 7acff51..c94f50e 100644
--- a/mg.c
+++ b/mg.c
@@ -904,7 +904,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
else if (PL_compiling.cop_warnings == pWARN_ALL) {
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
- HV * const bits=get_hv("warnings::Bits", FALSE);
+ HV * const bits=get_hv("warnings::Bits", 0);
if (bits) {
SV ** const bits_all = hv_fetchs(bits, "all", FALSE);
if (bits_all)
diff --git a/op.c b/op.c
index e32cbdb..5103efb 100644
--- a/op.c
+++ b/op.c
@@ -2338,8 +2338,7 @@ Perl_newPROG(pTHX_ OP *o)
/* Register with debugger */
if (PERLDB_INTER) {
- CV * const cv
- = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("DB::postponed"), 0);
+ CV * const cv = get_cvs("DB::postponed", 0);
if (cv) {
dSP;
PUSHMARK(SP);
diff --git a/os2/os2.c b/os2/os2.c
index 4ebdd50..9448fdc 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -2072,7 +2072,7 @@ os2error(int rc)
dTHX;
ULONG len;
char *s;
- int number = SvTRUE(get_sv("OS2::nsyserror", TRUE));
+ int number = SvTRUE(get_sv("OS2::nsyserror", GV_ADD));
if (!(_emx_env & 0x200)) return ""; /* Nop if not OS/2. */
if (rc == 0)
diff --git a/perl.c b/perl.c
index d02514c..66411ee 100644
--- a/perl.c
+++ b/perl.c
@@ -2415,21 +2415,22 @@ S_run_body(pTHX_ I32 oldscope)
=for apidoc p||get_sv
-Returns the SV of the specified Perl scalar. If C<create> is set and the
-Perl variable does not exist then it will be created. If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the SV of the specified Perl scalar. C<flags> are passed to
+C<gv_fetchpv>. If C<GV_ADD> is set and the
+Perl variable does not exist then it will be created. If C<flags> is zero
+and the variable does not exist then NULL is returned.
=cut
*/
SV*
-Perl_get_sv(pTHX_ const char *name, I32 create)
+Perl_get_sv(pTHX_ const char *name, I32 flags)
{
GV *gv;
PERL_ARGS_ASSERT_GET_SV;
- gv = gv_fetchpv(name, create, SVt_PV);
+ gv = gv_fetchpv(name, flags, SVt_PV);
if (gv)
return GvSV(gv);
return NULL;
@@ -2440,21 +2441,22 @@ Perl_get_sv(pTHX_ const char *name, I32 create)
=for apidoc p||get_av
-Returns the AV of the specified Perl array. If C<create> is set and the
-Perl variable does not exist then it will be created. If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the AV of the specified Perl array. C<flags> are passed to
+C<gv_fetchpv>. If C<GV_ADD> is set and the
+Perl variable does not exist then it will be created. If C<flags> is zero
+and the variable does not exist then NULL is returned.
=cut
*/
AV*
-Perl_get_av(pTHX_ const char *name, I32 create)
+Perl_get_av(pTHX_ const char *name, I32 flags)
{
- GV* const gv = gv_fetchpv(name, create, SVt_PVAV);
+ GV* const gv = gv_fetchpv(name, flags, SVt_PVAV);
PERL_ARGS_ASSERT_GET_AV;
- if (create)
+ if (flags)
return GvAVn(gv);
if (gv)
return GvAV(gv);
@@ -2466,21 +2468,22 @@ Perl_get_av(pTHX_ const char *name, I32 create)
=for apidoc p||get_hv
-Returns the HV of the specified Perl hash. If C<create> is set and the
-Perl variable does not exist then it will be created. If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the HV of the specified Perl hash. C<flags> are passed to
+C<gv_fetchpv>. If C<GV_ADD> is set and the
+Perl variable does not exist then it will be created. If C<flags> is zero
+and the variable does not exist then NULL is returned.
=cut
*/
HV*
-Perl_get_hv(pTHX_ const char *name, I32 create)
+Perl_get_hv(pTHX_ const char *name, I32 flags)
{
- GV* const gv = gv_fetchpv(name, create, SVt_PVHV);
+ GV* const gv = gv_fetchpv(name, flags, SVt_PVHV);
PERL_ARGS_ASSERT_GET_HV;
- if (create)
+ if (flags)
return GvHVn(gv);
if (gv)
return GvHV(gv);
@@ -2526,6 +2529,8 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len,
I32 flags)
return NULL;
}
+/* Nothing in core calls this now, but we can't replace it with a macro and
+ move it to mathoms.c as a macro would evaluate name twice. */
CV*
Perl_get_cv(pTHX_ const char *name, I32 flags)
{
@@ -2584,7 +2589,7 @@ Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
{
PERL_ARGS_ASSERT_CALL_PV;
- return call_sv(MUTABLE_SV(get_cv(sub_name, TRUE)), flags);
+ return call_sv(MUTABLE_SV(get_cv(sub_name, GV_ADD)), flags);
}
/*
@@ -3067,7 +3072,7 @@ Perl_moreswitches(pTHX_ const char *s)
PL_rs = newSVpvn(&ch, 1);
}
}
- sv_setsv(get_sv("/", TRUE), PL_rs);
+ sv_setsv(get_sv("/", GV_ADD), PL_rs);
return s + numlen;
}
case 'C':
@@ -3588,7 +3593,7 @@ S_init_main_stash(pTHX)
PL_globalstash = GvHV(gv_fetchpvs("CORE::GLOBAL::", GV_ADDMULTI,
SVt_PVHV));
/* We must init $/ before switches are processed. */
- sv_setpvs(get_sv("/", TRUE), "\n");
+ sv_setpvs(get_sv("/", GV_ADD), "\n");
}
STATIC int
@@ -4561,7 +4566,7 @@ S_init_predump_symbols(pTHX)
GV *tmpgv;
IO *io;
- sv_setpvs(get_sv("\"", TRUE), " ");
+ sv_setpvs(get_sv("\"", GV_ADD), " ");
PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
@@ -4731,7 +4736,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register
char **argv, register
/* touch @F array to prevent spurious warnings 20020415 MJD */
if (PL_minus_a) {
- (void) get_av("main::F", TRUE | GV_ADDMULTI);
+ (void) get_av("main::F", GV_ADD | GV_ADDMULTI);
}
}
diff --git a/perlio.c b/perlio.c
index 5db65b9..b935734 100644
--- a/perlio.c
+++ b/perlio.c
@@ -807,7 +807,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int
load)
} else {
SV * const pkgsv = newSVpvs("PerlIO");
SV * const layer = newSVpvn(name, len);
- CV * const cv = Perl_get_cvn_flags(aTHX_
STR_WITH_LEN("PerlIO::Layer::NoWarnings"), 0);
+ CV * const cv = get_cvs("PerlIO::Layer::NoWarnings", 0);
ENTER;
SAVEINT(PL_in_load_module);
if (cv) {
diff --git a/pod/perl5005delta.pod b/pod/perl5005delta.pod
index 39646b6..6420f87 100644
--- a/pod/perl5005delta.pod
+++ b/pod/perl5005delta.pod
@@ -101,7 +101,7 @@ If you see a compiler error that talks about the variable
C<thr> not
being declared (when building a module that has XS code), you need
to add C<dTHR;> at the beginning of the block that elicited the error.
-The API function C<perl_get_sv("@",FALSE)> should be used instead of
+The API function C<perl_get_sv("@",GV_ADD)> should be used instead of
directly accessing perl globals as C<GvSV(errgv)>. The API call is
backward compatible with existing perls and provides source compatibility
with threading is enabled.
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 8c3e6d6..fc51e14 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -354,13 +354,14 @@ Found in file av.c
=item get_av
X<get_av>
-Returns the AV of the specified Perl array. If C<create> is set and the
-Perl variable does not exist then it will be created. If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the AV of the specified Perl array. C<flags> are passed to
+C<gv_fetchpv>. If C<GV_ADD> is set and the
+Perl variable does not exist then it will be created. If C<flags> is zero
+and the variable does not exist then NULL is returned.
NOTE: the perl_ form of this function is deprecated.
- AV* get_av(const char* name, I32 create)
+ AV* get_av(const char *name, I32 flags)
=for hackers
Found in file perl.c
@@ -1484,13 +1485,14 @@ Found in file handy.h
=item get_hv
X<get_hv>
-Returns the HV of the specified Perl hash. If C<create> is set and the
-Perl variable does not exist then it will be created. If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the HV of the specified Perl hash. C<flags> are passed to
+C<gv_fetchpv>. If C<GV_ADD> is set and the
+Perl variable does not exist then it will be created. If C<flags> is zero
+and the variable does not exist then NULL is returned.
NOTE: the perl_ form of this function is deprecated.
- HV* get_hv(const char* name, I32 create)
+ HV* get_hv(const char *name, I32 flags)
=for hackers
Found in file perl.c
@@ -3985,13 +3987,14 @@ Found in file universal.c
=item get_sv
X<get_sv>
-Returns the SV of the specified Perl scalar. If C<create> is set and the
-Perl variable does not exist then it will be created. If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the SV of the specified Perl scalar. C<flags> are passed to
+C<gv_fetchpv>. If C<GV_ADD> is set and the
+Perl variable does not exist then it will be created. If C<flags> is zero
+and the variable does not exist then NULL is returned.
NOTE: the perl_ form of this function is deprecated.
- SV* get_sv(const char* name, I32 create)
+ SV* get_sv(const char *name, I32 flags)
=for hackers
Found in file perl.c
@@ -7333,7 +7336,7 @@ sidestepping the normal C order of execution. See C<warn>.
If you want to throw an exception object, assign the object to
C<$@> and then pass C<NULL> to croak():
- errsv = get_sv("@", TRUE);
+ errsv = get_sv("@", GV_ADD);
sv_setsv(errsv, exception_object);
croak(NULL);
diff --git a/pod/perlembed.pod b/pod/perlembed.pod
index 2466531..39364eb 100644
--- a/pod/perlembed.pod
+++ b/pod/perlembed.pod
@@ -325,15 +325,15 @@ the first, a C<float> from the second, and a C<char *>
from the third.
/** Treat $a as an integer **/
eval_pv("$a = 3; $a **= 2", TRUE);
- printf("a = %d\n", SvIV(get_sv("a", FALSE)));
+ printf("a = %d\n", SvIV(get_sv("a", 0)));
/** Treat $a as a float **/
eval_pv("$a = 3.14; $a **= 2", TRUE);
- printf("a = %f\n", SvNV(get_sv("a", FALSE)));
+ printf("a = %f\n", SvNV(get_sv("a", 0)));
/** Treat $a as a string **/
eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
- printf("a = %s\n", SvPV_nolen(get_sv("a", FALSE)));
+ printf("a = %s\n", SvPV_nolen(get_sv("a", 0)));
perl_destruct(my_perl);
perl_free(my_perl);
@@ -457,7 +457,7 @@ been wrapped here):
retval = my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
- *string = get_sv("string", FALSE);
+ *string = get_sv("string", 0);
return SvIV(retval);
}
@@ -480,7 +480,7 @@ been wrapped here):
my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
- *match_list = get_av("array", FALSE);
+ *match_list = get_av("array", 0);
num_matches = av_len(*match_list) + 1; /** assume $[ is 0 **/
return num_matches;
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 3ce60d0..6408e87 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -191,7 +191,7 @@ have "magic". See L<Magic Virtual Tables> later in this
document.
If you know the name of a scalar variable, you can get a pointer to its SV
by using the following:
- SV* get_sv("package::varname", FALSE);
+ SV* get_sv("package::varname", 0);
This returns NULL if the variable does not exist.
@@ -367,7 +367,7 @@ then nothing is done.
If you know the name of an array variable, you can get a pointer to its AV
by using the following:
- AV* get_av("package::varname", FALSE);
+ AV* get_av("package::varname", 0);
This returns NULL if the variable does not exist.
@@ -442,7 +442,7 @@ specified below.
If you know the name of a hash variable, you can get a pointer to its HV
by using the following:
- HV* get_hv("package::varname", FALSE);
+ HV* get_hv("package::varname", 0);
This returns NULL if the variable does not exist.
@@ -667,9 +667,9 @@ to write:
To create a new Perl variable with an undef value which can be accessed from
your Perl script, use the following routines, depending on the variable type.
- SV* get_sv("package::varname", TRUE);
- AV* get_av("package::varname", TRUE);
- HV* get_hv("package::varname", TRUE);
+ SV* get_sv("package::varname", GV_ADD);
+ AV* get_av("package::varname", GV_ADD);
+ HV* get_hv("package::varname", GV_ADD);
Notice the use of TRUE as the second parameter. The new variable can now
be set, using the routines appropriate to the data type.
@@ -878,7 +878,7 @@ following code:
extern int dberror;
extern char *dberror_list;
- SV* sv = get_sv("dberror", TRUE);
+ SV* sv = get_sv("dberror", GV_ADD);
sv_setiv(sv, (IV) dberror);
sv_setpv(sv, dberror_list[dberror]);
SvIOK_on(sv);
diff --git a/pp_ctl.c b/pp_ctl.c
index 799683d..f118d57 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1778,7 +1778,7 @@ PP(pp_caller)
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
SV **bits_all;
- HV * const bits = get_hv("warnings::Bits", FALSE);
+ HV * const bits = get_hv("warnings::Bits", 0);
if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
mask = newSVsv(*bits_all);
}
@@ -2575,7 +2575,7 @@ PP(pp_goto)
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
Perl_get_db_sub(aTHX_ NULL, cv);
if (PERLDB_GOTO) {
- CV * const gotocv = get_cv("DB::goto", FALSE);
+ CV * const gotocv = get_cvs("DB::goto", 0);
if (gotocv) {
PUSHMARK( PL_stack_sp );
call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG);
@@ -3098,7 +3098,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32
seq)
/* Register with debugger: */
if (PERLDB_INTER && saveop && saveop->op_type == OP_REQUIRE) {
- CV * const cv = get_cv("DB::postponed", FALSE);
+ CV * const cv = get_cvs("DB::postponed", 0);
if (cv) {
dSP;
PUSHMARK(SP);
diff --git a/proto.h b/proto.h
index a0dfbbf..dd927fa 100644
--- a/proto.h
+++ b/proto.h
@@ -2424,17 +2424,17 @@ PERL_CALLCONV I32 Perl_eval_sv(pTHX_ SV* sv, I32
flags)
#define PERL_ARGS_ASSERT_EVAL_SV \
assert(sv)
-PERL_CALLCONV SV* Perl_get_sv(pTHX_ const char* name, I32 create)
+PERL_CALLCONV SV* Perl_get_sv(pTHX_ const char *name, I32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_GET_SV \
assert(name)
-PERL_CALLCONV AV* Perl_get_av(pTHX_ const char* name, I32 create)
+PERL_CALLCONV AV* Perl_get_av(pTHX_ const char *name, I32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_GET_AV \
assert(name)
-PERL_CALLCONV HV* Perl_get_hv(pTHX_ const char* name, I32 create)
+PERL_CALLCONV HV* Perl_get_hv(pTHX_ const char *name, I32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_GET_HV \
assert(name)
diff --git a/symbian/symbian_utils.cpp b/symbian/symbian_utils.cpp
index b3eee0b..e6483ef 100644
--- a/symbian/symbian_utils.cpp
+++ b/symbian/symbian_utils.cpp
@@ -171,7 +171,7 @@ extern "C" {
} else {
buf8.Format(_L8("Symbian error %d"), error);
}
- SV* sv = Perl_get_sv(aTHX_ "\005", TRUE); /* $^E or ${^OS_ERROR} */
+ SV* sv = Perl_get_sv(aTHX_ "\005", GV_ADD); /* $^E or ${^OS_ERROR} */
if (!sv)
return (char*)NullErr;
sv_setpv(sv, (const char *)buf8.PtrZ());
diff --git a/utf8.c b/utf8.c
index 8243793..4f4c3ea 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1498,7 +1498,7 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN
*lenp,
if (special && (uv1 == 0xDF || uv1 > 0xFF)) {
/* It might be "special" (sometimes, but not always,
* a multicharacter mapping) */
- HV * const hv = get_hv(special, FALSE);
+ HV * const hv = get_hv(special, 0);
SV **svp;
if (hv &&
diff --git a/util.c b/util.c
index 86c06f5..521a8c2 100644
--- a/util.c
+++ b/util.c
@@ -1454,7 +1454,7 @@ sidestepping the normal C order of execution. See C<warn>.
If you want to throw an exception object, assign the object to
C<$@> and then pass C<NULL> to croak():
- errsv = get_sv("@", TRUE);
+ errsv = get_sv("@", GV_ADD);
sv_setsv(errsv, exception_object);
croak(NULL);
--
Perl5 Master Repository
