In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/5e196316f76f6f3ce68647b65f6a2609b286674b?hp=5b2ef88ec2b538ad872eb354160909d8bd529aa7>
- Log -----------------------------------------------------------------
commit 5e196316f76f6f3ce68647b65f6a2609b286674b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Aug 4 23:24:18 2016 -0700
Add Chris Travers to AUTHORS
M AUTHORS
commit 458470f62360040dcd4b5a55c8ba07503e1af5fc
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Aug 4 23:23:09 2016 -0700
[perl #128769] Improve base.pm @INC . message
The new version is based on one written by Chris Travers, polished
up a bit by yours truly.
M dist/base/lib/base.pm
M dist/base/t/incdot.t
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 1 +
dist/base/lib/base.pm | 9 ++++++--
dist/base/t/incdot.t | 2 +-
embed.fnc | 2 +-
embed.h | 2 +-
gv.c | 63 ++++++++++++++++++++++++---------------------------
proto.h | 2 +-
7 files changed, 41 insertions(+), 40 deletions(-)
diff --git a/AUTHORS b/AUTHORS
index e3dc53a..3fbbc9c 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -235,6 +235,7 @@ Chris Lightfoot <ch...@ex-parrot.com>
Chris Nandor <pu...@pobox.com>
Chris Pepper
Chris R. Donnelly <chris.donne...@vauto.com>
+Chris Travers <chris.trav...@gmail.com>
Chris Tubutis <ch...@broadband.att.com>
Chris Wick <cw...@lmc.com>
Chris Williams <chr...@netinfo.com.au>
diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm
index c7f9963..38c91c7 100644
--- a/dist/base/lib/base.pm
+++ b/dist/base/lib/base.pm
@@ -122,8 +122,13 @@ Base class package "$base" is empty.
ERROR
if ($dotty && -e $fn) {
$e .= <<ERROS;
- If you mean to load $fn from the current directory, you may
- want to try "use lib '.'".
+ The file $fn does exist in the current directory. But note
+ that base.pm, when loading a module, now ignores the current working
+ directory if it is the last entry in \@INC. If your software worked on
+ previous versions of Perl, the best solution is to use FindBin to
+ detect the path properly and to add that path to \@INC. As a last
+ resort, you can re-enable looking in the current working directory by
+ adding "use lib '.'" to your code.
ERROS
}
$e =~ s/\n\z/)\n/;
diff --git a/dist/base/t/incdot.t b/dist/base/t/incdot.t
index fadebc4..1619492 100644
--- a/dist/base/t/incdot.t
+++ b/dist/base/t/incdot.t
@@ -15,5 +15,5 @@ like $@, qr/\@INC contains: $inc\).\)/,
'Error does not list final dot in @INC (or mention use lib)';
eval { 'base'->import('t::lib::Dummy') };
like $@, qr<\@INC contains: $inc\).\n(?x:
- ) If you mean to load t/lib/Dummy\.pm from the current >,
+ ) The file t/lib/Dummy\.pm does exist in the current direct>,
'special cur dir message for existing files in . that are ignored';
diff --git a/embed.fnc b/embed.fnc
index baa15b2..f2e48ab 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1933,7 +1933,7 @@ s |bool|find_default_stash|NN HV **stash|NN const char
*name \
|STRLEN len|const U32 is_utf8|const I32 add \
|const svtype sv_type
s |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \
- |STRLEN len|bool addmg \
+ |STRLEN len \
|const svtype sv_type
s |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type
s |bool|gv_is_in_main|NN const char *name|STRLEN len \
diff --git a/embed.h b/embed.h
index 930ea91..7b4efff 100644
--- a/embed.h
+++ b/embed.h
@@ -1538,7 +1538,7 @@
#define gv_fetchmeth_internal(a,b,c,d,e,f) S_gv_fetchmeth_internal(aTHX_
a,b,c,d,e,f)
#define gv_init_svtype(a,b) S_gv_init_svtype(aTHX_ a,b)
#define gv_is_in_main(a,b,c) S_gv_is_in_main(aTHX_ a,b,c)
-#define gv_magicalize(a,b,c,d,e,f) S_gv_magicalize(aTHX_ a,b,c,d,e,f)
+#define gv_magicalize(a,b,c,d,e) S_gv_magicalize(aTHX_ a,b,c,d,e)
#define gv_magicalize_isa(a) S_gv_magicalize_isa(aTHX_ a)
#define gv_stashpvn_internal(a,b,c) S_gv_stashpvn_internal(aTHX_ a,b,c)
#define gv_stashsvpvn_cached(a,b,c,d) S_gv_stashsvpvn_cached(aTHX_ a,b,c,d)
diff --git a/gv.c b/gv.c
index 0fd789d..e24a193 100644
--- a/gv.c
+++ b/gv.c
@@ -1312,7 +1312,6 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const
char * name,
load_module, so save it. For the
moment itâs always a single char. */
const SV * const target = varname == '[' ? GvSV(gv) : (SV *)GvHV(gv);
- SV * const namesv = newSVpvn(name, len);
PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
@@ -1326,27 +1325,26 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv,
const char * name,
dSP;
ENTER;
- SAVEFREESV(namesv);
#define HV_FETCH_TIE_FUNC (GV **)hv_fetch(stash, "_tie_it", 7, 0)
/* Load the module if it is not loaded. */
- if (!(stash = gv_stashsv(namesv, 0))
+ if (!(stash = gv_stashpvn(name, len, 0))
|| !(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
{
- SV *module = newSVsv(namesv);
+ SV * const module = newSVpvn(name, len);
const char type = varname == '[' ? '$' : '%';
if ( flags & 1 )
save_scalar(gv);
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
assert(sp == PL_stack_sp);
- stash = gv_stashsv(namesv, 0);
+ stash = gv_stashpvn(name, len, 0);
if (!stash)
- Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not
available",
- type, varname, SVfARG(namesv));
+ Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not
available",
+ type, varname, name);
else if (!(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
- Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not
define _tie_it",
- type, varname, SVfARG(namesv));
+ Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define
_tie_it",
+ type, varname, name);
}
/* Now call the tie function. It should be in *gvp. */
assert(gvp); assert(*gvp); assert(GvCV(*gvp));
@@ -1356,7 +1354,6 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const
char * name,
call_sv((SV *)*gvp, G_VOID|G_DISCARD);
LEAVE;
}
- else SvREFCNT_dec_NN(namesv);
}
/*
@@ -1817,15 +1814,14 @@ S_find_default_stash(pTHX_ HV **stash, const char
*name, STRLEN len,
* Note that it does not insert the GV into the stash prior to
* magicalization, which some variables require need in order
* to work (like $[, %+, %-, %!), so callers must take care of
- * that beforehand.
+ * that.
*
- * The return value has a specific meaning for gv_fetchpvn_flags:
- * If it returns true, and the gv is empty, it indicates that its
- * refcount should be decreased.
+ * It returns true if the gv did turn out to be magical one; i.e.,
+ * if gv_magicalize actually did something.
*/
PERL_STATIC_INLINE bool
S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
- bool addmg, const svtype sv_type)
+ const svtype sv_type)
{
SSize_t paren;
@@ -1862,7 +1858,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char
*name, STRLEN len,
default:
goto try_core;
}
- return addmg;
+ goto ret;
}
try_core:
if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
@@ -2013,7 +2009,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char
*name, STRLEN len,
this test */
UV uv;
if (!grok_atoUV(name, &uv, NULL) || uv > I32_MAX)
- return addmg;
+ goto ret;
/* XXX why are we using a SSize_t? */
paren = (SSize_t)(I32)uv;
goto storeparen;
@@ -2189,7 +2185,13 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char
*name, STRLEN len,
}
}
- return addmg;
+ ret:
+ /* Return true if we actually did something. */
+ return GvAV(gv) || GvHV(gv) || GvIO(gv) || GvCV(gv)
+ || ( GvSV(gv) && (
+ SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv))
+ )
+ );
}
/* If we do ever start using this later on in the file, we need to make
@@ -2352,29 +2354,22 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN
full_len, I32 flags,
if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) )
GvMULTI_on(gv) ;
-#define GvEMPTY(gv) !(GvAV(gv) || GvHV(gv) || GvIO(gv) \
- || GvCV(gv) || (GvSV(gv) && SvOK(GvSV(gv))))
-
/* set up magic where warranted */
- if ( gv_magicalize(gv, stash, name, len, addmg, sv_type) ) {
+ if ( gv_magicalize(gv, stash, name, len, sv_type) ) {
/* See 23496c6 */
- if (GvEMPTY(gv)) {
- if ( GvSV(gv) && SvMAGICAL(GvSV(gv)) ) {
- /* The GV was and still is "empty", except that now
- * it has the magic flags turned on, so we want it
+ if (addmg) {
+ /* gv_magicalize magicalised this gv, so we want it
* stored in the symtab.
+ * Effectively the caller is asking, âDoes this gv exist?â
+ * And we respond, âEr, *now* it does!â
*/
(void)hv_store(stash,name,len,(SV *)gv,0);
- }
- else {
- /* Most likely the temporary GV created above */
+ }
+ }
+ else if (addmg) {
+ /* The temporary GV created above */
SvREFCNT_dec_NN(gv);
gv = NULL;
- }
- }
- else
- /* Not empty; this means gv_magicalize magicalised it. */
- (void)hv_store(stash,name,len,(SV *)gv,0);
}
if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
diff --git a/proto.h b/proto.h
index 3cdb21c..f047e46 100644
--- a/proto.h
+++ b/proto.h
@@ -4308,7 +4308,7 @@ STATIC void S_gv_init_svtype(pTHX_ GV *gv, const
svtype sv_type);
STATIC bool S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32
is_utf8);
#define PERL_ARGS_ASSERT_GV_IS_IN_MAIN \
assert(name)
-STATIC bool S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name,
STRLEN len, bool addmg, const svtype sv_type);
+STATIC bool S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name,
STRLEN len, const svtype sv_type);
#define PERL_ARGS_ASSERT_GV_MAGICALIZE \
assert(gv); assert(stash); assert(name)
STATIC void S_gv_magicalize_isa(pTHX_ GV *gv);
--
Perl5 Master Repository
