Fix perl_os_thread typedef for pthreads. Tweak SvTAINT so that

sv_setfoo functions go back to not needing dTHR. Fix Configure
to check for already-existing -thread on archname and to check
better for d_pthread_created_joinable.

p4raw-id: //depot/perl@356

diff --git a/Configure b/Configure
index 36cb6d4..934958b 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -2099,8 +2099,15 @@ esac
 rp='What is your architecture name'
 . ./myread
 case "$usethreads" in
-$define)  archname="$ans-thread"
-          echo "Threads selected... architecture name is now $archname." >&4
+$define)  echo "Threads selected." >&4
+          case "$ans" in
+          *-thread) echo "...and architecture name already ends in -thread." >&4
+                    archname="$ans"
+                    ;;
+          *)        archname="$ans-thread"
+                    echo "...setting architecture name to $archname." >&4
+                    ;;
+          esac
           ;;
 *)        archname="$ans" ;;
 esac
@@ -9913,12 +9920,6 @@ if test "X$usethreads" != X; then
     if test "X$d_pthreads_created_joinable" = X; then
        echo >&4 "Checking whether pthreads are created joinable."
        $cat >try.c <<EOCP
-/* Note: this program returns 1 if detached, 0 if not.
- * Easier this way because the PTHREAD_CREATE_DETACHED is more
- * portable than the obsolete PTHREAD_CREATE_UNDETACHED.
- * Testing for joinable (aka undetached) as opposed to detached
- * is then again logically more sensible because that's
- * the more modern default state in the pthreads implementations. */
 #include <pthread.h>
 #include <stdio.h>
 int main() {
@@ -9935,21 +9936,21 @@ EOCP
        : Compile and link separately because the used cc might not be
        : able to link the right CRT and libs for pthreading.
        if $cc $ccflags -c try.c >/dev/null 2>&1 &&
-          $ld $lddlflags $ldflags -o try try$obj_ext $libs >/dev/null 2>&1; then
+          $ld $ldflags -o try try$obj_ext $libs >/dev/null 2>&1; then
            yyy=`./try`
        else
            echo "(I can't execute the test program--assuming they are.)"
            yyy=joinable
        fi
        case "$yyy" in
-       joinable)
+       detached)
+           val="$undef"
+           echo "Nope, they aren't."
+           ;;
+       *)
            val="$define"
            echo "Yup, they are."
            ;;
-       *)
-           val="$undef"
-           echo "Nope, they aren't."
-       ;;
        esac
        set d_pthreads_created_joinable
        eval $setvar

diff --git a/perl.h b/perl.h
index 4381e2d..a2aefa3 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -979,6 +979,7 @@ typedef I32 (*filter_t) _((int, SV *, int));
 #      include <win32thread.h>
 #    else
 #      include <pthread.h>
+typedef pthread_t perl_os_thread;
 typedef pthread_mutex_t perl_mutex;
 typedef pthread_cond_t perl_cond;
 typedef pthread_key_t perl_key;

diff --git a/sv.c b/sv.c
index 381c943..8e04c3c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1084,7 +1084,6 @@ sv_grow(SV* sv, unsigned long newlen)
 void
 sv_setiv(register SV *sv, IV i)
 {
-    dTHR;      /* just for taint */
     sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1132,7 +1131,6 @@ sv_setuv(register SV *sv, UV u)
 void
 sv_setnv(register SV *sv, double num)
 {
-    dTHR;      /* just for taint */
     sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1247,9 +1245,11 @@ sv_2iv(register SV *sv)
        if (SvPOKp(sv) && SvLEN(sv))
            return asIV(sv);
        if (!SvROK(sv)) {
-           dTHR;               /* just for localizing */
-           if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-               warn(warn_uninit);
+           if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+               dTHR;
+               if (!localizing)
+                   warn(warn_uninit);
+           }
            return 0;
        }
     }
@@ -1323,9 +1323,11 @@ sv_2uv(register SV *sv)
        if (SvPOKp(sv) && SvLEN(sv))
            return asUV(sv);
        if (!SvROK(sv)) {
-           dTHR;               /* just for localizing */
-           if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-               warn(warn_uninit);
+           if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+               dTHR;
+               if (!localizing)
+                   warn(warn_uninit);
+           }
            return 0;
        }
     }
