diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-01-24 13:14:21 +0000 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-01-24 13:14:21 +0000 |
commit | 27bcc0a7e6b15b7b0d6f632d5f31918abd005ef4 (patch) | |
tree | 8913aaf5a774174e598e6054220156d83eeb467b | |
parent | 141db969318ed8140b5af01514c043bc7f710dc3 (diff) | |
download | perl-27bcc0a7e6b15b7b0d6f632d5f31918abd005ef4.tar.gz |
Revert change 23843.
(See discussion for bug [perl #31924])
p4raw-id: //depot/perl@23873
-rw-r--r-- | embed.fnc | 1 | ||||
-rw-r--r-- | embed.h | 2 | ||||
-rw-r--r-- | global.sym | 1 | ||||
-rw-r--r-- | hv.c | 45 | ||||
-rw-r--r-- | hv.h | 3 | ||||
-rw-r--r-- | pod/perlapi.pod | 19 | ||||
-rw-r--r-- | pp_ctl.c | 10 | ||||
-rw-r--r-- | proto.h | 1 | ||||
-rwxr-xr-x | t/comp/require.t | 18 |
9 files changed, 13 insertions, 87 deletions
@@ -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 @@ -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 @@ -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; @@ -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 @@ -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"); @@ -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"; |