This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate changes#6392,6394..6399,6401..6404
authorHugo van der Sanden <hv@crypt.org>
Thu, 13 Jul 2000 19:27:13 +0000 (20:27 +0100)
committerGurusamy Sarathy <gsar@cpan.org>
Mon, 20 Nov 2000 17:31:55 +0000 (17:31 +0000)
       The {multiplier} of a fixed substring was overlooked which
       caused a wrong initial search offset for that substring.

       Subject: [PATCH 5.6.0] Re: [ID 20000613.001] Regex works in v5.005_03 but fails in v5.06
       Message-Id: <200007131827.TAA14487@crypt.compulink.co.uk>
       Date: Thu, 13 Jul 2000 19:27:13 +0100

       Fix the BOM bug: not a byteorder bug, a signedness bug.

       Replace change #6337 with a better one.

       Subject: Re: [PATCH] [ID 20000701.002] Regular Expressions Not Unsetting $1 Vars When Backtracking
       From: Hugo <hv@crypt.compulink.co.uk>
       Date: Fri, 14 Jul 2000 04:16:20 +0100
       Message-Id: <200007140316.EAA15857@crypt.compulink.co.uk>

       MakeMaker should not remove editor backups (*~) on `make clean`
       by default (completes change#6383)

       move new variables to the end of the interpreter structure (for
       bincompat in code that doesn't #include XSUB.h)

       rename totally bletcherous SvLOCK() thingy (doesn't do what the
       name suggests anyway)

       various cleanups (typos, misformatted code, and small bugs)

       typecasts needed for change#6394

       typos in change#6399, regen headers

       inconsistent types needs casts

       PERL_OBJECT build tweaks

p4raw-link: @6404 on //depot/perl: 6e3aabd614ca77aec0b07c2811e8d104cc5690f3
p4raw-link: @6401 on //depot/perl: c60d5571b477c5e30d135bb2704d752cb04465a3
p4raw-link: @6399 on //depot/perl: 01ec43d06089361423d61a40521883bf73e1944a
p4raw-link: @6394 on //depot/cfgperl: 78ae23f54fc4e301b66d2a32897cb42fa2633fe7
p4raw-link: @6392 on //depot/cfgperl: 2a8d968921bf85a89f4bb388b94f9acdd8b1f27f
p4raw-link: @6383 on //depot/perl: 56acea6ff1302cdf8b9d387cd3766c26e5146dca
p4raw-link: @6337 on //depot/cfgperl: f06a1d4e6ae96bf8af49f0ef1c79f500d8de0143

p4raw-id: //depot/maint-5.6/perl@7780
p4raw-integrated: from //depot/cfgperl@7779 'copy in' global.sym
(@6307..) regexec.c (@6337..) 'edit in' t/op/re_tests (@6392..)
'ignore' MANIFEST (@6372..) 'merge in' regcomp.c (@6241..)
p4raw-integrated: from //depot/cfgperl@6394 'edit in' embed.pl proto.h
(@6307..) toke.c (@6390..)
p4raw-integrated: from //depot/perl@7779 'copy in'
ext/IPC/SysV/Makefile.PL (@6383..)
p4raw-integrated: from //depot/perl@6404 'edit in' toke.c (@6403..)
p4raw-integrated: from //depot/perl@6402 'copy in' pod/perlapi.pod
(@6359..) embedvar.h perlapi.h (@6366..) embed.h (@6369..)
'edit in' doop.c (@6399..) proto.h (@6400..)
p4raw-integrated: from //depot/perl@6399 'copy in' pp.c (@6369..) 'edit
in' embed.pl (@6369..) 'merge in' op.c (@6369..) mg.c (@6373..)
p4raw-integrated: from //depot/perl@6398 'copy in' sv.h thread.h
(@6369..) 'merge in' util.c (@6369..)
p4raw-integrated: from //depot/perl@6397 'copy in' intrpvar.h (@6347..)
p4raw-integrated: from //depot/perl@6396 'copy in'
lib/ExtUtils/MM_Unix.pm (@6148..)

21 files changed:
doop.c
embed.h
embed.pl
embedvar.h
ext/IPC/SysV/Makefile.PL
global.sym
intrpvar.h
lib/ExtUtils/MM_Unix.pm
mg.c
op.c
perlapi.h
pod/perlapi.pod
pp.c
proto.h
regcomp.c
regexec.c
sv.h
t/op/re_tests
thread.h
toke.c
util.c

diff --git a/doop.c b/doop.c
index d5f80f5..bb8de1a 100644 (file)
--- a/doop.c
+++ b/doop.c
 #include <signal.h>
 #endif
 
-
-#define HALF_UPGRADE(start,end) {                                    \
-                                U8* newstr;                          \
-                                STRLEN len;                          \
-                                len = end-start;                     \
-                                newstr = bytes_to_utf8(start, &len); \
-                                Copy(newstr,start,len,U8*);          \
-                                end = start + len;                   \
-                                }
+#define HALF_UPGRADE(start,end) \
+    STMT_START {                               \
+       U8* NeWsTr;                             \
+       STRLEN LeN = (end) - (start);           \
+       NeWsTr = bytes_to_utf8(start, &LeN);    \
+       Copy(NeWsTr,start,LeN,U8*);             \
+       end = (start) + LeN;                    \
+    } STMT_END
 
 
 STATIC I32
@@ -53,14 +52,15 @@ S_do_trans_simple(pTHX_ SV *sv)
 
     /* First, take care of non-UTF8 input strings, because they're easy */
     if (!sutf) {
-    while (s < send) {
+       while (s < send) {
            if ((ch = tbl[*s]) >= 0) {
-               matches++;
-                *s++ = ch;
-            } else
-       s++;
-        }
-    SvSETMAGIC(sv);
+               matches++;
+               *s++ = ch;
+           }
+           else
+               s++;
+       }
+       SvSETMAGIC(sv);
         return matches;
     }
 
