This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixes coredump introduced by 11755 and 11790. Thanks to Doug for
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index f31855b..3457353 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5507,13 +5507,19 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     register STDCHAR *bp;
     register I32 cnt;
     I32 i = 0;
+    I32 rspara = 0;
 
     SV_CHECK_THINKFIRST(sv);
     (void)SvUPGRADE(sv, SVt_PV);
 
     SvSCREAM_off(sv);
 
-    if (RsSNARF(PL_rs)) {
+    if (PL_curcop == &PL_compiling) {
+       /* we always read code in line mode */
+       rsptr = "\n";
+       rslen = 1;
+    }
+    else if (RsSNARF(PL_rs)) {
        rsptr = NULL;
        rslen = 0;
     }
@@ -5545,6 +5551,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     else if (RsPARA(PL_rs)) {
        rsptr = "\n\n";
        rslen = 2;
+       rspara = 1;
     }
     else {
        /* Get $/ i.e. PL_rs into same encoding as stream wants */
@@ -5563,7 +5570,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 
     rslast = rslen ? rsptr[rslen - 1] : '\0';
 
-    if (RsPARA(PL_rs)) {               /* have to do this both before and after */
+    if (rspara) {              /* have to do this both before and after */
        do {                    /* to make sure file boundaries work right */
            if (PerlIO_eof(fp))
                return 0;
@@ -5769,7 +5776,7 @@ screamer2:
        }
     }
 
-    if (RsPARA(PL_rs)) {               /* have to do this both before and after */
+    if (rspara) {              /* have to do this both before and after */
         while (i != EOF) {     /* to make sure file boundaries work right */
            i = PerlIO_getc(fp);
            if (i != '\n') {
@@ -6721,6 +6728,19 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
     return sv_2pv(sv, lp);
 }
 
+/* For -DCRIPPLED_CC only. See also C<sv_2pv_flags()>.
+ */
+
+char *
+Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
+{
+    if (SvPOK(sv)) {
+       *lp = SvCUR(sv);
+       return SvPVX(sv);
+    }
+    return sv_2pv_flags(sv, lp, 0);
+}
+
 /*
 =for apidoc sv_pvn_force
 
@@ -7651,8 +7671,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        char c;
        int i;
        unsigned base = 0;
-       IV iv;
-       UV uv;
+       IV iv = 0;
+       UV uv = 0;
        NV nv;
        STRLEN have;
        STRLEN need;
@@ -7942,13 +7962,15 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                if (!veclen)
                    continue;
                if (vec_utf)
-                   iv = (IV)utf8n_to_uvchr(vecstr, veclen, &ulen, 0);
+                   uv = utf8n_to_uvchr(vecstr, veclen, &ulen, UTF8_ALLOW_ANYUV);
                else {
-                   iv = *vecstr;
+                   uv = *vecstr;
                    ulen = 1;
                }
                vecstr += ulen;
                veclen -= ulen;
+               if (plus)
+                    esignbuf[esignlen++] = plus;
            }
            else if (args) {
                switch (intsize) {
@@ -7973,14 +7995,17 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #endif
                }
            }
-           if (iv >= 0) {
-               uv = iv;
-               if (plus)
-                   esignbuf[esignlen++] = plus;
-           }
-           else {
-               uv = -iv;
-               esignbuf[esignlen++] = '-';
+           if ( !vectorize )   /* we already set uv above */
+           {
+               if (iv >= 0) {
+                   uv = iv;
+                   if (plus)
+                       esignbuf[esignlen++] = plus;
+               }
+               else {
+                   uv = -iv;
+                   esignbuf[esignlen++] = '-';
+               }
            }
            base = 10;
            goto integer;
@@ -8022,7 +8047,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                if (!veclen)
                    continue;
                if (vec_utf)
-                   uv = utf8n_to_uvchr(vecstr, veclen, &ulen, 0);
+                   uv = utf8n_to_uvchr(vecstr, veclen, &ulen, UTF8_ALLOW_ANYUV);
                else {
                    uv = *vecstr;
                    ulen = 1;
@@ -9783,12 +9808,18 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     {
        I32 len = av_len((AV*)proto_perl->Iregex_padav);
        SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
-       for(i = 0; i <= len; i++) {                             
-           av_push(PL_regex_padav,
-            SvREFCNT_inc(
-                        newSViv((IV)re_dup((REGEXP *)
-                             SvIVX(regexen[i]), param))
-                    ));
+       av_push(PL_regex_padav,
+               sv_dup_inc(regexen[0],param));
+       for(i = 1; i <= len; i++) {
+            if(SvREPADTMP(regexen[i])) {
+             av_push(PL_regex_padav, sv_dup_inc(regexen[i], param));
+            } else { 
+               av_push(PL_regex_padav,
+                    SvREFCNT_inc(
+                        newSViv(PTR2IV(re_dup(INT2PTR(REGEXP *, 
+                             SvIVX(regexen[i])), param)))
+                       ));
+           }
        }
     }
     PL_regex_pad = AvARRAY(PL_regex_padav);
@@ -9826,6 +9857,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_curstname       = sv_dup_inc(proto_perl->Icurstname, param);
 
     PL_beginav         = av_dup_inc(proto_perl->Ibeginav, param);
+    PL_beginav_save    = av_dup_inc(proto_perl->Ibeginav_save, param);
     PL_endav           = av_dup_inc(proto_perl->Iendav, param);
     PL_checkav         = av_dup_inc(proto_perl->Icheckav, param);
     PL_initav          = av_dup_inc(proto_perl->Iinitav, param);
@@ -9881,6 +9913,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     else
        PL_exitlist     = (PerlExitListEntry*)NULL;
     PL_modglobal       = hv_dup_inc(proto_perl->Imodglobal, param);
+    PL_custom_op_names  = hv_dup_inc(proto_perl->Icustom_op_names,param);
+    PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
 
     PL_profiledata     = NULL;
     PL_rsfp            = fp_dup(proto_perl->Irsfp, '<');
@@ -10155,7 +10189,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_tainted         = proto_perl->Ttainted;
     PL_curpm           = proto_perl->Tcurpm;   /* XXX No PMOP ref count */
-    PL_nrs             = sv_dup_inc(proto_perl->Tnrs, param);
     PL_rs              = sv_dup_inc(proto_perl->Trs, param);
     PL_last_in_gv      = gv_dup(proto_perl->Tlast_in_gv, param);
     PL_ofs_sv          = sv_dup_inc(proto_perl->Tofs_sv, param);