Change 30196 by [EMAIL PROTECTED] on 2007/02/10 19:13:38
Integrate (ish):
[ 26374]
Fix for [perl #37886] strict 'refs' doesn't apply inside defined
[ 29900]
defined @$foo and defined %$bar should be subject to strict 'refs';
[ 29905]
Refactor the common soft-reference code from pp_rv2sv and pp_rv2av
into a single routine Perl_softref2xv(). As soft references are
rarely used compared with true references, move this code from pp_hot.c
[ 29907]
Remove register keyword from dSP; (at least for now)
[ 30195]
These casts to GV are no longer needed.
but preserve the current behaviour of allowing defined $$foo, @$bar
and %$baz to be exempt from strict refs, because somebody out there
is bound to be using it.
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#206 integrate
... //depot/maint-5.8/perl/embed.h#154 integrate
... //depot/maint-5.8/perl/lib/DBM_Filter.pm#2 integrate
... //depot/maint-5.8/perl/pp.c#134 edit
... //depot/maint-5.8/perl/pp.h#22 integrate
... //depot/maint-5.8/perl/pp_hot.c#130 integrate
... //depot/maint-5.8/perl/proto.h#198 integrate
... //depot/maint-5.8/perl/t/lib/strict/refs#3 edit
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#206 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#205~30181~ 2007-02-09 09:20:56.000000000 -0800
+++ perl/embed.fnc 2007-02-10 11:13:38.000000000 -0800
@@ -1175,6 +1175,10 @@
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
sR |SV* |refto |NN SV* sv
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \
+ |const U32 type|NN SV ***spp
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
s |I32 |unpack_rec |NN struct tempsym* symptr|NN const char *s \
==== //depot/maint-5.8/perl/embed.h#154 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#153~30181~ 2007-02-09 09:20:56.000000000 -0800
+++ perl/embed.h 2007-02-10 11:13:38.000000000 -0800
@@ -1183,6 +1183,8 @@
#define refto S_refto
#endif
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define unpack_rec S_unpack_rec
@@ -3280,6 +3282,10 @@
#define refto(a) S_refto(aTHX_ a)
#endif
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#endif
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define unpack_rec(a,b,c,d,e) S_unpack_rec(aTHX_ a,b,c,d,e)
==== //depot/maint-5.8/perl/lib/DBM_Filter.pm#2 (text) ====
Index: perl/lib/DBM_Filter.pm
--- perl/lib/DBM_Filter.pm#1~22231~ 2004-01-27 12:35:31.000000000 -0800
+++ perl/lib/DBM_Filter.pm 2007-02-10 11:13:38.000000000 -0800
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
package Tie::Hash ;
@@ -91,6 +91,7 @@
# if $class already contains "::", don't prefix "DBM_Filter::"
$class = "DBM_Filter::$class" unless $class =~ /::/;
+ no strict 'refs';
# does the "DBM_Filter::$class" exist?
if ( ! defined %{ "${class}::"} ) {
# Nope, so try to load it.
@@ -98,7 +99,6 @@
croak "$caller: Cannot Load DBM Filter '$class': $@" if $@;
}
- no strict 'refs';
my $fetch = *{ "${class}::Fetch" }{CODE};
my $store = *{ "${class}::Store" }{CODE};
my $filter = *{ "${class}::Filter" }{CODE};
==== //depot/maint-5.8/perl/pp.c#134 (text) ====
Index: perl/pp.c
--- perl/pp.c#133~30051~ 2007-01-28 13:56:48.000000000 -0800
+++ perl/pp.c 2007-02-10 11:13:38.000000000 -0800
@@ -219,6 +219,45 @@
RETURN;
}
+/* Helper function for pp_rv2sv and pp_rv2av */
+GV *
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
+ SV ***spp)
+{
+ GV *gv;
+
+ if (!SvOK(sv)) {
+ if (PL_op->op_flags & OPf_REF || PL_op->op_private & HINT_STRICT_REFS)
+ Perl_die(aTHX_ PL_no_usym, what);
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit();
+ if (type != SVt_PV && GIMME_V == G_ARRAY) {
+ (*spp)--;
+ return NULL;
+ }
+ **spp = &PL_sv_undef;
+ return NULL;
+ }
+ if ((PL_op->op_flags & OPf_SPECIAL) &&
+ !(PL_op->op_flags & OPf_MOD))
+ {
+ gv = gv_fetchsv(sv, 0, type);
+ if (!gv
+ && (!is_gv_magical_sv(sv,0)
+ || !(gv = gv_fetchsv(sv, GV_ADD, type))))
+ {
+ **spp = &PL_sv_undef;
+ return NULL;
+ }
+ }
+ else {
+ if (PL_op->op_private & HINT_STRICT_REFS)
+ Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+ gv = gv_fetchsv(sv, GV_ADD, type);
+ }
+ return gv;
+}
+
PP(pp_rv2sv)
{
GV *gv = NULL;
@@ -246,30 +285,9 @@
if (SvROK(sv))
goto wasref;
}
- if (!SvOK(sv)) {
- if (PL_op->op_flags & OPf_REF ||
- PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_usym, "a SCALAR");
- if (ckWARN(WARN_UNINITIALIZED))
- report_uninit();
- RETSETUNDEF;
- }
- if ((PL_op->op_flags & OPf_SPECIAL) &&
- !(PL_op->op_flags & OPf_MOD))
- {
- gv = (GV*)gv_fetchsv(sv, 0, SVt_PV);
- if (!gv
- && (!is_gv_magical_sv(sv, 0)
- || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV))))
- {
- RETSETUNDEF;
- }
- }
- else {
- if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR");
- gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV);
- }
+ gv = Perl_softref2xv(aTHX_ sv, "a SCALAR", SVt_PV, &sp);
+ if (!gv)
+ RETURN;
}
sv = GvSVn(gv);
}
==== //depot/maint-5.8/perl/pp.h#22 (text) ====
Index: perl/pp.h
--- perl/pp.h#21~30194~ 2007-02-10 10:07:51.000000000 -0800
+++ perl/pp.h 2007-02-10 11:13:38.000000000 -0800
@@ -73,7 +73,7 @@
#define TOPMARK (*PL_markstack_ptr)
#define POPMARK (*PL_markstack_ptr--)
-#define dSP register SV **sp = PL_stack_sp
+#define dSP SV **sp = PL_stack_sp
#define djSP dSP
#define dMARK register SV **mark = PL_stack_base + POPMARK
#define dORIGMARK const I32 origmark = mark - PL_stack_base
==== //depot/maint-5.8/perl/pp_hot.c#130 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#129~30194~ 2007-02-10 10:07:51.000000000 -0800
+++ perl/pp_hot.c 2007-02-10 11:13:38.000000000 -0800
@@ -776,35 +776,10 @@
if (SvROK(sv))
goto wasref;
}
- if (!SvOK(sv)) {
- if (PL_op->op_flags & OPf_REF ||
- PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_usym, is_pp_rv2av ? an_array : a_hash);
- if (ckWARN(WARN_UNINITIALIZED))
- report_uninit();
- if (gimme == G_ARRAY) {
- SP--;
- RETURN;
- }
- RETSETUNDEF;
- }
- if ((PL_op->op_flags & OPf_SPECIAL) &&
- !(PL_op->op_flags & OPf_MOD))
- {
- gv = (GV*)gv_fetchsv(sv, 0, type);
- if (!gv
- && (!is_gv_magical_sv(sv,0)
- || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
- {
- RETSETUNDEF;
- }
- }
- else {
- if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_symref_sv, sv,
- is_pp_rv2av ? an_array : a_hash);
- gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
- }
+ gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
+ type, &sp);
+ if (!gv)
+ RETURN;
}
else {
gv = (GV*)sv;
==== //depot/maint-5.8/perl/proto.h#198 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#197~30181~ 2007-02-09 09:20:56.000000000 -0800
+++ perl/proto.h 2007-02-10 11:13:38.000000000 -0800
@@ -1706,6 +1706,14 @@
__attribute__warn_unused_result__;
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+PERL_CALLCONV GV* Perl_softref2xv(pTHX_ SV *const sv, const char *const
what, const U32 type, SV ***spp)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_4);
+
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
STATIC I32 S_unpack_rec(pTHX_ struct tempsym* symptr, const char *s, const
char *strbeg, const char *strend, const char **new_s);
==== //depot/maint-5.8/perl/t/lib/strict/refs#3 (text) ====
Index: perl/t/lib/strict/refs
--- perl/t/lib/strict/refs#2~22399~ 2004-02-27 07:23:08.000000000 -0800
+++ perl/t/lib/strict/refs 2007-02-10 11:13:38.000000000 -0800
@@ -301,3 +301,21 @@
/(?{${"foo"}++})/;
EXPECT
Can't use string ("foo") as a SCALAR ref while "strict refs" in use at
(re_eval 1) line 1.
+########
+# [perl #37886] strict 'refs' doesn't apply inside defined (not fixed for
maint)
+use strict 'refs';
+my $x = "foo";
+defined $$x;
+EXPECT
+########
+# [perl #37886] strict 'refs' doesn't apply inside defined (not fixed for
maint)
+use strict 'refs';
+my $x = "foo";
+defined @$x;
+EXPECT
+########
+# [perl #37886] strict 'refs' doesn't apply inside defined (not fixed for
maint)
+use strict 'refs';
+my $x = "foo";
+defined %$x;
+EXPECT
End of Patch.