@@ -81,12 +81,13 @@ S_do_trans_simple(pTHX_ SV *sv)
             else         
                 d = uv_to_utf8(d,ch);
             s += ulen;
-        } else { /* No match -> copy */
+        }
+       else { /* No match -> copy */
             while (ulen--)
                 *d++ = *s++;
         }
     }
-    *d='\0';
+    *d = '\0';
     sv_setpvn(sv, (const char*)dstart, d - dstart);
     SvUTF8_on(sv);
     SvLEN_set(sv, 2*len+1);
@@ -114,7 +115,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 
     while (s < send) {
         if (hasutf && *s & 0x80)
-            s+=UTF8SKIP(s);
+            s += UTF8SKIP(s);
         else {
             UV c;
             I32 ulen;
@@ -125,7 +126,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
                 c = *s;
             if (c < 0x100 && tbl[c] >= 0)
                 matches++;
-            s+=ulen;
+            s += ulen;
         }
     }
 
@@ -158,7 +159,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 
        while (s < send) {
             if (hasutf && *s & 0x80)
-                s+=UTF8SKIP(s);
+                s += UTF8SKIP(s);
             else {
                if ((ch = tbl[*s]) >= 0) {
                    *d = ch;
@@ -168,7 +169,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
                    else
                        p = d++;
                }
-               else if (ch == -1)              /* -1 is unmapped character */
+               else if (ch == -1)      /* -1 is unmapped character */
                    *d++ = *s;          /* -2 is delete character */
                s++;
             }
@@ -177,20 +178,20 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
     else {
        while (s < send) {
             if (hasutf && *s & 0x80)
-                s+=UTF8SKIP(s);
+                s += UTF8SKIP(s);
             else {
                if ((ch = tbl[*s]) >= 0) {
                    *d = ch;
                    matches++;
                    d++;
                }
-               else if (ch == -1)              /* -1 is unmapped character */
+               else if (ch == -1)      /* -1 is unmapped character */
                    *d++ = *s;          /* -2 is delete character */
                s++;
             }
        }
     }
-    matches += send - d;       /* account for disappeared chars */
+    matches += send - d;               /* account for disappeared chars */
     *d = '\0';
     SvCUR_set(sv, d - (U8*)SvPVX(sv));
     SvSETMAGIC(sv);
@@ -236,13 +237,13 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
        if ((uv = swash_fetch(rv, s)) < none) {
            s += UTF8SKIP(s);
            matches++;
-            if (uv & 0x80 && !isutf++)
+            if ((uv & 0x80) && !isutf++)
                 HALF_UPGRADE(dstart,d);
            d = uv_to_utf8(d, uv);
        }
        else if (uv == none) {
            int i;
-        i = UTF8SKIP(s);
+           i = UTF8SKIP(s);
             if (i > 1 && !isutf++)
                 HALF_UPGRADE(dstart,d);
            while(i--)
@@ -250,7 +251,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
        }
        else if (uv == extra) {
            int i;
-        i = UTF8SKIP(s);
+           i = UTF8SKIP(s);
            s += i;
            matches++;
             if (i > 1 && !isutf++) 
@@ -349,32 +350,32 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
            if (uv < none) {
                matches++;
                if (uv != puv) {
-                    if (uv & 0x80 && !isutf++) 
+                    if ((uv & 0x80) && !isutf++) 
                         HALF_UPGRADE(dst,d);
-                       d = uv_to_utf8(d, uv);
+                   d = uv_to_utf8(d, uv);
                    puv = uv;
                }
                    s += UTF8SKIP(s);
                continue;
            }
            else if (uv == none) {      /* "none" is unmapped character */
-                       I32 ulen;
-                       *d++ = (U8)utf8_to_uv(s, &ulen);
-                       s += ulen;
+               I32 ulen;
+               *d++ = (U8)utf8_to_uv(s, &ulen);
+               s += ulen;
                puv = 0xfeedface;
                continue;
            }
            else if (uv == extra && !del) {
                matches++;
                if (uv != puv) {
-                       d = uv_to_utf8(d, final);
+                   d = uv_to_utf8(d, final);
                    puv = final;
                }
-                   s += UTF8SKIP(s);
+               s += UTF8SKIP(s);
                continue;
            }
-           matches++;          /* "none+1" is delete character */
-               s += UTF8SKIP(s);
+           matches++;                  /* "none+1" is delete character */
+           s += UTF8SKIP(s);
        }
     }
     else {
@@ -394,24 +395,24 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
            }
            if (uv < none) {
                matches++;
-                   d = uv_to_utf8(d, uv);
-                   s += UTF8SKIP(s);
+               d = uv_to_utf8(d, uv);
+               s += UTF8SKIP(s);
                continue;
            }
            else if (uv == none) {      /* "none" is unmapped character */
-                       I32 ulen;
-                       *d++ = (U8)utf8_to_uv(s, &ulen);
-                       s += ulen;
+               I32 ulen;
+               *d++ = (U8)utf8_to_uv(s, &ulen);
+               s += ulen;
                continue;
            }
            else if (uv == extra && !del) {
                matches++;
-                   d = uv_to_utf8(d, final);
-                   s += UTF8SKIP(s);
+               d = uv_to_utf8(d, final);
+               s += UTF8SKIP(s);
                continue;
            }
-           matches++;          /* "none+1" is delete character */
-               s += UTF8SKIP(s);
+           matches++;                  /* "none+1" is delete character */
+           s += UTF8SKIP(s);
        }
     }
     if (dst)
@@ -448,19 +449,19 @@ Perl_do_trans(pTHX_ SV *sv)
 
     switch (PL_op->op_private & ~hasutf & 63) {
     case 0:
-    if (hasutf)
-        return do_trans_simple_utf8(sv);
-    else
-        return do_trans_simple(sv);
+       if (hasutf)
+           return do_trans_simple_utf8(sv);
+       else
+           return do_trans_simple(sv);
 
     case OPpTRANS_IDENTICAL:
-    if (hasutf)
-        return do_trans_count_utf8(sv);
-    else
-        return do_trans_count(sv);
+       if (hasutf)
+           return do_trans_count_utf8(sv);
+       else
+           return do_trans_count(sv);
 
     default:
-    if (hasutf)
+       if (hasutf)
            return do_trans_complex_utf8(sv);
        else
            return do_trans_complex(sv);
diff --git a/embed.h b/embed.h
index 928be19..2969d86 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define cv_dump                        S_cv_dump
 #define cv_clone2              S_cv_clone2
 #define scalar_mod_type                S_scalar_mod_type
-#define method_2entersub       S_method_2entersub
 #define my_kid                 S_my_kid
 #define dup_attrlist           S_dup_attrlist
 #define apply_attrs            S_apply_attrs
 #define cv_dump(a)             S_cv_dump(aTHX_ a)
 #define cv_clone2(a,b)         S_cv_clone2(aTHX_ a,b)
 #define scalar_mod_type(a,b)   S_scalar_mod_type(aTHX_ a,b)
-#define method_2entersub(a,b,c)        S_method_2entersub(aTHX_ a,b,c)
 #define my_kid(a,b)            S_my_kid(aTHX_ a,b)
 #define dup_attrlist(a)                S_dup_attrlist(aTHX_ a)
 #define apply_attrs(a,b,c)     S_apply_attrs(aTHX_ a,b,c)
 #define cv_clone2              S_cv_clone2
 #define S_scalar_mod_type      CPerlObj::S_scalar_mod_type
 #define scalar_mod_type                S_scalar_mod_type
-#define S_method_2entersub     CPerlObj::S_method_2entersub
-#define method_2entersub       S_method_2entersub
 #define S_my_kid               CPerlObj::S_my_kid
 #define my_kid                 S_my_kid
 #define S_dup_attrlist         CPerlObj::S_dup_attrlist
index 2b75a49..0b4c545 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1375,7 +1375,7 @@ Ap        |bool   |Gv_AMupdate    |HV* stash
 p      |OP*    |append_elem    |I32 optype|OP* head|OP* tail
 p      |OP*    |append_list    |I32 optype|LISTOP* first|LISTOP* last
 p      |I32    |apply          |I32 type|SV** mark|SV** sp
-Afp    |void   |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len
+A    |void   |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len
 Ap     |SV*    |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash
 Ap     |bool   |avhv_exists_ent|AV *ar|SV* keysv|U32 hash
 Ap     |SV**   |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash
@@ -2474,7 +2474,7 @@ s |char*  |scan_trans     |char *start
 s      |char*  |scan_word      |char *s|char *dest|STRLEN destlen \
                                |int allow_package|STRLEN *slp
 s      |char*  |skipspace      |char *s
-s      |char*  |swallow_bom    |char *s
+s      |char*  |swallow_bom    |U8 *s
 s      |void   |checkcomma     |char *s|char *name|char *what
 s      |void   |force_ident    |char *s|int kind
 s      |void   |incline        |char *s
index 3bd98d1..10339b2 100644 (file)
 #define PL_exitlistlen         (PERL_GET_INTERP->Iexitlistlen)
 #define PL_expect              (PERL_GET_INTERP->Iexpect)
 #define PL_fdpid               (PERL_GET_INTERP->Ifdpid)
+#define PL_fdpid_mutex         (PERL_GET_INTERP->Ifdpid_mutex)
 #define PL_filemode            (PERL_GET_INTERP->Ifilemode)
 #define PL_forkprocess         (PERL_GET_INTERP->Iforkprocess)
 #define PL_formfeed            (PERL_GET_INTERP->Iformfeed)
 #define PL_subname             (PERL_GET_INTERP->Isubname)
 #define PL_sv_arenaroot                (PERL_GET_INTERP->Isv_arenaroot)
 #define PL_sv_count            (PERL_GET_INTERP->Isv_count)
+#define PL_sv_lock_mutex       (PERL_GET_INTERP->Isv_lock_mutex)
 #define PL_sv_mutex            (PERL_GET_INTERP->Isv_mutex)
 #define PL_sv_no               (PERL_GET_INTERP->Isv_no)
 #define PL_sv_objcount         (PERL_GET_INTERP->Isv_objcount)
 #define PL_exitlistlen         (vTHX->Iexitlistlen)
 #define PL_expect              (vTHX->Iexpect)
 #define PL_fdpid               (vTHX->Ifdpid)
+#define PL_fdpid_mutex         (vTHX->Ifdpid_mutex)
 #define PL_filemode            (vTHX->Ifilemode)
 #define PL_forkprocess         (vTHX->Iforkprocess)
 #define PL_formfeed            (vTHX->Iformfeed)
 #define PL_subname             (vTHX->Isubname)
 #define PL_sv_arenaroot                (vTHX->Isv_arenaroot)
 #define PL_sv_count            (vTHX->Isv_count)
+#define PL_sv_lock_mutex       (vTHX->Isv_lock_mutex)
 #define PL_sv_mutex            (vTHX->Isv_mutex)
 #define PL_sv_no               (vTHX->Isv_no)
 #define PL_sv_objcount         (vTHX->Isv_objcount)
 #define PL_exitlistlen         (aTHXo->interp.Iexitlistlen)
 #define PL_expect              (aTHXo->interp.Iexpect)
 #define PL_fdpid               (aTHXo->interp.Ifdpid)
+#define PL_fdpid_mutex         (aTHXo->interp.Ifdpid_mutex)
 #define PL_filemode            (aTHXo->interp.Ifilemode)
 #define PL_forkprocess         (aTHXo->interp.Iforkprocess)
 #define PL_formfeed            (aTHXo->interp.Iformfeed)
 #define PL_subname             (aTHXo->interp.Isubname)
 #define PL_sv_arenaroot                (aTHXo->interp.Isv_arenaroot)
 #define PL_sv_count            (aTHXo->interp.Isv_count)
+#define PL_sv_lock_mutex       (aTHXo->interp.Isv_lock_mutex)
 #define PL_sv_mutex            (aTHXo->interp.Isv_mutex)
 #define PL_sv_no               (aTHXo->interp.Isv_no)
 #define PL_sv_objcount         (aTHXo->interp.Isv_objcount)
 #define PL_Iexitlistlen                PL_exitlistlen
 #define PL_Iexpect             PL_expect
 #define PL_Ifdpid              PL_fdpid
+#define PL_Ifdpid_mutex                PL_fdpid_mutex
 #define PL_Ifilemode           PL_filemode
 #define PL_Iforkprocess                PL_forkprocess
 #define PL_Iformfeed           PL_formfeed
 #define PL_Isubname            PL_subname
 #define PL_Isv_arenaroot       PL_sv_arenaroot
 #define PL_Isv_count           PL_sv_count
+#define PL_Isv_lock_mutex      PL_sv_lock_mutex
 #define PL_Isv_mutex           PL_sv_mutex
 #define PL_Isv_no              PL_sv_no
 #define PL_Isv_objcount                PL_sv_objcount
index b87f179..f994950 100644 (file)
@@ -13,7 +13,7 @@ sub MY::libscan
  return '' 
        if($path =~ m:/(RCS|CVS|SCCS)/: ||
           $path =~ m:[~%]$: ||
-          $path =~ m:(\.(orig|rej)|~)$:
+          $path =~ m:\.(orig|rej)$:
          );
  
  $path;
index 719e50a..6ee8fc4 100644 (file)
@@ -21,6 +21,7 @@ Perl_get_context
 Perl_set_context
 Perl_amagic_call
 Perl_Gv_AMupdate
+Perl_apply_attrs_string
 Perl_avhv_delete_ent
 Perl_avhv_exists_ent
 Perl_avhv_fetch_ent
@@ -185,6 +186,7 @@ Perl_to_uni_upper_lc
 Perl_to_uni_title_lc
 Perl_to_uni_lower_lc
 Perl_is_utf8_char
+Perl_is_utf8_string
 Perl_is_utf8_alnum
 Perl_is_utf8_alnumc
 Perl_is_utf8_idfirst
@@ -460,6 +462,8 @@ Perl_utf16_to_utf8
 Perl_utf16_to_utf8_reversed
 Perl_utf8_distance
 Perl_utf8_hop
+Perl_utf8_to_bytes
+Perl_bytes_to_utf8
 Perl_utf8_to_uv
 Perl_uv_to_utf8
 Perl_warn
@@ -543,3 +547,4 @@ Perl_ptr_table_fetch
 Perl_ptr_table_store
 Perl_ptr_table_split
 Perl_sys_intern_clear
+Perl_sys_intern_init
index d686413..f84de79 100644 (file)
@@ -140,10 +140,6 @@ PERLVAR(Iforkprocess,      int)            /* so do_open |- can return proc# */
 /* subprocess state */
 PERLVAR(Ifdpid,                AV *)           /* keep fd-to-pid mappings for my_popen */
 
-#ifdef USE_THREADS
-PERLVAR(Ifdpid_mutex,  perl_mutex)     /* mutex for fdpid array */
-#endif
-
 /* internal state */
 PERLVAR(Itainting,     bool)           /* doing taint checks */
 PERLVARI(Iop_mask,     char *, NULL)   /* masked operations for safe evals */
@@ -250,29 +246,17 @@ PERLVAR(Isighandlerp,     Sighandler_t)
 
 PERLVAR(Ixiv_arenaroot,        XPV*)           /* list of allocated xiv areas */
 PERLVAR(Ixiv_root,     IV *)           /* free xiv list */
-PERLVAR(Ixnv_arenaroot,        XPV*)           /* list of allocated xnv areas */
 PERLVAR(Ixnv_root,     NV *)           /* free xnv list */
-PERLVAR(Ixrv_arenaroot,        XPV*)           /* list of allocated xrv areas */
 PERLVAR(Ixrv_root,     XRV *)          /* free xrv list */
-PERLVAR(Ixpv_arenaroot,        XPV*)           /* list of allocated xpv areas */
 PERLVAR(Ixpv_root,     XPV *)          /* free xpv list */
-PERLVAR(Ixpviv_arenaroot,XPVIV*)       /* list of allocated xpviv areas */
 PERLVAR(Ixpviv_root,   XPVIV *)        /* free xpviv list */
-PERLVAR(Ixpvnv_arenaroot,XPVNV*)       /* list of allocated xpvnv areas */
 PERLVAR(Ixpvnv_root,   XPVNV *)        /* free xpvnv list */
-PERLVAR(Ixpvcv_arenaroot,XPVCV*)       /* list of allocated xpvcv areas */
 PERLVAR(Ixpvcv_root,   XPVCV *)        /* free xpvcv list */
-PERLVAR(Ixpvav_arenaroot,XPVAV*)       /* list of allocated xpvav areas */
 PERLVAR(Ixpvav_root,   XPVAV *)        /* free xpvav list */
-PERLVAR(Ixpvhv_arenaroot,XPVHV*)       /* list of allocated xpvhv areas */
 PERLVAR(Ixpvhv_root,   XPVHV *)        /* free xpvhv list */
-PERLVAR(Ixpvmg_arenaroot,XPVMG*)       /* list of allocated xpvmg areas */
 PERLVAR(Ixpvmg_root,   XPVMG *)        /* free xpvmg list */
-PERLVAR(Ixpvlv_arenaroot,XPVLV*)       /* list of allocated xpvlv areas */
 PERLVAR(Ixpvlv_root,   XPVLV *)        /* free xpvlv list */
-PERLVAR(Ixpvbm_arenaroot,XPVBM*)       /* list of allocated xpvbm areas */
 PERLVAR(Ixpvbm_root,   XPVBM *)        /* free xpvbm list */
-PERLVAR(Ihe_arenaroot, XPV*)           /* list of allocated he areas */
 PERLVAR(Ihe_root,      HE *)           /* free he list */
 PERLVAR(Inice_chunk,   char *)         /* a nice chunk of memory to reuse */
 PERLVAR(Inice_chunk_size,      U32)    /* how nice the chunk of memory is */
@@ -460,8 +444,26 @@ PERLVAR(IProc,             struct IPerlProc*)
 PERLVAR(Iptr_table,    PTR_TBL_t*)
 #endif
 
-#if defined(USE_THREADS)
-PERLVAR(Isv_lock_mutex,        perl_mutex)     /* Mutex for SvLOCK macro */
+#ifdef USE_THREADS
+PERLVAR(Ifdpid_mutex,  perl_mutex)     /* mutex for fdpid array */
+PERLVAR(Isv_lock_mutex,        perl_mutex)     /* mutex for SvLOCK macro */
 #endif
 
 PERLVAR(Inullstash,    HV *)           /* illegal symbols end up here */
+
+PERLVAR(Ixnv_arenaroot,        XPV*)           /* list of allocated xnv areas */
+PERLVAR(Ixrv_arenaroot,        XPV*)           /* list of allocated xrv areas */
+PERLVAR(Ixpv_arenaroot,        XPV*)           /* list of allocated xpv areas */
+PERLVAR(Ixpviv_arenaroot,XPVIV*)       /* list of allocated xpviv areas */
+PERLVAR(Ixpvnv_arenaroot,XPVNV*)       /* list of allocated xpvnv areas */
+PERLVAR(Ixpvcv_arenaroot,XPVCV*)       /* list of allocated xpvcv areas */
+PERLVAR(Ixpvav_arenaroot,XPVAV*)       /* list of allocated xpvav areas */
+PERLVAR(Ixpvhv_arenaroot,XPVHV*)       /* list of allocated xpvhv areas */
+PERLVAR(Ixpvmg_arenaroot,XPVMG*)       /* list of allocated xpvmg areas */
+PERLVAR(Ixpvlv_arenaroot,XPVLV*)       /* list of allocated xpvlv areas */
+PERLVAR(Ixpvbm_arenaroot,XPVBM*)       /* list of allocated xpvbm areas */
+PERLVAR(Ihe_arenaroot, XPV*)           /* list of allocated he areas */
+
+/* New variables must be added to the very end for binary compatibility.
+ * XSUB.h provides wrapper functions via perlapi.h that make this
+ * irrelevant, but not all code may be expected to #include XSUB.h. */
index 65b0bd9..8e337d9 100644 (file)
@@ -457,7 +457,7 @@ EOT
     push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all
                         perlmain.c mon.out core core.*perl.*.?
                         *perl.core so_locations pm_to_blib
-                        *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe
+                        *$(OBJ_EXT) *$(LIB_EXT) perl.exe
                         $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def
                         $(BASEEXT).exp
                        ]);
