From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sun, 10 Jun 2001 15:01:08 +0000 (+0000)
Subject: Integrate mainline
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3697daca46626be7588b55af4ba9e1ac215bc180;p=p5sagit%2Fp5-mst-13.2.git

Integrate mainline

p4raw-id: //depot/perlio@10499
---

diff --git a/Changes b/Changes
index 220c3a3..5918b63 100644
--- a/Changes
+++ b/Changes
@@ -31,6 +31,144 @@ or any other branch.
 Version v5.7.1		Development release working toward v5.8
 --------------
 ____________________________________________________________________________
+[ 10495] By: jhi                                   on 2001/06/10  10:55:34
+        Log: Subject: Re: pragma/locale.t #107
+             From: Hugo <hv@crypt.compulink.co.uk>
+             Date: Sun, 10 Jun 2001 11:23:30 +0100
+             Message-Id: <200106101023.LAA32085@crypt.compulink.co.uk>
+             
+             Encapsulate the scan of the decimal radix separator.
+     Branch: perl
+	   ! embed.h embed.pl proto.h sv.c
+____________________________________________________________________________
+[ 10494] By: jhi                                   on 2001/06/10  03:00:17
+        Log: Try to grok numbers both with the locale specific separator
+             and with the usual "." (if different from the lss); add a test
+             to locale.t to do also a little bit of math in addition to just
+             equalness testing; remove extraneous logic as suggested in
+             
+             Subject: Re: pragma/locale.t #107
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Sat, 9 Jun 2001 22:37:36 +0100
+             Message-ID: <20010609223735.Y76396@plum.flirble.org>
+     Branch: perl
+	   ! sv.c t/pragma/locale.t
+____________________________________________________________________________
+[ 10493] By: jhi                                   on 2001/06/10  01:25:23
+        Log: Metaconfig unit change for #10492.
+     Branch: metaconfig/U/perl
+	   ! Extensions.U
+____________________________________________________________________________
+[ 10492] By: jhi                                   on 2001/06/10  01:23:59
+        Log: Subject: [PATCH] Don't build Thread.pm if USEITHREADS
+             From: Artur Bergman <artur@contiller.se> 
+             Date: Sat, 09 Jun 2001 21:03:51 +0200
+             Message-ID: <B7483FB6.1398%artur@contiller.se>
+     Branch: perl
+	   ! Configure
+____________________________________________________________________________
+[ 10491] By: jhi                                   on 2001/06/10  01:15:40
+        Log: Integrate perlio.
+     Branch: perl
+	  !> perlsfio.h
+____________________________________________________________________________
+[ 10490] By: jhi                                   on 2001/06/10  01:08:26
+        Log: Do locale specific separator if only in locale.
+     Branch: perl
+	   ! util.c
+____________________________________________________________________________
+[ 10489] By: nick                                  on 2001/06/09  19:13:25
+        Log: Make XS/Typemap compile (but fail) with sfio
+     Branch: perlio
+	   ! perlsfio.h
+____________________________________________________________________________
+[ 10488] By: nick                                  on 2001/06/09  19:12:51
+        Log: Re-integrate mainline
+     Branch: perlio
+	  !> embed.h embed.pl embedvar.h intrpvar.h perl.h perlapi.h
+	  !> proto.h sv.c util.c
+____________________________________________________________________________
+[ 10487] By: nick                                  on 2001/06/09  16:26:29
+        Log: Integrate mainline
+     Branch: perlio
+	  !> (integrate 31 files)
+____________________________________________________________________________
+[ 10486] By: jhi                                   on 2001/06/09  16:11:51
+        Log: Subject: [PATCH] New attempt to clone callack
+             From: Artur Bergman <artur@contiller.se> 
+             Date: Thu, 07 Jun 2001 11:52:16 +0200
+             Message-ID: <B7451B6F.12B7%artur@contiller.se>
+     Branch: perl
+	   ! embedvar.h intrpvar.h perlapi.h sv.c
+____________________________________________________________________________
+[ 10485] By: jhi                                   on 2001/06/09  15:23:52
+        Log: Numeric conversion tweaks suggested by Hugo and Nicholas.
+     Branch: perl
+	   ! embed.h embed.pl perl.h proto.h sv.c util.c
+____________________________________________________________________________
+[ 10484] By: jhi                                   on 2001/06/09  14:47:25
+        Log: Subject: Re: pragma/locale.t #107
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Sat, 9 Jun 2001 16:26:10 +0100
+             Message-ID: <20010609162609.V76396@plum.flirble.org>
+             
+             A missing NVification.
+     Branch: perl
+	   ! sv.c
+____________________________________________________________________________
+[ 10483] By: jhi                                   on 2001/06/08  19:40:32
+        Log: Redo the #10482, there already was a test script for formats.
+     Branch: perl
+	   - t/io/format.t
+	   ! MANIFEST t/op/write.t
+____________________________________________________________________________
+[ 10482] By: jhi                                   on 2001/06/08  19:34:45
+        Log: Twisted format testing, from Merijn.
+     Branch: perl
+	   + t/io/format.t
+	   ! MANIFEST
+____________________________________________________________________________
+[ 10481] By: jhi                                   on 2001/06/08  19:21:56
+        Log: More \p{In...} testing, combined with \N{...}.
+     Branch: perl
+	   ! lib/utf8_heavy.pl t/op/pat.t
+____________________________________________________________________________
+[ 10480] By: jhi                                   on 2001/06/08  14:16:06
+        Log: Metaconfig changes for #10479.
+     Branch: metaconfig
+	   ! U/Glossary.patch
+     Branch: metaconfig/U/perl
+	   ! d_modfl.U
+____________________________________________________________________________
+[ 10479] By: jhi                                   on 2001/06/08  14:15:32
+        Log: Be inspired more by Hugo-- introduce HAS_MODFL_POW32_BUG.
+     Branch: perl
+	   ! Configure Porting/Glossary Porting/config.sh Porting/config_H
+	   ! config_h.SH configure.com epoc/config.sh pp.c uconfig.h
+	   ! uconfig.sh vos/config.alpha.def vos/config.ga.def
+	   ! win32/config.bc win32/config.gc win32/config.vc
+____________________________________________________________________________
+[ 10478] By: jhi                                   on 2001/06/08  12:20:41
+        Log: Subject: Re: [PATCH perl@10439] fix old $^S description in perlvms.pod
+             From: "Craig A. Berry" <craigberry@mac.com>
+             Date: Thu, 7 Jun 2001 14:27:20 -0500
+             Message-Id: <a05100e01b7458075db7d@[172.16.52.1]>
+     Branch: perl
+	   ! vms/perlvms.pod
+____________________________________________________________________________
+[ 10477] By: jhi                                   on 2001/06/08  12:19:00
+        Log: Subject: [PATCH] Unresolved symbol in ext/re/re.xs
+             From: Gisle Aas <gisle@ActiveState.com>
+             Date: 07 Jun 2001 17:04:29 -0700
+             Message-ID: <lrae3jsupe.fsf@caliper.ActiveState.com>
+     Branch: perl
+	   ! ext/re/re.xs
+____________________________________________________________________________
+[ 10476] By: jhi                                   on 2001/06/08  01:35:42
+        Log: Update Changes.
+     Branch: perl
+	   ! Changes patchlevel.h
+____________________________________________________________________________
 [ 10475] By: jhi                                   on 2001/06/08  00:53:45
         Log: Regen Glossary et alia.
      Branch: perl
diff --git a/Configure b/Configure
index 7ba331a..f01329f 100755
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
 #
-# Generated on Fri Jun  8 18:06:31 EET DST 2001 [metaconfig 3.0 PL70]
+# Generated on Sun Jun 10 05:21:37 EET DST 2001 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >c1$$ <<EOF
@@ -15985,8 +15985,11 @@ for xxx in $known_extensions ; do
 		esac
 		;;
 	Thread|thread)
-		case "$usethreads" in 
-		true|$define|y) avail_ext="$avail_ext $xxx" ;;
+                case "$usethreads" in
+                true|$define|y)
+                        case "$useithreads" in
+                        $undef|false|[nN]*) avail_ext="$avail_ext $xxx" ;;
+                        esac
 		esac
 		;;
 	IPC/SysV|ipc/sysv)
diff --git a/embed.h b/embed.h
index 36f2728..80500da 100644
--- a/embed.h
+++ b/embed.h
@@ -1115,6 +1115,7 @@
 #define gv_share		S_gv_share
 #  endif
 #define grok_number		S_grok_number
+#define grok_numeric_radix	S_grok_numeric_radix
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
 #define check_uni		S_check_uni
@@ -2609,6 +2610,7 @@
 #define gv_share(a)		S_gv_share(aTHX_ a)
 #  endif
 #define grok_number(a,b,c)	S_grok_number(aTHX_ a,b,c)
+#define grok_numeric_radix(a,b)	S_grok_numeric_radix(aTHX_ a,b)
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
 #define check_uni()		S_check_uni(aTHX)
@@ -5083,6 +5085,8 @@
 #  endif
 #define S_grok_number		CPerlObj::S_grok_number
 #define grok_number		S_grok_number
+#define S_grok_numeric_radix	CPerlObj::S_grok_numeric_radix
+#define grok_numeric_radix	S_grok_numeric_radix
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
 #define S_check_uni		CPerlObj::S_check_uni
diff --git a/embed.pl b/embed.pl
index 67e142a..5557eab 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2522,6 +2522,7 @@ s	|I32	|expect_number	|char** pattern
 s	|SV*	|gv_share	|SV *sv
 #  endif
 s	|int	|grok_number	|const char *pv|STRLEN len|UV *valuep
