Revert change 23843.

(See discussion for bug [perl #31924])

p4raw-id: //depot/perl@23873

diff --git a/embed.fnc b/embed.fnc
index b3418f7..795f3fe 100644 (file)
--- 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 f85de5e..d5c5e40 100644 (file)
--- 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 dcb5594..43c4d44 100644 (file)
--- 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 8270c97..bb8cef6 100644 (file)
--- 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 e66a42d..81044c9 100644 (file)
--- 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 8da393e..f2fa8d9 100644 (file)
--- 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 6846775..829b655 100644 (file)
--- 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 6162490..f99ab1c 100644 (file)
--- 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 5d861d2..29f5436 100755 (executable)
--- 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";