diff --git a/mg.c b/mg.c
index a9b0cc9..b2e194e 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -614,7 +614,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            {
                i = t1 - s1;
                s = rx->subbeg + s1;
-                if (!rx->subbeg)
+               if (!rx->subbeg)
                    break;
 
              getrx:
diff --git a/op.c b/op.c
index df729de..32a9a27 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2683,7 +2683,9 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        if (!squash) {
                if (t == r ||
                    (tlen == rlen && memEQ((char *)t, (char *)r, tlen)))
+               {
                    o->op_private |= OPpTRANS_IDENTICAL;
+               }
        }
 
        while (t < tend || tfirst <= tlast) {
index de0e7cc..c57d575 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -230,6 +230,8 @@ START_EXTERN_C
 #define PL_expect              (*Perl_Iexpect_ptr(aTHXo))
 #undef  PL_fdpid
 #define PL_fdpid               (*Perl_Ifdpid_ptr(aTHXo))
+#undef  PL_fdpid_mutex
+#define PL_fdpid_mutex         (*Perl_Ifdpid_mutex_ptr(aTHXo))
 #undef  PL_filemode
 #define PL_filemode            (*Perl_Ifilemode_ptr(aTHXo))
 #undef  PL_forkprocess
@@ -494,6 +496,8 @@ START_EXTERN_C
 #define PL_sv_arenaroot                (*Perl_Isv_arenaroot_ptr(aTHXo))
 #undef  PL_sv_count
 #define PL_sv_count            (*Perl_Isv_count_ptr(aTHXo))
+#undef  PL_sv_lock_mutex
+#define PL_sv_lock_mutex       (*Perl_Isv_lock_mutex_ptr(aTHXo))
 #undef  PL_sv_mutex
 #define PL_sv_mutex            (*Perl_Isv_mutex_ptr(aTHXo))
 #undef  PL_sv_no
index 2896951..effbda4 100644 (file)
@@ -1913,6 +1913,9 @@ Returns the size of the string buffer in the SV.  See C<SvCUR>.
 
        STRLEN  SvLEN(SV* sv)
 
+=for hackers
+Found in file sv.h
+
 =item SvNIOK
 
 Returns a boolean indicating whether the SV contains a number, integer or
@@ -2332,6 +2335,9 @@ Found in file sv.h
 
 Type flag for blessed scalars.  See C<svtype>.
 
+=for hackers
+Found in file sv.h
+
 =item SvUPGRADE
 
 Used to upgrade an SV to a more complex form.  Uses C<sv_upgrade> to
diff --git a/pp.c b/pp.c
index 1649cf4..cb55181 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4418,7 +4418,7 @@ PP(pp_pack)
            patcopy++;
            continue;
         }
-       if (datumtype == 'U' && pat==patcopy+1) 
+       if (datumtype == 'U' && pat == patcopy+1) 
            SvUTF8_on(cat);
        if (datumtype == '#') {
            while (pat < patend && *pat != '\n')
diff --git a/proto.h b/proto.h
index bd222fe..f65f898 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -61,11 +61,7 @@ PERL_CALLCONV bool   Perl_Gv_AMupdate(pTHX_ HV* stash);
 PERL_CALLCONV OP*      Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail);
 PERL_CALLCONV OP*      Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last);
 PERL_CALLCONV I32      Perl_apply(pTHX_ I32 type, SV** mark, SV** sp);
