Porting/Maintainers.pl
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 02b4d02..e5f7bea 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -354,7 +354,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 #ifdef DEBUGGING
        SvREFCNT(sv) = 0;
 #endif
-       /* Must always set typemask because it's awlays checked in on cleanup
+       /* Must always set typemask because it's always checked in on cleanup
           when the arenas are walked looking for objects.  */
        SvFLAGS(sv) = SVTYPEMASK;
        sv++;
@@ -467,7 +467,8 @@ do_clean_named_objs(pTHX_ SV *sv)
             SvOBJECT(GvSV(sv))) ||
             (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
             (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
-            (GvIO(sv) && GvIOp(sv) && SvOBJECT(GvIO(sv))) ||  /* In certain rare cases GvIOP(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+            /* In certain rare cases GvIOp(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+            (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) ||
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
@@ -3622,9 +3623,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                /* and won't be needed again, potentially */
              !(PL_op && PL_op->op_type == OP_AASSIGN))
 #ifdef PERL_OLD_COPY_ON_WRITE
-            && !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
-                && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
-                 && SvTYPE(sstr) >= SVt_PVIV)
+            && ((flags & SV_COW_SHARED_HASH_KEYS)
+               ? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
+                    && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
+                    && SvTYPE(sstr) >= SVt_PVIV))
+               : 1)
 #endif
             ) {
             /* Failed the swipe test, and it's not a shared hash key either.
@@ -5394,7 +5397,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
 
        if (PL_utf8cache) {
            STRLEN ulen;
-           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
+           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
 
            if (mg && mg->mg_len != -1) {
                ulen = mg->mg_len;
@@ -7056,11 +7059,11 @@ Perl_newSVhek(pTHX_ const HEK *hek)
 
 Creates a new SV with its SvPVX_const pointing to a shared string in the string
 table. If the string does not already exist in the table, it is created
-first.  Turns on READONLY and FAKE.  The string's hash is stored in the UV
-slot of the SV; if the C<hash> parameter is non-zero, that value is used;
-otherwise the hash is computed.  The idea here is that as the string table
-is used for shared hash keys these strings will have SvPVX_const == HeKEY and
-hash lookup will avoid string compare.
+first.  Turns on READONLY and FAKE. If the C<hash> parameter is non-zero, that
+value is used; otherwise the hash is computed. The string's hash can be later
+be retrieved from the SV with the C<SvSHARED_HASH()> macro. The idea here is
+that as the string table is used for shared hash keys these strings will have
+SvPVX_const == HeKEY and hash lookup will avoid string compare.
 
 =cut
 */
@@ -7213,7 +7216,7 @@ Perl_newSVuv(pTHX_ UV u)
 /*
 =for apidoc newSV_type
 
-Creates a new SV, of the type specificied.  The reference count for the new SV
+Creates a new SV, of the type specified.  The reference count for the new SV
 is set to 1.
 
 =cut
@@ -9191,7 +9194,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                : SvNV(argsv);
 
            need = 0;
-           if (c != 'e' && c != 'E') {
+           /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
+              else. frexp() has some unspecified behaviour for those three */
+           if (c != 'e' && c != 'E' && (nv * 0) == 0) {
                i = PERL_INT_MIN;
                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
                   will cast our (long double) to (double) */
@@ -9492,7 +9497,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 All the macros and functions in this section are for the private use of
 the main function, perl_clone().
 
-The foo_dup() functions make an exact copy of an existing foo thinngy.
+The foo_dup() functions make an exact copy of an existing foo thingy.
 During the course of a cloning, a hash table is used to map old addresses
 to new addresses. The table is created and manipulated with the
 ptr_table_* functions.
@@ -10903,6 +10908,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
+    PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
@@ -10937,6 +10943,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
+    PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
@@ -11162,7 +11169,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_sub_generation  = proto_perl->Isub_generation;
     PL_isarev          = hv_dup_inc(proto_perl->Iisarev, param);
-    PL_delayedisa      = hv_dup_inc(proto_perl->Idelayedisa, param);
 
     /* funky return mechanisms */
     PL_forkprocess     = proto_perl->Iforkprocess;
@@ -11265,11 +11271,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_runops          = proto_perl->Irunops;
 
-#ifdef CSH
-    PL_cshlen          = proto_perl->Icshlen;
-    PL_cshname         = proto_perl->Icshname; /* XXX never deallocated */
-#endif
-
     PL_parser          = parser_dup(proto_perl->Iparser, param);
 
     PL_subline         = proto_perl->Isubline;
@@ -12073,6 +12074,11 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
        match = 1; /* XS or custom code could trigger random warnings */
        goto do_op;
 
+    case OP_POS:
+       /* def-ness of rval pos() is independent of the def-ness of its arg */
+       if ( !(obase->op_flags & OPf_MOD))
+           break;
+
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))