@@ -1369,9 +1371,11 @@ sv_2uv(register SV *sv)
        SvUVX(sv) = asUV(sv);
     }
     else  {
-       dTHR;           /* just for localizing */
-       if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-           warn(warn_uninit);
+       if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+           dTHR;
+           if (!localizing)
+               warn(warn_uninit);
+       }
        return 0;
     }
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
@@ -1397,9 +1401,11 @@ sv_2nv(register SV *sv)
        if (SvIOKp(sv))
            return (double)SvIVX(sv);
         if (!SvROK(sv)) {
-           dTHR;               /* just for localizing */
-           if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-               warn(warn_uninit);
+           if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+               dTHR;
+               if (!localizing)
+                   warn(warn_uninit);
+           }
             return 0;
         }
     }
@@ -1603,9 +1609,11 @@ sv_2pv(register SV *sv, STRLEN *lp)
            goto tokensave;
        }
         if (!SvROK(sv)) {
-           dTHR;               /* just for localizing */
-           if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-               warn(warn_uninit);
+           if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) {
+               dTHR;
+               if (!localizing)
+                   warn(warn_uninit);
+           }
             *lp = 0;
             return "";
         }
@@ -2144,7 +2152,6 @@ sv_setsv(SV *dstr, register SV *sstr)
 void
 sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
 {
-    dTHR;      /* just for taint */
     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
                          elicit a warning, but it won't hurt. */
     sv_check_thinkfirst(sv);
@@ -2169,7 +2176,6 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
 void
 sv_setpv(register SV *sv, register const char *ptr)
 {
-    dTHR;      /* just for taint */
     register STRLEN len;
 
     sv_check_thinkfirst(sv);
@@ -2194,7 +2200,6 @@ sv_setpv(register SV *sv, register const char *ptr)
 void
 sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
 {
-    dTHR;      /* just for taint */
     sv_check_thinkfirst(sv);
     if (!SvUPGRADE(sv, SVt_PV))
        return;
@@ -2255,7 +2260,6 @@ sv_chop(register SV *sv, register char *ptr)      /* like set but assuming ptr is in
 void
 sv_catpvn(register SV *sv, register char *ptr, register STRLEN len)
 {
-    dTHR;      /* just for taint */
     STRLEN tlen;
     char *junk;
 
@@ -2284,7 +2288,6 @@ sv_catsv(SV *dstr, register SV *sstr)
 void
 sv_catpv(register SV *sv, register char *ptr)
 {
-    dTHR;      /* just for taint */
     register STRLEN len;
     STRLEN tlen;
     char *junk;
@@ -2363,10 +2366,8 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
     if (name)
        if (namlen >= 0)
            mg->mg_ptr = savepvn(name, namlen);
-       else if (namlen == HEf_SVKEY) {
-           dTHR;               /* just for SvREFCNT_inc */
+       else if (namlen == HEf_SVKEY)
            mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
-       }
     
     switch (how) {
     case 0:
@@ -3582,7 +3583,6 @@ sv_reset(register char *s, HV *stash)
                sv = GvSV(gv);
                (void)SvOK_off(sv);
                if (SvTYPE(sv) >= SVt_PV) {
-                   dTHR;       /* just for taint */
                    SvCUR_set(sv, 0);
                    if (SvPVX(sv) != Nullch)
                        *SvPVX(sv) = '\0';
@@ -3801,7 +3801,6 @@ sv_pvn_force(SV *sv, STRLEN *lp)
            *SvEND(sv) = '\0';
        }
        if (!SvPOK(sv)) {
-           dTHR;       /* just for taint */
            SvPOK_on(sv);               /* validate pointer */
            SvTAINT(sv);
            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",

diff --git a/sv.h b/sv.h
index 1adaffe..ffcc4aa 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -490,7 +490,14 @@ struct xpvio {
 #define SvTAINTED_on(sv)  STMT_START{ if(tainting){sv_taint(sv);}   }STMT_END
 #define SvTAINTED_off(sv) STMT_START{ if(tainting){sv_untaint(sv);} }STMT_END
 
-#define SvTAINT(sv)      STMT_START{ if(tainted){SvTAINTED_on(sv);} }STMT_END
+#define SvTAINT(sv)                    \
+    STMT_START {                       \
+       if (tainting) {                 \
+           dTHR;                       \
+           if (tainted)                \
+               SvTAINTED_on(sv);       \
+       }                               \
+    } STMT_END
 
 #define SvPV_force(sv, lp) sv_pvn_force(sv, &lp)
 #define SvPV(sv, lp) sv_pvn(sv, &lp)

diff --git a/thread.h b/thread.h
index b6397cb..2328f7e 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -5,7 +5,6 @@
 #else
 
 /* POSIXish threads */
-typedef pthread_t perl_os_thread;
 #ifdef OLD_PTHREADS_API
 #  define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
 #  define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)