-PERL_CALLCONV void     Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, char *attrstr, STRLEN len)
-#ifdef CHECK_FORMAT
- __attribute__((format(printf,pTHX_3,pTHX_4)))
-#endif
-;
+PERL_CALLCONV void     Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, char *attrstr, STRLEN len);
 PERL_CALLCONV SV*      Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash);
 PERL_CALLCONV bool     Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash);
 PERL_CALLCONV SV**     Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash);
@@ -1018,7 +1014,6 @@ STATIC char*      S_gv_ename(pTHX_ GV *gv);
 STATIC void    S_cv_dump(pTHX_ CV *cv);
 STATIC CV*     S_cv_clone2(pTHX_ CV *proto, CV *outside);
 STATIC bool    S_scalar_mod_type(pTHX_ OP *o, I32 type);
-STATIC OP *    S_method_2entersub(pTHX_ OP *o, OP *o2, OP *svop);
 STATIC OP *    S_my_kid(pTHX_ OP *o, OP *attrs);
 STATIC OP *    S_dup_attrlist(pTHX_ OP *o);
 STATIC void    S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs);
@@ -1228,7 +1223,7 @@ STATIC char*      S_scan_subst(pTHX_ char *start);
 STATIC char*   S_scan_trans(pTHX_ char *start);
 STATIC char*   S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp);
 STATIC char*   S_skipspace(pTHX_ char *s);
