summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2005-01-24 13:14:21 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2005-01-24 13:14:21 +0000
commit27bcc0a7e6b15b7b0d6f632d5f31918abd005ef4 (patch)
tree8913aaf5a774174e598e6054220156d83eeb467b
parent141db969318ed8140b5af01514c043bc7f710dc3 (diff)
downloadperl-27bcc0a7e6b15b7b0d6f632d5f31918abd005ef4.tar.gz
Revert change 23843.
(See discussion for bug [perl #31924]) p4raw-id: //depot/perl@23873
-rw-r--r--embed.fnc1
-rw-r--r--embed.h2
-rw-r--r--global.sym1
-rw-r--r--hv.c45
-rw-r--r--hv.h3
-rw-r--r--pod/perlapi.pod19
-rw-r--r--pp_ctl.c10
-rw-r--r--proto.h1
-rwxr-xr-xt/comp/require.t18
9 files changed, 13 insertions, 87 deletions
diff --git a/embed.fnc b/embed.fnc
index b3418f7734..795f3fe6c5 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -271,7 +271,6 @@ Apd |SV* |hv_delete_ent |HV* tb|SV* key|I32 flags|U32 hash
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
diff --git a/embed.h b/embed.h
index f85de5e643..d5c5e4018a 100644
--- a/embed.h
+++ b/embed.h
@@ -327,7 +327,6 @@
#define hv_exists Perl_hv_exists
#define hv_exists_ent Perl_hv_exists_ent
#define hv_fetch Perl_hv_fetch
-#define hv_fetch_flags Perl_hv_fetch_flags
#define hv_fetch_ent Perl_hv_fetch_ent
#define hv_free_ent Perl_hv_free_ent
#define hv_iterinit Perl_hv_iterinit
@@ -2935,7 +2934,6 @@
#define hv_exists(a,b,c) Perl_hv_exists(aTHX_ a,b,c)
#define hv_exists_ent(a,b,c) Perl_hv_exists_ent(aTHX_ a,b,c)
#define hv_fetch(a,b,c,d) Perl_hv_fetch(aTHX_ a,b,c,d)
-#define hv_fetch_flags(a,b,c,d,e) Perl_hv_fetch_flags(aTHX_ a,b,c,d,e)
#define hv_fetch_ent(a,b,c,d) Perl_hv_fetch_ent(aTHX_ a,b,c,d)
#define hv_free_ent(a,b) Perl_hv_free_ent(aTHX_ a,b)
#define hv_iterinit(a) Perl_hv_iterinit(aTHX_ a)
diff --git a/global.sym b/global.sym
index dcb5594c6f..43c4d4440a 100644
--- a/global.sym
+++ b/global.sym
@@ -145,7 +145,6 @@ Perl_hv_delete_ent
Perl_hv_exists
Perl_hv_exists_ent
Perl_hv_fetch
-Perl_hv_fetch_flags
Perl_hv_fetch_ent
Perl_hv_free_ent
Perl_hv_iterinit
diff --git a/hv.c b/hv.c
index 8270c97dd2..bb8cef6e0d 100644
--- a/hv.c
+++ b/hv.c
@@ -186,7 +186,6 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
#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
@@ -338,46 +337,6 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
}
/*
-=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>
@@ -734,9 +693,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
}
- } else if (HeVAL(entry) == &PL_sv_placeholder
- && !(action & HV_FETCH_PLACEHOLDER))
- {
+ } else if (HeVAL(entry) == &PL_sv_placeholder) {
/* if we find a placeholder, we pretend we haven't found
anything */
break;
diff --git a/hv.h b/hv.h
index e66a42d9cf..81044c9097 100644
--- a/hv.h
+++ b/hv.h
@@ -318,9 +318,6 @@ C<SV*>.
/* 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)
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 8da393e4e9..f2fa8d9b62 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -1196,25 +1196,6 @@ information on how to use this function on tied hashes.
=for hackers
Found in file hv.c
-=item 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.
-
-NOTE: this function is experimental and may change or be
-removed without notice.
-
- SV** hv_fetch_flags(HV* tb, const char* key, I32 klen, I32 lval, I32 flags)
-
-=for hackers
-Found in file hv.c
-
=item hv_iterinit
Prepares a starting point to traverse a hash table. Returns the number of
diff --git a/pp_ctl.c b/pp_ctl.c
index 684677520d..829b655f1d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1469,7 +1469,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
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_placeholder, 0);
+ &PL_sv_undef, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
@@ -2941,7 +2941,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
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_placeholder, 0);
+ &PL_sv_undef, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
}
@@ -3083,10 +3083,8 @@ PP(pp_require)
DIE(aTHX_ "Null filename used");
TAINT_PROPER("require");
if (PL_op->op_type == OP_REQUIRE &&
- (svp = hv_fetch_flags(GvHVn(PL_incgv), name, len, 0,
- HV_FETCH_WANTPLACEHOLDERS)))
- {
- if (*svp != &PL_sv_placeholder)
+ (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
+ if (*svp != &PL_sv_undef)
RETPUSHYES;
else
DIE(aTHX_ "Compilation failed in require");
diff --git a/proto.h b/proto.h
index 616249013c..f99ab1c8c4 100644
--- a/proto.h
+++ b/proto.h
@@ -250,7 +250,6 @@ PERL_CALLCONV SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash)
PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen);
PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash);
PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, I32 klen, I32 lval);
-PERL_CALLCONV SV** Perl_hv_fetch_flags(pTHX_ HV* tb, const char* key, I32 klen, I32 lval, I32 flags);
PERL_CALLCONV HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash);
PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry);
PERL_CALLCONV I32 Perl_hv_iterinit(pTHX_ HV* tb);
diff --git a/t/comp/require.t b/t/comp/require.t
index 5d861d24ec..29f5436df7 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -11,9 +11,8 @@ $i = 1;
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 43;
-my $ebcdic_utf8_skips = 3;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= $ebcdic_utf8_skips; }
+my $total_tests = 44;
+if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 41; }
print "1..$total_tests\n";
sub do_require {
@@ -123,6 +122,8 @@ for my $expected_compile (1,0) {
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
@@ -132,6 +133,9 @@ do_require "1)\n";
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' };
@@ -140,19 +144,13 @@ print "# $@\nnot " unless $@ =~ /Compilation failed/i;
print "ok ",$i++,"\n";
print "not " unless -e $flag_file;
print "ok ",$i++,"\n";
-# [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 "not " unless exists $INC{'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
my $x = "ok $i\n";