X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4c17e999c9ee0b1efabb2b96c6fbb1c7a2ad2822..f34d8cddb66ff0384d68d9388041c9a299f2bb09:/util.c

diff --git a/util.c b/util.c
index 4b48e62..f307138 100644
--- a/util.c
+++ b/util.c
@@ -1380,7 +1380,7 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
         int wi;
         /* The PERL_C_BACKTRACE_ON_WARN must be an integer of one or more. */
         if ((ws = PerlEnv_getenv("PERL_C_BACKTRACE_ON_ERROR")) &&
-            (wi = atoi(ws)) > 0) {
+            (wi = grok_atou(ws, NULL)) > 0) {
             Perl_dump_c_backtrace(aTHX_ Perl_debug_log, wi, 1);
         }
     }
@@ -1533,7 +1533,6 @@ S_invoke_exception_hook(pTHX_ SV *ex, bool warn)
 	SV *exarg;
 
 	ENTER;
-	save_re_context();
 	if (warn) {
 	    SAVESPTR(*hook);
 	    *hook = NULL;
@@ -2072,7 +2071,11 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
         my_setenv_format(environ[i], nam, nlen, val, vlen);
     } else {
 # endif
-#   if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__)
+    /* This next branch should only be called #if defined(HAS_SETENV), but
+       Configure doesn't test for that yet.  For Solaris, setenv() and unsetenv()
+       were introduced in Solaris 9, so testing for HAS UNSETENV is sufficient.
+    */
+#   if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) || (defined(__sun) && defined(HAS_UNSETENV))
 #       if defined(HAS_UNSETENV)
         if (val == NULL) {
             (void)unsetenv(nam);
@@ -4381,9 +4384,9 @@ Perl_parse_unicode_opts(pTHX_ const char **popt)
 
   if (*p) {
        if (isDIGIT(*p)) {
-	    opt = (U32) atoi(p);
-	    while (isDIGIT(*p))
-		p++;
+            const char* endptr;
+            opt = (U32) grok_atou(p, &endptr);
+	    p = endptr;
 	    if (*p && *p != '\n' && *p != '\r') {
 	     if(isSPACE(*p)) goto the_end_of_the_opts_parser;
 	     else
@@ -4698,7 +4701,7 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
  * The default implementation reads a single env var, PERL_MEM_LOG,
  * expecting one or more of the following:
  *
- *    \d+ - fd		fd to write to		: must be 1st (atoi)
+ *    \d+ - fd		fd to write to		: must be 1st (grok_atou)
  *    'm' - memlog	was PERL_MEM_LOG=1
  *    's' - svlog	was PERL_SV_LOG=1
  *    't' - timestamp	was PERL_MEM_LOG_TIMESTAMP=1
@@ -4766,7 +4769,8 @@ S_mem_log_common(enum mem_log_type mlt, const UV n,
 	 * timeval. */
 	{
 	    STRLEN len;
-	    int fd = atoi(pmlenv);
+            const char* endptr;
+	    int fd = grok_atou(pmlenv, &endptr); /* Ignore endptr. */
 	    if (!fd)
 		fd = PERL_MEM_LOG_FD;
 
@@ -5345,10 +5349,10 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
     if (!PERLDB_SUB_NN) {
 	GV *gv = CvGV(cv);
 
-	if (!svp) {
+	if (gv && !svp) {
 	    gv_efullname3(dbsv, gv, NULL);
 	}
-	else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+	else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || !gv
 	     || strEQ(GvNAME(gv), "END")
 	     || ( /* Could be imported, and old sub redefined. */
 		 (GvCV(gv) != cv || !S_gv_has_usable_name(aTHX_ gv))
@@ -5368,10 +5372,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 	else {
 	    sv_sethek(dbsv, HvENAME_HEK(GvSTASH(gv)));
 	    sv_catpvs(dbsv, "::");
-	    sv_catpvn_flags(
-	      dbsv, GvNAME(gv), GvNAMELEN(gv),
-	      GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES
-	    );
+	    sv_cathek(dbsv, GvNAME_HEK(gv));
 	}
     }
     else {
@@ -5695,12 +5696,12 @@ static void atos_update(atos_context* ctx,
 
 /* Given an output buffer end |p| and its |start|, matches
  * for the atos output, extracting the source code location
- * if possible, returning NULL otherwise. */
+ * and returning non-NULL if possible, returning NULL otherwise. */
 static const char* atos_parse(const char* p,
                               const char* start,
                               STRLEN* source_name_size,
                               STRLEN* source_line) {
-    /* atos() outputs is something like:
+    /* atos() output is something like:
      * perl_parse (in miniperl) (perl.c:2314)\n\n".
      * We cannot use Perl regular expressions, because we need to
      * stay low-level.  Therefore here we have a rolled-out version
@@ -5710,11 +5711,14 @@ static const char* atos_parse(const char* p,
      * The matched regular expression is roughly "\(.*:\d+\)\s*$" */
     const char* source_number_start;
     const char* source_name_end;
+    const char* source_line_end;
+    const char* close_paren;
     /* Skip trailing whitespace. */
     while (p > start && isspace(*p)) p--;
     /* Now we should be at the close paren. */
     if (p == start || *p != ')')
         return NULL;
+    close_paren = p;
     p--;
     /* Now we should be in the line number. */
     if (p == start || !isdigit(*p))
@@ -5735,7 +5739,9 @@ static const char* atos_parse(const char* p,
         return NULL;
     p++;
     *source_name_size = source_name_end - p;
-    *source_line = atoi(source_number_start);
+    *source_line = grok_atou(source_number_start, &source_line_end);
+    if (source_line_end != close_paren)
+        return NULL;
     return p;
 }