POPEVAL: don't set optype

[perl5.git] / util.c

diff --git a/util.c b/util.c
index ab468fe..7cd7d0e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2178,7 +2178,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
        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(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) || (defined(__sun) && defined(HAS_UNSETENV)) || defined(PERL_DARWIN)
 #       if defined(HAS_UNSETENV)
         if (val == NULL) {
             (void)unsetenv(nam);
@@ -2714,6 +2714,15 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 /* this is called in parent before the fork() */
 void
 Perl_atfork_lock(void)
+#if defined(USE_ITHREADS)
+#  ifdef USE_PERLIO
+  PERL_TSA_ACQUIRE(PL_perlio_mutex)
+#  endif
+#  ifdef MYMALLOC
+  PERL_TSA_ACQUIRE(PL_malloc_mutex)
+#  endif
+  PERL_TSA_ACQUIRE(PL_op_mutex)
+#endif
 {
 #if defined(USE_ITHREADS)
     dVAR;
@@ -2731,6 +2740,15 @@ Perl_atfork_lock(void)
 /* this is called in both parent and child after the fork() */
 void
 Perl_atfork_unlock(void)
+#if defined(USE_ITHREADS)
+#  ifdef USE_PERLIO
+  PERL_TSA_RELEASE(PL_perlio_mutex)
+#  endif
+#  ifdef MYMALLOC
+  PERL_TSA_RELEASE(PL_malloc_mutex)
+#  endif
+  PERL_TSA_RELEASE(PL_op_mutex)
+#endif
 {
 #if defined(USE_ITHREADS)
     dVAR;
@@ -4520,6 +4538,9 @@ Perl_parse_unicode_opts(pTHX_ const char **popt)
                         Perl_croak(aTHX_ "Unknown Unicode option letter '%c'", *p);
                 }
             }
+            else {
+                Perl_croak(aTHX_ "Invalid number '%s' for -C option.\n", p);
+            }
         }
         else {
            for (; *p; p++) {
@@ -5249,13 +5270,11 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
     va_list apc;
 
     PERL_ARGS_ASSERT_MY_VSNPRINTF;
-#ifndef HAS_VSNPRINTF
-    PERL_UNUSED_VAR(len);
-#endif
     Perl_va_copy(ap, apc);
 # ifdef HAS_VSNPRINTF
     retval = vsnprintf(buffer, len, format, apc);
 # else
+    PERL_UNUSED_ARG(len);
     retval = vsprintf(buffer, format, apc);
 # endif
     va_end(apc);
@@ -5263,6 +5282,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
 # ifdef HAS_VSNPRINTF
     retval = vsnprintf(buffer, len, format, ap);
 # else
+    PERL_UNUSED_ARG(len);
     retval = vsprintf(buffer, format, ap);
 # endif
 #endif /* #ifdef NEED_VA_COPY */
@@ -6577,6 +6597,28 @@ Perl_dump_c_backtrace(pTHX_ PerlIO* fp, int depth, int skip)
 
 #endif /* #ifdef USE_C_BACKTRACE */
 
+#ifdef PERL_TSA_ACTIVE
+
+/* pthread_mutex_t and perl_mutex are typedef equivalent
+ * so casting the pointers is fine. */
+
+int perl_tsa_mutex_lock(perl_mutex* mutex)
+{
+    return pthread_mutex_lock((pthread_mutex_t *) mutex);
+}
+
+int perl_tsa_mutex_unlock(perl_mutex* mutex)
+{
+    return pthread_mutex_unlock((pthread_mutex_t *) mutex);
+}
+
+int perl_tsa_mutex_destroy(perl_mutex* mutex)
+{
+    return pthread_mutex_destroy((pthread_mutex_t *) mutex);
+}
+
+#endif
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */