This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip test when Encode isn't built
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 360ec28..3c55183 100644 (file)
--- a/util.c
+++ b/util.c
@@ -504,7 +504,6 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
            = (unsigned char*)(SvPVX_mutable(sv) + len + PERL_FBM_TABLE_OFFSET);
        s = table - 1 - PERL_FBM_TABLE_OFFSET;  /* last char */
        memset((void*)table, mlen, 256);
-       BmFLAGS(sv) = (U8)flags;
        i = 0;
        sb = s - mlen + 1;                      /* first char (maybe) */
        while (s >= sb) {
@@ -524,6 +523,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
            frequency = PL_freq[s[i]];
        }
     }
+    BmFLAGS(sv) = (U8)flags;
     BmRARE(sv) = s[rarest];
     BmPREVIOUS(sv) = rarest;
     BmUSEFUL(sv) = 100;                        /* Initial value */
@@ -769,7 +769,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
        : (((pos = *old_posp), pos += PL_screamnext[pos]) == 0)) {
       cant_find:
        if ( BmRARE(littlestr) == '\n'
-            && BmPREVIOUS(littlestr) == (U8)SvCUR(littlestr) - 1) {
+            && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) {
            little = (const unsigned char *)(SvPVX_const(littlestr));
            littleend = little + SvCUR(littlestr);
            first = *little++;
@@ -953,6 +953,27 @@ Perl_savesharedpv(pTHX_ const char *pv)
 }
 
 /*
+=for apidoc savesharedpvn
+
+A version of C<savepvn()> which allocates the duplicate string in memory
+which is shared between threads. (With the specific difference that a NULL
+pointer is not acceptable)
+
+=cut
+*/
+char *
+Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
+{
+    char *const newaddr = (char*)PerlMemShared_malloc(len + 1);
+    assert(pv);
+    if (!newaddr) {
+       return write_no_mem();
+    }
+    newaddr[len] = '\0';
+    return (char*)memcpy(newaddr, pv, len);
+}
+
+/*
 =for apidoc savesvpv
 
 A version of C<savepv()>/C<savepvn()> which gets the string to duplicate from
@@ -4120,6 +4141,9 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if ( alpha && !saw_period )
        Perl_croak(aTHX_ "Invalid version format (alpha without decimal)");
 
+    if ( alpha && saw_period && width == 0 )
+       Perl_croak(aTHX_ "Invalid version format (misplaced _ in number)");
+
     if ( saw_period > 1 )
        qv = 1; /* force quoted version processing */
 
@@ -5134,13 +5158,14 @@ Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv)
 
 #ifdef PERL_GLOBAL_STRUCT
 
+#define PERL_GLOBAL_STRUCT_INIT
+#include "opcode.h" /* the ppaddr and check */
+
 struct perl_vars *
 Perl_init_global_struct(pTHX)
 {
     struct perl_vars *plvarsp = NULL;
-#ifdef PERL_GLOBAL_STRUCT
-#  define PERL_GLOBAL_STRUCT_INIT
-#  include "opcode.h" /* the ppaddr and check */
+# ifdef PERL_GLOBAL_STRUCT
     const IV nppaddr = sizeof(Gppaddr)/sizeof(Perl_ppaddr_t);
     const IV ncheck  = sizeof(Gcheck) /sizeof(Perl_check_t);
 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
@@ -5168,10 +5193,14 @@ Perl_init_global_struct(pTHX)
 #  undef PERLVARIC
 #  undef PERLVARISC
 #  ifdef PERL_GLOBAL_STRUCT
-    plvarsp->Gppaddr = PerlMem_malloc(nppaddr * sizeof(Perl_ppaddr_t));
+    plvarsp->Gppaddr =
+       (Perl_ppaddr_t*)
+       PerlMem_malloc(nppaddr * sizeof(Perl_ppaddr_t));
     if (!plvarsp->Gppaddr)
         exit(1);
-    plvarsp->Gcheck  = PerlMem_malloc(ncheck  * sizeof(Perl_check_t));
+    plvarsp->Gcheck  =
+       (Perl_check_t*)
+       PerlMem_malloc(ncheck  * sizeof(Perl_check_t));
     if (!plvarsp->Gcheck)
         exit(1);
     Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t); 
@@ -5180,8 +5209,8 @@ Perl_init_global_struct(pTHX)
 #  ifdef PERL_SET_VARS
     PERL_SET_VARS(plvarsp);
 #  endif
-#  undef PERL_GLOBAL_STRUCT_INIT
-#endif
+# undef PERL_GLOBAL_STRUCT_INIT
+# endif
     return plvarsp;
 }
 
@@ -5192,16 +5221,16 @@ Perl_init_global_struct(pTHX)
 void
 Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
 {
-#ifdef PERL_GLOBAL_STRUCT
+# ifdef PERL_GLOBAL_STRUCT
 #  ifdef PERL_UNSET_VARS
     PERL_UNSET_VARS(plvarsp);
 #  endif
     free(plvarsp->Gppaddr);
     free(plvarsp->Gcheck);
-#    ifdef PERL_GLOBAL_STRUCT_PRIVATE
+#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
     free(plvarsp);
-#    endif
-#endif
+#  endif
+# endif
 }
 
 #endif /* PERL_GLOBAL_STRUCT */