X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=reentr.pl;h=ddbfab36f197b81006fbfb6700041e28b4c0739c;hb=d1bd4ef0a107c19b597b3c5d49a9b6836c36909f;hp=cdce54e53a850903dedbe0a6ff39585aaff08a4b;hpb=e06c4d37e9c075c9a909e0cdf8fdf9d851bbe1a4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/reentr.pl b/reentr.pl
index cdce54e..ddbfab3 100644
--- a/reentr.pl
+++ b/reentr.pl
@@ -42,13 +42,14 @@ my %map = (
 
 safer_unlink 'reentr.h';
 die "reentr.h: $!" unless open(H, ">reentr.h");
+binmode H;
 select H;
 print <<EOF;
 /* -*- buffer-read-only: t -*-
  *
  *    reentr.h
  *
- *    Copyright (C) 2002, 2003, 2005 by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -60,13 +61,29 @@ print <<EOF;
 #ifndef REENTR_H
 #define REENTR_H
 
+/* If compiling for a threaded perl, we will macro-wrap the system/library
+ * interfaces (e.g. getpwent()) which have threaded versions
+ * (e.g. getpwent_r()), which will handle things correctly for
+ * the Perl interpreter, but otherwise (for XS) the wrapping does
+ * not take place.  See L<perlxs/Thread-aware system interfaces>.
+ */
+
+#ifndef PERL_REENTR_API
+# if defined(PERL_CORE) || defined(PERL_EXT)
+#  define PERL_REENTR_API 1
+# else
+#  define PERL_REENTR_API 0
+# endif
+#endif
+
 #ifdef USE_REENTRANT_API
  
 /* Deprecations: some platforms have the said reentrant interfaces
  * but they are declared obsolete and are not to be used.  Often this
  * means that the platform has threadsafed the interfaces (hopefully).
  * All this is OS version dependent, so we are of course fooling ourselves.
- * If you know of more deprecations on some platforms, please add your own. */
+ * If you know of more deprecations on some platforms, please add your own
+ * (by editing reentr.pl, mind!) */
 
 #ifdef __hpux
 #   undef HAS_CRYPT_R
@@ -93,9 +110,9 @@ print <<EOF;
  * memzero out certain structures before calling the functions.
  */
 #if defined(__OpenBSD__)
-#    define REENTR_MEMZERO(a,b) memzero(a,b),
+#    define REENTR_MEMZERO(a,b) memzero(a,b)
 #else
-#    define REENTR_MEMZERO(a,b)
+#    define REENTR_MEMZERO(a,b) 0
 #endif 
 
 #ifdef NETDB_R_OBSOLETE
@@ -183,6 +200,7 @@ while (<DATA>) { # Read in the protypes.
 
     # If given the -U option open up the metaconfig unit for this function.
     if ($opts{U} && open(U, ">d_${func}_r.U"))  {
+    	binmode U;
 	select U;
     }
 
@@ -347,7 +365,7 @@ sub pushssif {
 sub pushinitfree {
     my $func = shift;
     push @init, <<EOF;
-	New(31338, PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char);
+	Newx(PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char);
 EOF
     push @free, <<EOF;
 	Safefree(PL_reentrant_buffer->_${func}_buffer);
@@ -545,7 +563,7 @@ EOF
 	    push @size, <<EOF;
 #   if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__)
 	PL_reentrant_buffer->$sz = sysconf($sc);
-	if (PL_reentrant_buffer->$sz == -1)
+	if (PL_reentrant_buffer->$sz == (size_t) -1)
 		PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
 #   else
 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
@@ -595,7 +613,7 @@ EOF
 EOF
 	    push @init, <<EOF;
 #if   !($D)
-	New(31338, PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char);
+	Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char);
 #endif
 EOF
 	    push @free, <<EOF;
@@ -632,6 +650,7 @@ EOF
 	push @wrap, $ifdef;
 
 	push @wrap, <<EOF;
+#  if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1)
 #   undef $func
 EOF
 
@@ -696,13 +715,17 @@ EOF
 			 } split '', $b;
 		$w = ", $w" if length $v;
 	    }
+
 	    my $call = "${func}_r($v$w)";
+	    if ($func eq 'localtime') {
+		$call = "L_R_TZSET $call";
+	    }
 
             # Must make OpenBSD happy
             my $memzero = '';
             if($p =~ /D$/ &&
                 ($genfunc eq 'protoent' || $genfunc eq 'servent')) {
-                $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data))';
+                $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data)),';
             }
 	    push @wrap, <<EOF;
 #   if !defined($func) && ${FUNC}_R_PROTO == REENTRANT_PROTO_$p
@@ -716,7 +739,7 @@ EOF
 		    my $rv = $v ? ", $v" : "";
 		    if ($r eq 'I') {
 			push @wrap, <<EOF;
-#       define $func($v) ($memzero(PL_reentrant_retint = $call)$test ? $true : (((PL_reentrant_retint == ERANGE) || (errno == ERANGE)) ? ($seent{$func} *) Perl_reentrant_retry("$func"$rv) : 0))
+#       define $func($v) ($memzero(PL_reentrant_retint = $call)$test ? $true : ((PL_reentrant_retint == ERANGE) ? ($seent{$func} *) Perl_reentrant_retry("$func"$rv) : 0))
 EOF
 		    } else {
 			push @wrap, <<EOF;
@@ -730,10 +753,14 @@ EOF
 		}
 	    }
 	    push @wrap, <<EOF;
-#   endif
+#  endif /* if defined(PERL_REENTR_API) && (PERL_REENTR_API+0 == 1) */
 EOF
 	}
 
+	    push @wrap, <<EOF;
+#   endif /* HAS_\U$func */
+EOF
+
 	push @wrap, $endif, "\n";
     }
 }
@@ -767,13 +794,14 @@ close(H);
 
 safer_unlink 'reentr.c';
 die "reentr.c: $!" unless open(C, ">reentr.c");
+binmode C;
 select C;
 print <<EOF;
 /* -*- buffer-read-only: t -*-
  *
  *    reentr.c
  *
- *    Copyright (C) 2002, 2003, 2005 by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -809,7 +837,7 @@ Perl_reentrant_size(pTHX) {
 void
 Perl_reentrant_init(pTHX) {
 #ifdef USE_REENTRANT_API
-	New(31337, PL_reentrant_buffer, 1, REENTR);
+	Newx(PL_reentrant_buffer, 1, REENTR);
 	Perl_reentrant_size(aTHX);
 @init
 #endif /* USE_REENTRANT_API */
@@ -828,6 +856,9 @@ Perl_reentrant_retry(const char *f, ...)
 {
     dTHX;
     void *retptr = NULL;
+    va_list ap;
+    va_start(ap, f);
+    {
 #ifdef USE_REENTRANT_API
 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
     void *p0;
@@ -841,9 +872,6 @@ Perl_reentrant_retry(const char *f, ...)
 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
     int anint;
 #  endif
-    va_list ap;
-
-    va_start(ap, f);
 
     switch (PL_op->op_type) {
 #ifdef USE_HOSTENT_BUFFER
@@ -1046,9 +1074,11 @@ Perl_reentrant_retry(const char *f, ...)
 	/* Not known how to retry, so just fail. */
 	break;
     }
-
-    va_end(ap);
+#else
+    PERL_UNUSED_ARG(f);
 #endif
+    }
+    va_end(ap);
     return retptr;
 }