-STATIC char*   S_swallow_bom(pTHX_ char *s);
+STATIC char*   S_swallow_bom(pTHX_ U8 *s);
 STATIC void    S_checkcomma(pTHX_ char *s, char *name, char *what);
 STATIC void    S_force_ident(pTHX_ char *s, int kind);
 STATIC void    S_incline(pTHX_ char *s);
index 89b3e53..db099ad 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -901,6 +901,9 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da
                                sv_catsv(data->last_found, last_str);
                                data->last_end += l * (mincount - 1);
                            }
+                       } else {
+                           /* start offset must point into the last copy */
+                           data->last_start_min += minnext * (mincount - 1);
                        }
                    }
                    /* It is counted once already... */
index 6bddf2d..7472d09 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -221,6 +221,22 @@ typedef struct re_cc_state
 
 #define regcpblow(cp) LEAVE_SCOPE(cp)
 
+#define TRYPAREN(paren, n, input) {                            \
+    if (paren) {                                               \
+       if (n) {                                                \
+           PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
+           PL_regendp[paren] = input - PL_bostr;               \
+       }                                                       \
+       else                                                    \
+           PL_regendp[paren] = -1;                             \
+    }                                                          \
+    if (regmatch(next))                                                \
+       sayYES;                                                 \
+    if (paren && n)                                            \
+       PL_regendp[paren] = -1;                                 \
+}
+
+
 /*
  * pregexec and friends
  */
@@ -3001,8 +3017,6 @@ S_regmatch(pTHX_ regnode *prog)
            else
                c1 = c2 = -1000;
            PL_reginput = locinput;
-           if (paren)
-               PL_regendp[paren] = -1;
            if (minmod) {
                CHECKPOINT lastcp;
                minmod = 0;
@@ -3037,16 +3051,7 @@ S_regmatch(pTHX_ regnode *prog)
                                sayNO;
                        }
                        /* PL_reginput == locinput now */
-                       if (paren) {
-                           if (ln) {
-                               PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr;
-                               PL_regendp[paren] = locinput - PL_bostr;
-                           }
-                           else
-                               PL_regendp[paren] = -1;
-                       }
-                       if (regmatch(next))
-                           sayYES;
+                       TRYPAREN(paren, ln, locinput);
                        PL_reginput = locinput; /* Could be reset... */
                        REGCP_UNWIND;
                        /* Couldn't or didn't -- move forward. */
@@ -3060,16 +3065,7 @@ S_regmatch(pTHX_ regnode *prog)
                        UCHARAT(PL_reginput) == c1 ||
                        UCHARAT(PL_reginput) == c2)
                    {
-                       if (paren) {
-                           if (n) {
-                               PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
-                               PL_regendp[paren] = PL_reginput - PL_bostr;
-                           }
-                           else
-                               PL_regendp[paren] = -1;
-                       }
-                       if (regmatch(next))
-                           sayYES;
+                       TRYPAREN(paren, n, PL_reginput);
                        REGCP_UNWIND;
                    }
                    /* Couldn't or didn't -- move forward. */
@@ -3103,16 +3099,7 @@ S_regmatch(pTHX_ regnode *prog)
                            UCHARAT(PL_reginput) == c1 ||
                            UCHARAT(PL_reginput) == c2)
                            {
-                               if (paren && n) {
-                                   if (n) {
-                                       PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
-                                       PL_regendp[paren] = PL_reginput - PL_bostr;
-                                   }
-                                   else
-                                       PL_regendp[paren] = -1;
-                               }
-                               if (regmatch(next))
-                                   sayYES;
+                               TRYPAREN(paren, n, PL_reginput);
                                REGCP_UNWIND;
                            }
                        /* Couldn't or didn't -- back up. */
@@ -3127,8 +3114,7 @@ S_regmatch(pTHX_ regnode *prog)
                            UCHARAT(PL_reginput) == c1 ||
                            UCHARAT(PL_reginput) == c2)
                            {
-                               if (regmatch(next))
-                                   sayYES;
+                               TRYPAREN(paren, n, PL_reginput);
                                REGCP_UNWIND;
                            }
                        /* Couldn't or didn't -- back up. */
