make parenthetic warnings look consistent; make diagnostic on

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index d58b230..bda2beb 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,6 +1,6 @@
 /*    util.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -40,13 +40,6 @@
 #   define vfork fork
 #endif
 
-#ifdef I_FCNTL
-#  include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#  include <sys/file.h>
-#endif
-
 #ifdef I_SYS_WAIT
 #  include <sys/wait.h>
 #endif
@@ -116,7 +109,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 {
     dTHX;
     Malloc_t ptr;
-#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
+#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) && !defined(PERL_MICRO)
     Malloc_t PerlMem_realloc();
 #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
 
@@ -161,7 +154,9 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 Free_t
 Perl_safesysfree(Malloc_t where)
 {
+#ifdef PERL_IMPLICIT_SYS
     dTHX;
+#endif
     DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
     if (where) {
        /*SUPPRESS 701*/
@@ -706,8 +701,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     if (setlocale_failure) {
        char *p;
        bool locwarn = (printwarn > 1 || 
-                       printwarn &&
-                       (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p)));
+                       (printwarn &&
+                        (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
 
        if (locwarn) {
 #ifdef LC_ALL
@@ -1002,17 +997,15 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
     register I32 multiline = flags & FBMrf_MULTILINE;
 
     if (bigend - big < littlelen) {
-      check_tail:
        if ( SvTAIL(littlestr) 
             && (bigend - big == littlelen - 1)
             && (littlelen == 1 
-                || *big == *little && memEQ(big, little, littlelen - 1)))
+                || (*big == *little && memEQ(big, little, littlelen - 1))))
            return (char*)big;
        return Nullch;
     }
 
     if (littlelen <= 2) {              /* Special-cased */
-       register char c;
 
        if (littlelen == 1) {
            if (SvTAIL(littlestr) && !multiline) { /* Anchor only! */
@@ -1164,7 +1157,6 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
                while (tmp--) {
                    if (*--s == *--little)
                        continue;
-                 differ:
                    s = olds + 1;       /* here we pay the price for failure */
                    little = oldlittle;
                    if (s < bigend)     /* fake up continue to outer loop */
@@ -1504,6 +1496,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     }
     else {
        message = Nullch;
+       msglen = 0;
     }
 
     DEBUG_S(PerlIO_printf(Perl_debug_log,
@@ -2362,7 +2355,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
        }
 #endif /* defined OS2 */
        /*SUPPRESS 560*/
-       if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
+       if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
            sv_setiv(GvSV(tmpgv), PerlProc_getpid());
        PL_forkprocess = 0;
        hv_clear(PL_pidstatus); /* we have no children */
@@ -2657,7 +2650,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
        HE *entry;
 
        hv_iterinit(PL_pidstatus);
-       if (entry = hv_iternext(PL_pidstatus)) {
+       if ((entry = hv_iternext(PL_pidstatus))) {
            pid = atoi(hv_iterkey(entry,(I32*)statusp));
            sv = hv_iterval(PL_pidstatus,entry);
            *statusp = SvIVX(sv);
@@ -3297,8 +3290,46 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f
     return (scriptname ? savepv(scriptname) : Nullch);
 }
 
+#ifndef PERL_GET_CONTEXT_DEFINED
+
+void *
+Perl_get_context(void)
+{
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+#  ifdef OLD_PTHREADS_API
+    pthread_addr_t t;
+    if (pthread_getspecific(PL_thr_key, &t))
+       Perl_croak_nocontext("panic: pthread_getspecific");
+    return (void*)t;
+#  else
+#  ifdef I_MACH_CTHREADS
+    return (void*)cthread_data(cthread_self());
+#  else
+    return (void*)pthread_getspecific(PL_thr_key);
+#  endif
+#  endif
+#else
+    return (void*)NULL;
+#endif
+}
+
+void
+Perl_set_context(void *t)
+{
+#if defined(USE_THREADS) || defined(USE_ITHREADS)
+#  ifdef I_MACH_CTHREADS
+    cthread_set_data(cthread_self(), t);
+#  else
+    if (pthread_setspecific(PL_thr_key, t))
+       Perl_croak_nocontext("panic: pthread_setspecific");
+#  endif
+#endif
+}
+
+#endif /* !PERL_GET_CONTEXT_DEFINED */
 
 #ifdef USE_THREADS
+
 #ifdef FAKE_THREADS
 /* Very simplistic scheduler for now */
 void
@@ -3373,18 +3404,6 @@ Perl_cond_wait(pTHX_ perl_cond *cp)
 }
 #endif /* FAKE_THREADS */
 
-#ifdef PTHREAD_GETSPECIFIC_INT
-struct perl_thread *
-Perl_getTHR(pTHX)
-{
-    pthread_addr_t t;
-
-    if (pthread_getspecific(PL_thr_key, &t))
-       Perl_croak(aTHX_ "panic: pthread_getspecific");
-    return (struct perl_thread *) t;
-}
-#endif
-
 MAGIC *
 Perl_condpair_magic(pTHX_ SV *sv)
 {
@@ -3494,7 +3513,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     /* parent thread's data needs to be locked while we make copy */
     MUTEX_LOCK(&t->mutex);
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
     PL_protect = t->Tprotect;
+#endif
 
     PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
     PL_defstash = t->Tdefstash;   /* XXX maybe these should */
@@ -3796,6 +3817,6 @@ Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj)
 
     if (io && IoDIRP(io))
        Perl_warner(aTHX_ WARN_CLOSED,
-                   "(Are you trying to call %s() on dirhandle %s?)\n",
+                   "\t(Are you trying to call %s() on dirhandle %s?)\n",
                    func, name);
 }