From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 24 Jan 2005 13:14:21 +0000 (+0000)
Subject: Revert change 23843.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=27bcc0a7e6b15b7b0d6f632d5f31918abd005ef4;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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";