diff --git a/sv.h b/sv.h
index b77a9d3..c670f80 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1022,13 +1022,6 @@ indicated number of bytes (remember to reserve space for an extra trailing
 NUL character).  Calls C<sv_grow> to perform the expansion if necessary. 
 Returns a pointer to the character buffer.
 
-=for apidoc Am|void|SvLOCK|SV* sv
-Aquires an internal mutex for a SV. Used to make sure multiple threads
-don't stomp on the guts of an SV at the same time
-
-=for apidoc Am|void|SvUNLOCK|SV* sv
-Release the internal mutex for an SV.
-
 =cut
 */
 
@@ -1064,9 +1057,6 @@ Release the internal mutex for an SV.
                SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst))
 
 #ifdef DEBUGGING
-
-#define SvLOCK(sv)     MUTEX_LOCK(&PL_sv_lock_mutex)
-#define SvUNLOCK(sv)   MUTEX_UNLOCK(&PL_sv_lock_mutex)
 #define SvPEEK(sv) sv_peek(sv)
 #else
 #define SvPEEK(sv) ""
index 263bded..b3137c7 100644 (file)
@@ -751,5 +751,10 @@ tt+$       xxxtt   y       -       -
 '^\S\s+aa$'m   \nx aa  y       -       -
 (^|a)b ab      y       -       -
 ^([ab]*?)(b)?(c)$      abac    y       -$2-    --
+(\w)?(abc)\1b  abcab   n       -       -
+^(?:.,){2}c    a,b,c   y       -       -
+^(.,){2}c      a,b,c   y       $1      b,
+^(?:[^,]*,){2}c        a,b,c   y       -       -
+^([^,]*,){2}c  a,b,c   y       $1      b,
 (?i)           y       -       -
 '(?!\A)x'm     a\nxb\n y       -       -
index 8234360..f7ab18c 100644 (file)
--- a/thread.h
+++ b/thread.h
 #  define UNLOCK_CRED_MUTEX    MUTEX_UNLOCK(&PL_cred_mutex)
 #  define LOCK_FDPID_MUTEX     MUTEX_LOCK(&PL_fdpid_mutex)
 #  define UNLOCK_FDPID_MUTEX   MUTEX_UNLOCK(&PL_fdpid_mutex)
+#  define LOCK_SV_LOCK_MUTEX   MUTEX_LOCK(&PL_sv_lock_mutex)
+#  define UNLOCK_SV_LOCK_MUTEX MUTEX_UNLOCK(&PL_sv_lock_mutex)
 
 /* Values and macros for thr->flags */
 #define THRf_STATE_MASK        7
@@ -385,6 +387,14 @@ typedef struct condpair {
 #  define UNLOCK_FDPID_MUTEX
 #endif
 
+#ifndef LOCK_SV_LOCK_MUTEX
+#  define LOCK_SV_LOCK_MUTEX
+#endif
+
+#ifndef UNLOCK_SV_LOCK_MUTEX
+#  define UNLOCK_SV_LOCK_MUTEX
+#endif
+
 /* THR, SET_THR, and dTHR are there for compatibility with old versions */
 #ifndef THR
 #  define THR          PERL_GET_THX
diff --git a/toke.c b/toke.c
index bea9abf..79f7a31 100644 (file)
--- a/toke.c
+++ b/toke.c
 static char ident_too_long[] = "Identifier too long";
 
 static void restore_rsfp(pTHXo_ void *f);
+#ifndef PERL_NO_UTF16_FILTER
+static I32 utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
+static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
+#endif
 
 #define XFAKEBRACK 128
 #define XENUMMASK 127
@@ -326,36 +330,6 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 }
 #endif
 
-#ifdef PERL_UTF16_FILTER
-STATIC I32
-S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
-{
-    I32 count = FILTER_READ(idx+1, sv, maxlen);
-    if (count) {
-       U8* tmps;
-       U8* tend;
-       New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
-       tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv));
-       sv_usepvn(sv, (char*)tmps, tend - tmps);
-    }
-    return count;
-}
-
-STATIC I32
-S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
-{
-    I32 count = FILTER_READ(idx+1, sv, maxlen);
-    if (count) {
-       U8* tmps;
-       U8* tend;
-       New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
-       tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv));
-       sv_usepvn(sv, (char*)tmps, tend - tmps);
-    }
-    return count;
-}
-#endif
-
 /*
  * Perl_lex_start
  * Initialize variables.  Uses the Perl save_stack to save its state (for
@@ -987,8 +961,8 @@ S_sublex_start(pTHX)
 
            p = SvPV(sv, len);
            nsv = newSVpvn(p, len);
-            if (SvUTF8(sv))
-               SvUTF8_on(nsv);
+           if (SvUTF8(sv))
+               SvUTF8_on(nsv);
            SvREFCNT_dec(sv);
            sv = nsv;
        } 
@@ -2006,17 +1980,19 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
         return (sv_gets(sv, fp, append));
 }
 
-STATIC HV *S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
+STATIC HV *
+S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 {
     GV *gv;
 
-    if (*pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
+    if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
         return PL_curstash;
 
     if (len > 2 &&
         (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
-        (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV))) {
-        return GvHV(gv); /* Foo:: */
+        (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV)))
+    {
+        return GvHV(gv);                       /* Foo:: */
     }
 
     /* use constant CLASS => 'MyClass' */
@@ -2490,8 +2466,8 @@ Perl_yylex(pTHX)
            goto retry;
        }
        do {
-        bool bof;
-        bof = PL_rsfp && (PerlIO_tell(PL_rsfp)==0); /* *Before* read! */
+           bool bof;
+           bof = PL_rsfp && (PerlIO_tell(PL_rsfp) == 0); /* *Before* read! */
            if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
              fake_eof:
                if (PL_rsfp) {
@@ -2528,8 +2504,8 @@ Perl_yylex(pTHX)
                    PL_doextract = FALSE;
                }
            } 
-        if (bof)
-            s = swallow_bom(s);
+           if (bof)
+               s = swallow_bom((U8*)s);
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
@@ -6157,8 +6133,8 @@ S_scan_trans(pTHX_ char *start)
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }
 