+s	|bool	|grok_numeric_radix|const char **sp|const char *send
 #endif
 
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
diff --git a/patchlevel.h b/patchlevel.h
index 47ccbe7..8dcc7fe 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -70,7 +70,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static	char	*local_patches[] = {
         NULL
-	,"DEVEL10475"
+	,"DEVEL10495"
 	,NULL
 };
 
diff --git a/proto.h b/proto.h
index 5005708..f4706ed 100644
--- a/proto.h
+++ b/proto.h
@@ -1246,6 +1246,7 @@ STATIC I32	S_expect_number(pTHX_ char** pattern);
 STATIC SV*	S_gv_share(pTHX_ SV *sv);
 #  endif
 STATIC int	S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep);
+STATIC int	S_grok_numeric_radix(pTHX_ const char **sp, const char *send);
 #endif
 
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
diff --git a/sv.c b/sv.c
index aeb471d..4b86aab 100644
--- a/sv.c
+++ b/sv.c
@@ -1494,6 +1494,30 @@ S_not_a_number(pTHX_ SV *sv)
 #define IS_NUMBER_NEG		      0x08 /* leading minus sign */
 #define IS_NUMBER_INFINITY	      0x10 /* this is big */
 
+static bool
+S_grok_numeric_radix(pTHX_ const char **sp, const char *send)
+{
+#ifdef USE_LOCALE_NUMERIC
+    if (PL_numeric_radix_sv && IN_LOCALE) { 
+        STRLEN len;
+        char* radix = SvPV(PL_numeric_radix_sv, len);
+        if (*sp + len <= send && memEQ(*sp, radix, len)) {
+            *sp += len;
+            return TRUE; 
+        }
+    }
+    /* always try "." if numeric radix didn't match because
+     * we may have data from different locales mixed */
+#endif
+    if (*sp < send && **sp == '.') {
+        ++*sp;
+        return TRUE;
+    }
+    return FALSE;
+}
+
+#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+
 static int
 S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
 {
@@ -1503,9 +1527,6 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
     const char max_mod_10 = UV_MAX % 10 + '0';
     int numtype = 0;
     int sawinf = 0;
-    char* radix = ".";
-    STRLEN radixlen = 1;
-	  
 
     while (isSPACE(*s))
 	s++;
@@ -1516,11 +1537,6 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
     else if (*s == '+')
 	s++;
 
-#ifdef USE_LOCALE_NUMERIC
-    if (PL_numeric_radix_sv && IN_LOCALE)
-        radix = SvPV(PL_numeric_radix_sv, radixlen);
-#endif
-
     /* next must be digit or the radix separator or beginning of infinity */
     if (isDIGIT(*s)) {
 	/* UVs are at least 32 bits, so the first 9 decimal digits cannot
@@ -1589,32 +1605,30 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
 	    *valuep = value;
 
       skip_value:
-	if (s + radixlen <= send && memEQ(s, radix, radixlen)) {
-	    s += radixlen;
+	if (GROK_NUMERIC_RADIX(&s, send)) {
 	    numtype |= IS_NUMBER_NOT_INT;
 	    while (isDIGIT(*s))  /* optional digits after the radix */
 	        s++;
 	}
     }
