diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1998-10-21 00:54:14 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-10-21 00:54:14 +0000 |
commit | 779c5bc9b377ace543a8d55375152f3503319113 (patch) | |
tree | f54f44a76f5b98f5b51ba97b65636f9e83e8155d /op.c | |
parent | 2ab1b4853ed375afa5dbf2299430175699d0452d (diff) | |
download | perl-779c5bc9b377ace543a8d55375152f3503319113.tar.gz |
restore sanity to "constant" references
p4raw-id: //depot/perl@2029
Diffstat (limited to 'op.c')
-rw-r--r-- | op.c | 40 |
1 files changed, 39 insertions, 1 deletions
@@ -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) { |