-       New(803,tbl,256,short);
-       o = newPVOP(OP_TRANS, 0, (char*)tbl);
+    New(803,tbl,256,short);
+    o = newPVOP(OP_TRANS, 0, (char*)tbl);
 
     complement = del = squash = 0;
     while (strchr("cds", *s)) {
@@ -7390,57 +7366,62 @@ Perl_yyerror(pTHX_ char *s)
     return 0;
 }
 
-
 STATIC char*
-S_swallow_bom(pTHX_ char *s) {
+S_swallow_bom(pTHX_ char *s)
+{
     STRLEN slen;
     slen = SvCUR(PL_linestr);
     switch (*s) {
     case -1:       
-    if ((s[1] & 255) == 254) { 
-        /* UTF-16 little-endian */
-#ifdef PERL_UTF16_FILTER
-        U8 *news;
+       if ((s[1] & 255) == 254) { 
+           /* UTF-16 little-endian */
+#ifndef PERL_NO_UTF16_FILTER
+           U8 *news;
 #endif
-        s+=2;
-        if (*s == 0 && s[1] == 0)  /* UTF-32 little-endian */
-            Perl_croak(aTHX_ "Unsupported script encoding");
-#ifdef PERL_UTF16_FILTER
-        filter_add(S_utf16rev_textfilter, NULL);
-        New(898, news, (PL_bufend - s) * 3 / 2 + 1, U8);
-        PL_bufend = utf16_to_utf8((U16*)s, news, PL_bufend - s);
-        s = news;
+           s += 2;
+           if (*s == 0 && s[1] == 0)  /* UTF-32 little-endian */
+               Perl_croak(aTHX_ "Unsupported script encoding");
+#ifndef PERL_NO_UTF16_FILTER
+           s += 2;
+           filter_add(utf16rev_textfilter, NULL);
+           New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
+           PL_bufend = (char*)utf16_to_utf8((U16*)s, news,
+                                            PL_bufend - (char*)s);
+           s = news;
 #else
-        Perl_croak(aTHX_ "Unsupported script encoding");
+           Perl_croak(aTHX_ "Unsupported script encoding");
 #endif
-    }
-    break;
+       }
+       break;
 
     case -2:
-    if ((s[1] & 255) == 255) {   /* UTF-16 big-endian */
-#ifdef PERL_UTF16_FILTER
-        U8 *news;
-        filter_add(S_utf16_textfilter, NULL);
-        New(898, news, (PL_bufend - s) * 3 / 2 + 1, U8);
-        PL_bufend = utf16_to_utf8((U16*)s, news, PL_bufend - s);
-        s = news;
+       if ((s[1] & 255) == 255) {   /* UTF-16 big-endian */
+#ifndef PERL_NO_UTF16_FILTER
+           U8 *news;
+           filter_add(utf16_textfilter, NULL);
+           New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
+           PL_bufend = (char*)utf16_to_utf8((U16*)s, news,
+                                            PL_bufend - (char*)s);
+           s = news;
 #else
-        Perl_croak(aTHX_ "Unsupported script encoding");
+           Perl_croak(aTHX_ "Unsupported script encoding");
 #endif
-   }
-   break;
-
-   case -17:
-   if ( slen>2 && (s[1] & 255) == 187 && (s[2] & 255) == 191) {
-        s+=3;                      /* UTF-8 */
-   }
-   break;
-   case 0:
-   if (slen > 3 && s[1] == 0 &&  /* UTF-32 big-endian */
-       s[2] & 255 == 254 && s[3] & 255 == 255)
-       Perl_croak(aTHX_ "Unsupported script encoding");
-} 
-return s;
+       }
+       break;
+
+    case -17:
+       if (slen > 2 && (s[1] & 255) == 187 && (s[2] & 255) == 191) {
+           s += 3;                      /* UTF-8 */
+       }
+       break;
+    case 0:
+       if (slen > 3 && s[1] == 0 &&  /* UTF-32 big-endian */
+           s[2] & 255 == 254 && s[3] & 255 == 255)
+       {
+           Perl_croak(aTHX_ "Unsupported script encoding");
+       }
+    }
+    return (char*)s;
 }
 
 #ifdef PERL_OBJECT
@@ -7463,3 +7444,33 @@ restore_rsfp(pTHXo_ void *f)
        PerlIO_close(PL_rsfp);
     PL_rsfp = fp;
 }
+
+#ifndef PERL_NO_UTF16_FILTER
+static I32
+utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
+{
+    I32 count = FILTER_READ(idx+1, sv, maxlen);
+    if (count) {
+       U8* tmps;
+       U8* tend;
+       New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
+       tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv));
+       sv_usepvn(sv, (char*)tmps, tend - tmps);
+    }
+    return count;
+}
+
+static I32
+utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
+{
+    I32 count = FILTER_READ(idx+1, sv, maxlen);
+    if (count) {
+       U8* tmps;
+       U8* tend;
+       New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
+       tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv));
+       sv_usepvn(sv, (char*)tmps, tend - tmps);
+    }
+    return count;
+}
+#endif
diff --git a/util.c b/util.c
index 0048309..dcf6ea4 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3492,11 +3492,9 @@ Perl_sv_lock(pTHX_ SV *osv)
     MAGIC *mg;
     SV *sv = osv;
 
-    SvLOCK(osv);
+    LOCK_SV_LOCK_MUTEX;
     if (SvROK(sv)) {
        sv = SvRV(sv);
-       SvUNLOCK(osv);
-       SvLOCK(sv);
     }
 
     mg = condpair_magic(sv);
@@ -3513,7 +3511,7 @@ Perl_sv_lock(pTHX_ SV *osv)
        MUTEX_UNLOCK(MgMUTEXP(mg));
        SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
     }
-    SvUNLOCK(sv);
+    UNLOCK_SV_LOCK_MUTEX;
     return sv;
 }