This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Propagate const/mutable/not into the SvPV call for retrieving an
authorNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2005 14:08:00 +0000 (14:08 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2005 14:08:00 +0000 (14:08 +0000)
overloaded value.

p4raw-id: //depot/perl@24801

sv.c

diff --git a/sv.c b/sv.c
index 81f407c..8575157 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3441,8 +3441,22 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
             register const char *typestr;
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-               /* FIXME - figure out best way to pass context inwards.  */
-                char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+               /* Unwrap this:  */
+               /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */
+
+                char *pv;
+               if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+                   if (flags & SV_CONST_RETURN) {
+                       pv = (char *) SvPVX_const(tmpstr);
+                   } else {
+                       pv = (flags & SV_MUTABLE_RETURN)
+                           ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+                   }
+                   if (lp)
+                       *lp = SvCUR(tmpstr);
+               } else {
+                   pv = sv_2pv_flags(tmpstr, lp, flags);
+               }
                 if (SvUTF8(tmpstr))
                     SvUTF8_on(sv);
                 else