summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-10-21 00:54:14 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-10-21 00:54:14 +0000
commit779c5bc9b377ace543a8d55375152f3503319113 (patch)
treef54f44a76f5b98f5b51ba97b65636f9e83e8155d /op.c
parent2ab1b4853ed375afa5dbf2299430175699d0452d (diff)
downloadperl-779c5bc9b377ace543a8d55375152f3503319113.tar.gz
restore sanity to "constant" references
p4raw-id: //depot/perl@2029
Diffstat (limited to 'op.c')
-rw-r--r--op.c40
1 files changed, 39 insertions, 1 deletions
diff --git a/op.c b/op.c
index c04f08256e..f9c9df12be 100644
--- a/op.c
+++ b/op.c
@@ -4450,8 +4450,46 @@ ck_rvconst(register OP *o)
char *name;
int iscv;
GV *gv;
+ SV *kidsv = kid->op_sv;
- name = SvPV(kid->op_sv, PL_na);
+ /* Is it a constant from cv_const_sv()? */
+ if (SvROK(kidsv) && SvREADONLY(kidsv)) {
+ SV *rsv = SvRV(kidsv);
+ int svtype = SvTYPE(rsv);
+ char *badtype = Nullch;
+
+ switch (o->op_type) {
+ case OP_RV2SV:
+ if (svtype > SVt_PVMG)
+ badtype = "a SCALAR";
+ break;
+ case OP_RV2AV:
+ if (svtype != SVt_PVAV)
+ badtype = "an ARRAY";
+ break;
+ case OP_RV2HV:
+ if (svtype != SVt_PVHV) {
+ if (svtype == SVt_PVAV) { /* pseudohash? */
+ SV **ksv = av_fetch((AV*)rsv, 0, FALSE);
+ if (ksv && SvROK(*ksv)
+ && SvTYPE(SvRV(*ksv)) == SVt_PVHV)
+ {
+ break;
+ }
+ }
+ badtype = "a HASH";
+ }
+ break;
+ case OP_RV2CV:
+ if (svtype != SVt_PVCV)
+ badtype = "a CODE";
+ break;
+ }
+ if (badtype)
+ croak("Constant is not %s reference", badtype);
+ return o;
+ }
+ name = SvPV(kidsv, PL_na);
if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
switch (o->op_type) {