-    else if (s + radixlen <= send && memEQ(s, radix, radixlen)) {
-       s += radixlen;
-       numtype |= IS_NUMBER_NOT_INT;
-       /* no digits before the radix means we need digits after it */
-       if (isDIGIT(*s)) {
-	   do {
-	       s++;
-	   } while (isDIGIT(*s));
-	   numtype |= IS_NUMBER_IN_UV;
-	   if (valuep) {
-	       /* integer approximation is valid - it's 0.  */
-	       *valuep = 0;
-	   }
-       }
-       else
-	 return 0;
+    else if (GROK_NUMERIC_RADIX(&s, send)) {
+        numtype |= IS_NUMBER_NOT_INT;
+	/* no digits before the radix means we need digits after it */
+	if (isDIGIT(*s)) {
+	    do {
+	        s++;
+	    } while (isDIGIT(*s));
+	    numtype |= IS_NUMBER_IN_UV;
+	    if (valuep) {
+	        /* integer approximation is valid - it's 0.  */
+	        *valuep = 0;
+	    }
+	}
+	else
+	    return 0;
     }
     else if (*s == 'I' || *s == 'i') {
-	s++; if (*s != 'N' && *s != 'n') return 0;
+        s++; if (*s != 'N' && *s != 'n') return 0;
 	s++; if (*s != 'F' && *s != 'f') return 0;
 	s++; if (*s == 'I' || *s == 'i') {
 	    s++; if (*s != 'N' && *s != 'n') return 0;
@@ -2423,7 +2437,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	    sv_upgrade(sv, SVt_PVNV);
 	else
 	    sv_upgrade(sv, SVt_NV);
-#if defined(USE_LONG_DOUBLE)
+#ifdef USE_LONG_DOUBLE
 	DEBUG_c({
 	    STORE_NUMERIC_LOCAL_SET_STANDARD();
 	    PerlIO_printf(Perl_debug_log,
@@ -2445,9 +2459,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) {
 	SvNOK_on(sv);
     }
-    else if (SvIOKp(sv) &&
-	     (!SvPOKp(sv) || !grok_number(SvPVX(sv), SvCUR(sv),NULL)))
-    {
+    else if (SvIOKp(sv)) {
 	SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
 #ifdef NV_PRESERVES_UV
 	SvNOK_on(sv);
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index df6df60..0926a6e 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -45,7 +45,7 @@ eval {
 # and mingw32 uses said silly CRT
 $have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
 
-my $last = $have_setlocale ? 116 : 98;
+my $last = $have_setlocale ? &last : &last_without_setlocale;
 
 print "1..$last\n";
 
@@ -235,6 +235,8 @@ check_taint_not  97, $2;
 
 check_taint_not  98, $a;
 
+sub last_without_setlocale { 98 }
+
 # I think we've seen quite enough of taint.
 # Let us do some *real* locale work now,
 # unless setlocale() is missing (i.e. minitest).
@@ -638,7 +640,7 @@ foreach $Locale (@Locale) {
 	my $w = 0;
 	local $SIG{__WARN__} =
 	    sub {
-		print "# @_";
+		print "# @_\n";
 		$w++;
 	    };
 
@@ -665,17 +667,20 @@ foreach $Locale (@Locale) {
 	    tryneoalpha($Locale, 110, $e == $c);
 	}
 	
-	tryneoalpha($Locale, 111, $w == 0);
-
 	my $f = "1.23";
+	my $g = 2.34;
 
-	debug "# 112..114: f = $f, locale = $Locale\n";
+	debug "# 111..115: f = $f, g = $g, locale = $Locale\n";
 
-	tryneoalpha($Locale, 112, $f == 1.23);
+	tryneoalpha($Locale, 111, $f == 1.23);
 
-	tryneoalpha($Locale, 113, $f == $x);
+	tryneoalpha($Locale, 112, $f == $x);
 	
-	tryneoalpha($Locale, 114, $f == $c);
+	tryneoalpha($Locale, 113, $f == $c);
+
+	tryneoalpha($Locale, 114, abs(($f + $g) - 3.57) < 0.01);
+
+	tryneoalpha($Locale, 115, $w == 0);
     }
 
     # Does taking lc separately differ from taking
@@ -698,7 +703,7 @@ foreach $Locale (@Locale) {
         my $y = "aa";
         my $z = "AB";
 
-        tryneoalpha($Locale, 115,
+        tryneoalpha($Locale, 116,
 		    lcA($x, $y) == 1 && lcB($x, $y) == 1 ||
 		    lcA($x, $z) == 0 && lcB($x, $z) == 0);
     }
@@ -711,7 +716,7 @@ foreach $Locale (@Locale) {
 	    # utf8 and locales do not mix.
 	    debug "# skipping UTF-8 locale '$Locale'\n";
 	    push @utf8locale, $Locale;
-            $utf8skip{116}++;
+            $utf8skip{117}++;
 	} else {
 	    use locale;
 	    use locale;
@@ -728,9 +733,9 @@ foreach $Locale (@Locale) {
 		next unless lc $y eq $x;
 		push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
 	    }
-	    tryneoalpha($Locale, 116, @f == 0);
+	    tryneoalpha($Locale, 117, @f == 0);
 	    if (@f) {
-		print "# failed 116 locale '$Locale' characters @f\n"
+		print "# failed 117 locale '$Locale' characters @f\n"
   	    }
         }
     }
@@ -738,7 +743,7 @@ foreach $Locale (@Locale) {
 
 # Recount the errors.
 
-foreach (99..$last) {
+foreach (&last_without_setlocale()+1..$last) {
     if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
 	if ($_ == 102) {
 	    print "# The failure of test 102 is not necessarily fatal.\n";
@@ -829,4 +834,6 @@ if ($didwarn) {
     }
 }
 
+sub last { 117 }
+
 # eof
diff --git a/util.c b/util.c
index 9cf667f..ecaf18b 100644
--- a/util.c
+++ b/util.c
@@ -4083,7 +4083,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     I32 offcount;	/* number of digits in least significant part */
 
 #ifdef USE_LOCALE_NUMERIC
-    if (PL_numeric_radix_sv)
+    if (PL_numeric_radix_sv && IN_LOCALE)
 	point = SvPV(PL_numeric_radix_sv, pointlen);
 #endif