New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
%INC caching failure-case problem #7534
Comments
From @nwc10Created by @nwc10This seems to be a problem only in blead: $ echo die >fail.pm I think it's something to do with the code in blead which cached failure The bug seems to need something aggressive such as a die inside the other The code example is real world - it's what you get from lib/if.t if Nicholas Clark Perl Info
|
From rick@bort.caOn Sun, Oct 10, 2004 at 03:38:35PM -0000, Nicholas Clark wrote:
This is because as it is now, failed compiles are cached as PL_sv_undef
Right, because those cases are not cached as failures. The following patch changes the caching placeholder to keys %INC; should only return the names of files successfully loaded. There was no API that I could find to test if a key was in %INC and was I didn't update the require subroutine in perlfunc. I really believe -- Inline Patch--- perl-current/embed.fnc Sun Oct 10 15:41:03 2004
+++ perl-dev/embed.fnc Tue Oct 12 23:07:36 2004
@@ -271,6 +271,7 @@
Apd |bool |hv_exists |HV* tb|const char* key|I32 klen
Apd |bool |hv_exists_ent |HV* tb|SV* key|U32 hash
Apd |SV** |hv_fetch |HV* tb|const char* key|I32 klen|I32 lval
+ApMd |SV** |hv_fetch_flags |HV* tb|const char* key|I32 klen|I32 lval|I32 flags
Apd |HE* |hv_fetch_ent |HV* tb|SV* key|I32 lval|U32 hash
Ap |void |hv_free_ent |HV* hv|HE* entry
Apd |I32 |hv_iterinit |HV* tb
--- perl-current/hv.c Sat Jul 31 12:44:58 2004
+++ perl-dev/hv.c Wed Oct 13 00:29:21 2004
@@ -186,6 +186,7 @@
#define HV_FETCH_ISEXISTS 0x02
#define HV_FETCH_LVALUE 0x04
#define HV_FETCH_JUST_SV 0x08
+#define HV_FETCH_PLACEHOLDER 0x10
/*
=for apidoc hv_store
@@ -337,6 +338,46 @@
}
/*
+=for apidoc hv_fetch_flags
+
+Returns the SV which corresponds to the specified key in the hash.
+See C<hv_fetch>.
+The C<flags> value will normally be zero; if HV_FETCH_WANTPLACEHOLDERS is
+set then placeholders keys (for restricted hashes) will be returned in addition
+to normal keys. By default placeholders are automatically skipped over.
+Currently a placeholder is implemented with a value that is
+C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
+restricted hashes may change.
+
+=cut
+*/
+
+SV**
+Perl_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval,
+ I32 flags)
+{
+ HE *hek;
+ STRLEN klen;
+ int common_flags;
+
+ if (klen_i32 < 0) {
+ klen = -klen_i32;
+ common_flags = HVhek_UTF8;
+ } else {
+ klen = klen_i32;
+ common_flags = 0;
+ }
+ hek = hv_fetch_common (hv, NULL, key, klen, common_flags,
+ ((flags & HV_FETCH_WANTPLACEHOLDERS)
+ ? HV_FETCH_PLACEHOLDER
+ : 0)
+ | HV_FETCH_JUST_SV
+ | (lval ? HV_FETCH_LVALUE : 0),
+ Nullsv, 0);
+ return hek ? &HeVAL(hek) : NULL;
+}
+
+/*
=for apidoc hv_exists_ent
Returns a boolean indicating whether the specified hash key exists. C<hash>
@@ -693,7 +734,9 @@
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
}
- } else if (HeVAL(entry) == &PL_sv_placeholder) {
+ } else if (HeVAL(entry) == &PL_sv_placeholder
+ && !(action & HV_FETCH_PLACEHOLDER))
+ {
/* if we find a placeholder, we pretend we haven't found
anything */
break;
--- perl-current/hv.h Mon Nov 3 03:23:31 2003
+++ perl-dev/hv.h Tue Oct 12 22:59:33 2004
@@ -318,6 +318,9 @@
/* Flags for hv_iternext_flags. */
#define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */
+/* Flags for hv_fetch_flags. */
+#define HV_FETCH_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */
+
/* available as a function in hv.c */
#define Perl_sharepvn(sv, len, hash) HEK_KEY(share_hek(sv, len, hash))
#define sharepvn(sv, len, hash) Perl_sharepvn(sv, len, hash)
--- perl-current/pp_ctl.c Sun Oct 10 15:41:04 2004
+++ perl-dev/pp_ctl.c Tue Oct 12 23:26:28 2004
@@ -1469,7 +1469,7 @@
char* msg = SvPVx(ERRSV, n_a);
SV *nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
- &PL_sv_undef, 0);
+ &PL_sv_placeholder, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
@@ -2949,7 +2949,7 @@
char* msg = SvPVx(ERRSV, n_a);
SV *nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
- &PL_sv_undef, 0);
+ &PL_sv_placeholder, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
@@ -3091,8 +3091,10 @@
DIE(aTHX_ "Null filename used");
TAINT_PROPER("require");
if (PL_op->op_type == OP_REQUIRE &&
- (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
- if (*svp != &PL_sv_undef)
+ (svp = hv_fetch_flags(GvHVn(PL_incgv), name, len, 0,
+ HV_FETCH_WANTPLACEHOLDERS)))
+ {
+ if (*svp != &PL_sv_placeholder)
RETPUSHYES;
else
DIE(aTHX_ "Compilation failed in require");
--- perl-current/t/comp/require.t Wed Aug 4 02:42:46 2004
+++ perl-dev/t/comp/require.t Wed Oct 13 00:34:32 2004
@@ -11,8 +11,9 @@
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 44;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 41; }
+my $total_tests = 43;
+my $ebcdic_utf8_skips = 3;
+if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= $ebcdic_utf8_skips; }
print "1..$total_tests\n";
sub do_require {
@@ -122,8 +123,6 @@
print "ok ",$i++,"\n";
print "not " unless -e $flag_file xor $expected_compile;
print "ok ",$i++,"\n";
- print "not " unless exists $INC{'bleah.pm'};
- print "ok ",$i++,"\n";
}
# compile-time failure in require
@@ -133,9 +132,6 @@
print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi;
print "ok ",$i++,"\n";
-# previous failure cached in %INC
-print "not " unless exists $INC{'bleah.pm'};
-print "ok ",$i++,"\n";
write_file($flag_file, 1);
write_file('bleah.pm', "unlink '$flag_file'; 1");
print "# $@\nnot " if eval { require 'bleah.pm' };
@@ -144,12 +140,18 @@
print "ok ",$i++,"\n";
print "not " unless -e $flag_file;
print "ok ",$i++,"\n";
-print "not " unless exists $INC{'bleah.pm'};
+# [perl #31924]
+eval { $INC{'bleah.pm'} = 'bleah.pm' };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+print "not " unless $INC{'bleah.pm'} eq 'bleah.pm';
print "ok ",$i++,"\n";
# successful require
do_require "1";
print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+print "not " unless $INC{'bleah.pm'} eq 'bleah.pm';
print "ok ",$i++,"\n";
# do FILE shouldn't see any outside lexicals |
The RT System itself - Status changed from 'new' to 'open' |
From @ysthOn Wed, Oct 13, 2004 at 12:40:18PM -0400, Rick Delaney <rick@bort.ca> wrote:
I don't think that's better. If we are going to cache failures, they |
From rick@bort.caOn Wed, Oct 13, 2004 at 10:12:50AM -0700, Yitzchak Scott-Thoennes wrote:
Maybe, but I don't think they need be visible in %INC since they -- |
From @rgsRick Delaney wrote:
I agree with this on principle. However something bugs me in your patch : -- |
From rick@bort.caOn Thu, Oct 14, 2004 at 06:58:41PM +0200, Rafael Garcia-Suarez wrote:
Yes, I actually removed 3 tests I think, all of which were testing that Anyway, since I was the one that originally added those tests I don't -- |
From @ysthOn Thu, Oct 14, 2004 at 06:58:41PM +0200, Rafael Garcia-Suarez <rgarciasuarez@mandrakesoft.com> wrote:
Then perhaps we need a %^NOINC? I really dislike the idea of having |
From @rgsRick Delaney wrote:
Thanks, applied as #23843 to blead.
|
@rgs - Status changed from 'open' to 'resolved' |
From @ysthOn Fri, Jan 21, 2005 at 03:02:46PM +0100, Rafael Garcia-Suarez wrote:
My last try at arguing against this; hereafter I'll stay quiet. system q!echo 'sub foo{"bar"} die'>foo.pl!; prints barbaz without this patch but: with it. I really don't see a way to cache failures in %INC without If this is really, truly, necessary, cache failures in %^NOINC instead |
From rick@bort.caOn Sun, Jan 23, 2005 at 12:14:30AM -0800, Yitzchak Scott-Thoennes wrote:
I think this is a reasonable objection. I'd be happy with it continuing if (lval) { where defer is PL_op->op_private & OPpLVAL_DEFER; and *svp is, of course, &PL_sv_undef. I don't understand the purpose of the defer. Maybe it's possible to fix
I don't have a problem with this either, except that it won't fix the -- |
From @rgsYitzchak Scott-Thoennes wrote:
OK. I've now reverted change 23843.
I don't see the point of caching failures in yet another special variable |
From rick@bort.caOn Mon, Jan 24, 2005 at 02:42:43PM +0100, Rafael Garcia-Suarez wrote:
I think the point would be that require() would start checking %^NOINC. die "Compilation failed in require" if $^NOINC{$file}; I originally considered implementing it this way but didn't know how to But now I think it should stay the way it is (caching as undef) and this # Is $file loaded? # Force reload of $file: -- |
Migrated from rt.perl.org#31924 (status was 'resolved')
Searchable as RT31924$
The text was updated successfully, but these errors were encountered: