This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl5db] Refactored do {...}s into ifs.
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 64c871c..b7403e8 100644 (file)
--- a/util.c
+++ b/util.c
@@ -307,12 +307,12 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
 #endif
     }
     else
-       Perl_croak_nocontext("%s", PL_memory_wrap);
+       croak_memory_wrap();
 #ifdef PERL_TRACK_MEMPOOL
     if (sTHX <= MEM_SIZE_MAX - (MEM_SIZE)total_size)
        total_size += sTHX;
     else
-       Perl_croak_nocontext("%s", PL_memory_wrap);
+       croak_memory_wrap();
 #endif
 #ifdef HAS_64K_LIMIT
     if (total_size > 0xffff) {
@@ -871,6 +871,8 @@ Perl_foldEQ(const char *s1, const char *s2, register I32 len)
 
     PERL_ARGS_ASSERT_FOLDEQ;
 
+    assert(len >= 0);
+
     while (len--) {
        if (*a != *b && *a != PL_fold[*b])
            return 0;
@@ -891,6 +893,8 @@ Perl_foldEQ_latin1(const char *s1, const char *s2, register I32 len)
 
     PERL_ARGS_ASSERT_FOLDEQ_LATIN1;
 
+    assert(len >= 0);
+
     while (len--) {
        if (*a != *b && *a != PL_fold_latin1[*b]) {
            return 0;
@@ -918,6 +922,8 @@ Perl_foldEQ_locale(const char *s1, const char *s2, register I32 len)
 
     PERL_ARGS_ASSERT_FOLDEQ_LOCALE;
 
+    assert(len >= 0);
+
     while (len--) {
        if (*a != *b && *a != PL_fold_locale[*b])
            return 0;
@@ -974,6 +980,8 @@ Perl_savepvn(pTHX_ const char *pv, register I32 len)
     char *newaddr;
     PERL_UNUSED_CONTEXT;
 
+    assert(len >= 0);
+
     Newx(newaddr,len+1,char);
     /* Give a meaning to NULL pointer mainly for the use in sv_magic() */
     if (pv) {
@@ -1617,9 +1625,9 @@ paths reduces CPU cache pressure.
 */
 
 void
-Perl_croak_no_modify(pTHX)
+Perl_croak_no_modify()
 {
-    Perl_croak(aTHX_ "%s", PL_no_modify);
+    Perl_croak_nocontext( "%s", PL_no_modify);
 }
 
 /*
@@ -2024,6 +2032,8 @@ Perl_my_bcopy(register const char *from,register char *to,register I32 len)
 
     PERL_ARGS_ASSERT_MY_BCOPY;
 
+    assert(len >= 0);
+
     if (from - to >= 0) {
        while (len--)
            *to++ = *from++;
@@ -2047,6 +2057,8 @@ Perl_my_memset(register char *loc, register I32 ch, register I32 len)
 
     PERL_ARGS_ASSERT_MY_MEMSET;
 
+    assert(len >= 0);
+
     while (len--)
        *loc++ = ch;
     return retval;
@@ -2062,6 +2074,8 @@ Perl_my_bzero(register char *loc, register I32 len)
 
     PERL_ARGS_ASSERT_MY_BZERO;
 
+    assert(len >= 0);
+
     while (len--)
        *loc++ = 0;
     return retval;
@@ -2079,6 +2093,8 @@ Perl_my_memcmp(const char *s1, const char *s2, register I32 len)
 
     PERL_ARGS_ASSERT_MY_MEMCMP;
 
+    assert(len >= 0);
+
     while (len--) {
         if ((tmp = *a++ - *b++))
            return tmp;
@@ -2488,7 +2504,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
     PERL_FLUSHALL_FOR_CHILD;
     This = (*mode == 'w');
     that = !This;
-    if (PL_tainting) {
+    if (TAINTING_get) {
        taint_env();
        taint_proper("Insecure %s%s", "EXEC");
     }
@@ -2634,7 +2650,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 #endif
     This = (*mode == 'w');
     that = !This;
-    if (doexec && PL_tainting) {
+    if (doexec && TAINTING_get) {
        taint_env();
        taint_proper("Insecure %s%s", "EXEC");
     }
@@ -3256,6 +3272,11 @@ Perl_repeatcpy(register char *to, register const char *from, I32 len, register I
 {
     PERL_ARGS_ASSERT_REPEATCPY;
 
+    assert(len >= 0);
+
+    if (count < 0)
+       croak_memory_wrap();
+
     if (len == 1)
        memset(to, *from, count);
     else if (count) {
@@ -4364,6 +4385,7 @@ dotted_decimal_version:
     }                                  /* end if dotted-decimal */
     else
     {                                  /* decimal versions */
+       int j = 0;                      /* may need this later */
        /* special strict case for leading '.' or '0' */
        if (strict) {
            if (*d == '.') {
@@ -4426,7 +4448,7 @@ dotted_decimal_version:
        }
 
        while (isDIGIT(*d)) {
-           d++;
+           d++; j++;
            if (*d == '.' && isDIGIT(d[-1])) {
                if (alpha) {
                    BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
@@ -4448,6 +4470,7 @@ dotted_decimal_version:
                if ( ! isDIGIT(d[1]) ) {
                    BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
                }
+               width = j;
                d++;
                alpha = TRUE;
            }
@@ -5984,7 +6007,6 @@ getting C<vsnprintf>.
 int
 Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
 {
-    dTHX;
     int retval;
     va_list ap;
     PERL_ARGS_ASSERT_MY_SNPRINTF;
@@ -6003,7 +6025,7 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
         (len > 0 && (Size_t)retval >= len) 
 #endif
     )
-       Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
+       Perl_croak_nocontext("panic: my_snprintf buffer overflow");
     return retval;
 }
 
@@ -6021,7 +6043,6 @@ C<sv_vcatpvf> instead, or getting C<vsnprintf>.
 int
 Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap)
 {
-    dTHX;
     int retval;
 #ifdef NEED_VA_COPY
     va_list apc;
@@ -6049,7 +6070,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
         (len > 0 && (Size_t)retval >= len) 
 #endif
     )
-       Perl_croak(aTHX_ "panic: my_vsnprintf buffer overflow");
+       Perl_croak_nocontext("panic: my_vsnprintf buffer overflow");
     return retval;
 }
 
@@ -6361,7 +6382,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
     dVAR;
     SV * const dbsv = GvSVn(PL_DBsub);
-    const bool save_taint = PL_tainted;
+    const bool save_taint = TAINT_get; /* Accepted unused var warning under NO_TAINT_SUPPORT */
 
     /* When we are called from pp_goto (svp is null),
      * we do not care about using dbsv to call CV;
@@ -6370,7 +6391,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 
     PERL_ARGS_ASSERT_GET_DB_SUB;
 
-    PL_tainted = FALSE;
+    TAINT_set(FALSE);
     save_item(dbsv);
     if (!PERLDB_SUB_NN) {
        GV *gv = CvGV(cv);