Integrate mainline

p4raw-id: //depot/perlio@14635

11 files changed, 161 insertions, 65 deletions

diff --git a/Configure b/Configure
index 6629891071..e44e19a588 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 Feb  8 22:04:29 EET 2002 [metaconfig 3.0 PL70]
+# Generated on Mon Feb 11 00:20:30 EET 2002 [metaconfig 3.0 PL70]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >c1$$ <<EOF
@@ -2317,7 +2317,7 @@ $rm -f blurfl sym
 : determine whether symbolic links are supported
 echo " "
 case "$lns" in
-*"ln -s")
+*"ln$_exe -s")
 	echo "Checking how to test for symbolic links..." >&4
 	$lns blurfl sym
 	if $test "X$issymlink" = X; then
@@ -13511,7 +13511,7 @@ $signal_t bletch(s) int s; { exit(4); }
 #endif
 int main() {
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x4321
-    U8 *buf = (U8*)"\0\0\0\1\0\0\0\0";
+    U8 buf[8];
     U32 *up;
     int i;
 
@@ -13526,6 +13526,15 @@ int main() {
     signal(SIGBUS, bletch);
 #endif
 
+    buf[0] = 0;
+    buf[1] = 0;
+    buf[2] = 0;
+    buf[3] = 1;
+    buf[5] = 0;
+    buf[6] = 0;
+    buf[7] = 0;
+    buf[8] = 1;
+
     for (i = 0; i < 4; i++) {
 	up = (U32*)(buf + i);
 	if (! ((*up == 1 << (8*i)) ||   /* big-endian */
diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c
index 4c53eb09c8..6aa290ec53 100644
--- a/djgpp/djgpp.c
+++ b/djgpp/djgpp.c
@@ -366,6 +366,24 @@ XS(dos_UseLFN)
     XSRETURN_IV (_USE_LFN);
 }
 
+XS(XS_Cwd_sys_cwd)
+{
+    dXSARGS;
+    if (items != 0)
+	Perl_croak_nocontext("Usage: Cwd::sys_cwd()");
+    {
+	char p[MAXPATHLEN];
+	char *	RETVAL;
+	RETVAL = getcwd(p, MAXPATHLEN);
+	ST(0) = sv_newmortal();
+	sv_setpv((SV*)ST(0), RETVAL);
+#ifndef INCOMPLETE_TAINTS
+	SvTAINTED_on(ST(0));
+#endif
+    }
+    XSRETURN(1);
+}
+
 void
 Perl_init_os_extras(pTHX)
 {
@@ -375,6 +393,7 @@ Perl_init_os_extras(pTHX)
     
     newXS ("Dos::GetCwd",dos_GetCwd,file);
     newXS ("Dos::UseLFN",dos_UseLFN,file);
+    newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file);
 
     /* install my File System Extension for globbing */
     __FSEXT_add_open_handler (glob_handler);
diff --git a/lib/ExtUtils/t/Installed.t b/lib/ExtUtils/t/Installed.t
index 17913ecf79..a974e041e3 100644
--- a/lib/ExtUtils/t/Installed.t
+++ b/lib/ExtUtils/t/Installed.t
@@ -26,6 +26,8 @@ use Test::More tests => 43;
 
 BEGIN { use_ok( 'ExtUtils::Installed' ) }
 
+my $noman = ! ($Config{installman1dir} && $Config{installman3dir});
+
 # saves having to qualify package name for class methods
 my $ei = bless( {}, 'ExtUtils::Installed' );
 
@@ -46,8 +48,13 @@ foreach my $path (qw( installman1dir installman3dir )) {
 
 is( $ei->_is_type($Config{prefix} . '/bar', 'prog'), 1, 
 	"... should find prog file under $Config{prefix}" );
-is( $ei->_is_type('bar', 'doc'), 0, 
-	'... should not find doc file outside path' );
+
+SKIP: {
+	skip('no man directories on this system', 1) if $noman;
+	is( $ei->_is_type('bar', 'doc'), 0, 
+		'... should not find doc file outside path' );
+}
+
 is( $ei->_is_type('bar', 'prog'), 0, 
 	'... nor prog file outside path' );
 is( $ei->_is_type('whocares', 'someother'), 0, '... nor other type anywhere' );
@@ -136,11 +143,18 @@ eval { $ei->files('badmod') };
 like( $@, qr/badmod is not installed/,'files() should croak given bad modname');
 eval { $ei->files('goodmod', 'badtype' ) };
 like( $@, qr/type must be/,'files() should croak given bad type' );
-my @files = $ei->files('goodmod', 'doc', $Config{installman1dir});
-is( scalar @files, 1, '... should find doc file under given dir' );
-like( $files[0], qr/foo$/, '... checking file name' );
-@files = $ei->files('goodmod', 'doc');
-is( scalar @files, 2, '... should find all doc files with no dir' );
+
+my @files;
+SKIP: {
+	skip('no man directories on this system', 3) if $noman;
+	
+	@files = $ei->files('goodmod', 'doc', $Config{installman1dir});
+	is( scalar @files, 1, '... should find doc file under given dir' );
+	is( grep({ /foo$/ } @files), 1, '... checking file name' );
+	@files = $ei->files('goodmod', 'doc');
+	is( scalar @files, 2, '... should find all doc files with no dir' );
+}
+
 @files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
 is( scalar @files, 0, '... should find no doc files given wrong dirs' );
 @files = $ei->files('goodmod', 'prog');
@@ -148,25 +162,32 @@ is( scalar @files, 1, '... should find doc file in correct dir' );
 like( $files[0], qr/foobar$/, '... checking file name' );
 @files = $ei->files('goodmod');
 is( scalar @files, 4, '... should find all files with no type specified' );
-my %dirnames = map { $_ => dirname($_) } @files;
+my %dirnames = map { lc($_) => dirname(lc($_)) } @files;
 
 # directories
 my @dirs = $ei->directories('goodmod', 'prog', 'fake');
 is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );
-@dirs = $ei->directories('goodmod', 'doc');
-is( scalar @dirs, 2, '... should find all files files() would' );
-@dirs = $ei->directories('goodmod');
-is( scalar @dirs, 4, '... should find all files files() would, again' );
-@files = sort map { exists $dirnames{$_} ? $dirnames{$_} : '' } @files;
-is( join(' ', @files), join(' ', @dirs), '... should sort output' );
-
-# directory_tree
-my $expectdirs = 
-	dirname($Config{installman1dir}) eq dirname($Config{installman3dir}) ? 3 :2;
-
-@dirs = $ei->directory_tree('goodmod', 'doc', dirname($Config{installman1dir}));
-is( scalar @dirs, $expectdirs, 
-	'directory_tree() should report intermediate dirs to those requested' );
+
+SKIP: {
+	skip('no man directories on this system', 4) if $noman;
+
+	@dirs = $ei->directories('goodmod', 'doc');
+	is( scalar @dirs, 2, '... should find all files files() would' );
+	@dirs = $ei->directories('goodmod');
+	is( scalar @dirs, 4, '... should find all files files() would, again' );
+	@files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } 
+		@files;
+	is( join(' ', @files), join(' ', @dirs), '... should sort output' );
+
+	# directory_tree
+	my $expectdirs = dirname($Config{installman1dir}) eq 
+		dirname($Config{installman3dir}) ? 3 :2;
+
+	@dirs = $ei->directory_tree('goodmod', 'doc', 
+		dirname($Config{installman1dir}));
+	is( scalar @dirs, $expectdirs, 
+		'directory_tree() should report intermediate dirs to those requested' );
+}
 
 my $fakepak = Fakepak->new(102);
 
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index 3ac1060f0c..529e34fe84 100644
--- a/lib/File/Spec.pm
+++ b/lib/File/Spec.pm
@@ -11,6 +11,7 @@ my %module = (MacOS   => 'Mac',
 	      VMS     => 'VMS',
 	      epoc    => 'Epoc',
 	      NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
+              dos     => 'OS2',   # Yes, File::Spec::OS2 works on DJGPP.
 	      cygwin  => 'Cygwin');
 
 
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 2a8b2bfa2c..c1996b0852 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -398,12 +398,12 @@ warnLevel($warnLevel);
 dieLevel($dieLevel);
 signalLevel($signalLevel);
 
-&pager(
-    (defined($ENV{PAGER}) 
-	? $ENV{PAGER}
-	: ($^O eq 'os2' 
-	   ? 'cmd /c more' 
-	   : 'more'))) unless defined $pager;
+pager(
+      defined $ENV{PAGER}              ? $ENV{PAGER} :
+      eval { require Config } && 
+        defined $Config::Config{pager} ? $Config::Config{pager}
+                                       : 'more'
+     ) unless defined $pager;
 setman();
 &recallCommand("!") unless defined $prc;
 &shellBang("!") unless defined $psh;
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 791b302d18..5be9ced695 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2782,7 +2782,9 @@ marked by <-- HERE in m/%s/
 
 (F) The class in the character class [: :] syntax is unknown.  The <-- HERE
 shows in the regular expression about where the problem was discovered.
-See L<perlre>.
+Note that the POSIX character classes do B<not> have the C<is> prefix
+the corresponding C interfaces have: in other words, it's C<[[:print:]]>,
+not C<isprint>.  See L<perlre>.
 
 =item POSIX getpgrp can't take an argument
 
diff --git a/pod/perlport.pod b/pod/perlport.pod
index 9b81ca5d8b..df304154c1 100644
--- a/pod/perlport.pod
+++ b/pod/perlport.pod
@@ -318,18 +318,22 @@ the user to override the default location of the file.
 Don't assume a text file will end with a newline.  They should,
 but people forget.
 
-Do not have two files of the same name with different case, like
-F<test.pl> and F<Test.pl>, as many platforms have case-insensitive
-filenames.  Also, try not to have non-word characters (except for C<.>)
-in the names, and keep them to the 8.3 convention, for maximum
-portability, onerous a burden though this may appear.
+Do not have two files or directories of the same name with different
+case, like F<test.pl> and F<Test.pl>, as many platforms have
+case-insensitive (or at least case-forgiving) filenames.  Also, try
+not to have non-word characters (except for C<.>) in the names, and
+keep them to the 8.3 convention, for maximum portability, onerous a
+burden though this may appear.
 
 Likewise, when using the AutoSplit module, try to keep your functions to
 8.3 naming and case-insensitive conventions; or, at the least,
 make it so the resulting files have a unique (case-insensitively)
 first 8 characters.
 
-Whitespace in filenames is tolerated on most systems, but not all.
+Whitespace in filenames is tolerated on most systems, but not all,
+and even on systems where it might be tolerated, some utilities
+might becoem confused by such whitespace.
+
 Many systems (DOS, VMS) cannot have more than one C<.> in their filenames.
 
 Don't assume C<< > >> won't be the first character of a filename.
@@ -343,6 +347,20 @@ with C<sysopen> instead of C<open>.  C<open> is magic and can
 translate characters like C<< > >>, C<< < >>, and C<|>, which may
 be the wrong thing to do.  (Sometimes, though, it's the right thing.)
 
+Don't use C<:> as a part of a filename since many systems use that for
+their own semantics (MacOS Classic for separating pathname components,
+many networking schemes and utilities for separating the nodename and
+the pathname, and so on).
+
+The I<portable filename characters> as defined by ANSI C are
+
+ a b c d e f g h i j k l m n o p q r t u v w x y z
+ A B C D E F G H I J K L M N O P Q R T U V W X Y Z
+ 0 1 2 3 4 5 6 7 8 9
+ . _ -
+
+and the "-" shouldn't be the first character.
+
 =head2 System Interaction
 
 Not all platforms provide a command line.  These are usually platforms
@@ -502,15 +520,20 @@ to get what should be the proper value on any system.
 
 =head2 Character sets and character encoding
 
-Assume little about character sets.  Assume nothing about
-numerical values (C<ord>, C<chr>) of characters.  Do not
-assume that the alphabetic characters are encoded contiguously (in
-the numeric sense).  Do not assume anything about the ordering of the
-characters.  The lowercase letters may come before or after the
-uppercase letters; the lowercase and uppercase may be interlaced so
-that both `a' and `A' come before `b'; the accented and other
-international characters may be interlaced so that E<auml> comes
-before `b'.
+Assume very little about character sets.
+
+Assume nothing about numerical values (C<ord>, C<chr>) of characters.
+Do not use explicit code point ranges (like \xHH-\xHH); use for
+example symbolic character classes like C<[:print:]>.
+
+Do not assume that the alphabetic characters are encoded contiguously
+(in the numeric sense).  There may be gaps.
+
+Do not assume anything about the ordering of the characters.
+The lowercase letters may come before or after the uppercase letters;
+the lowercase and uppercase may be interlaced so that both `a' and `A'
+come before `b'; the accented and other international characters may
+be interlaced so that E<auml> comes before `b'.
 
 =head2 Internationalisation
 
diff --git a/pp_pack.c b/pp_pack.c
index 03bf3c83b0..25cd592af8 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -449,7 +449,7 @@ PP(pp_unpack)
 	    if (checksum) {
 		while (len-- > 0 && s < strend) {
 		    STRLEN alen;
-		    auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0);
+		    auint = UNI_TO_NATIVE(utf8n_to_uvchr((U8*)s, strend - s, &alen, 0));
 		    along = alen;
 		    s += along;
 		    if (checksum > bits_in_uv)
@@ -463,7 +463,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 		while (len-- > 0 && s < strend) {
 		    STRLEN alen;
-		    auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0);
+		    auint = UNI_TO_NATIVE(utf8n_to_uvchr((U8*)s, strend - s, &alen, 0));
 		    along = alen;
 		    s += along;
 		    sv = NEWSV(37, 0);
@@ -1558,7 +1558,7 @@ PP(pp_pack)
 	case 'U':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		auint = SvUV(fromstr);
+		auint = NATIVE_TO_UNI(SvUV(fromstr));
 		SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1);
 		SvCUR_set(cat, (char*)uvchr_to_utf8((U8*)SvEND(cat),auint)
 			       - SvPVX(cat));
diff --git a/regcomp.c b/regcomp.c
index 7850492497..7e1e6bd6d5 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -3188,16 +3188,22 @@ tryagain:
 				   foldlen;
 				   foldlen -= numlen) {
 				   ender = utf8_to_uvchr(foldbuf, &numlen);
-				   reguni(pRExC_state, ender, s, &numlen);
-				   s       += numlen;
-				   len     += numlen;
-				   foldbuf += numlen;
+				   if (numlen > 0) {
+					reguni(pRExC_state, ender, s, &numlen);
+					s       += numlen;
+					len     += numlen;
+					foldbuf += numlen;
+				   }
+				   else
+					break; /* "Can't happen." */
 			      }
 			 }
 			 else {
 			      reguni(pRExC_state, ender, s, &numlen);
-			      s   += numlen;
-			      len += numlen;
+			      if (numlen > 0) {
+				   s   += numlen;
+				   len += numlen;
+			      }
 			 }
 		    }
 		    else {
@@ -3213,16 +3219,22 @@ tryagain:
 			       foldlen;
 			       foldlen -= numlen) {
 			       ender = utf8_to_uvchr(foldbuf, &numlen);
-			       reguni(pRExC_state, ender, s, &numlen);
-			       s       += numlen;
-			       len     += numlen;
-			       foldbuf += numlen;
+			       if (numlen > 0) {
+				    reguni(pRExC_state, ender, s, &numlen);
+				    s       += numlen;
+				    len     += numlen;
+				    foldbuf += numlen;
+			       }
+			       else
+				    break;
 			  }
 		     }
 		     else {
 			  reguni(pRExC_state, ender, s, &numlen);
-			  s   += numlen;
-			  len += numlen;
+			  if (numlen > 0) {
+			       s   += numlen;
+			       len += numlen;
+			  }
 		     }
 		     len--;
 		}
diff --git a/t/op/arith.t b/t/op/arith.t
index a607e60149..4205345a7e 100755
--- a/t/op/arith.t
+++ b/t/op/arith.t
@@ -1,6 +1,6 @@
 #!./perl -w
 
-print "1..132\n";
+print "1..133\n";
 
 sub try ($$) {
    print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
@@ -264,4 +264,8 @@ tryeq 130, 18446744073709551616/9223372036854775808, 2;
   # -167772160. It's actually undefined behaviour, so anything may happen.
   my $int = ($n % 1000) * 167772160;
   tryeq 132, $int, 21307064320;
+
+  my $t = time;
+  my $t1000 = time() * 1000;
+  try 133, abs($t1000 -1000 * $t) <= 2000;
 }
diff --git a/t/op/pack.t b/t/op/pack.t
index 38d015bd01..d1a8032beb 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -531,8 +531,13 @@ EOP
   is($z, $expect);
 }
 
-is("1.20.300.4000", sprintf "%vd", pack("U*",1,20,300,4000));
-is("1.20.300.4000", sprintf "%vd", pack("  U*",1,20,300,4000));
+
+SKIP: {
+    skip("(EBCDIC and) version strings are bad idea", 2) if $Is_EBCDIC;
+
+    is("1.20.300.4000", sprintf "%vd", pack("U*",1,20,300,4000));
+    is("1.20.300.4000", sprintf "%vd", pack("  U*",1,20,300,4000));
+}
 isnt(v1.20.300.4000, sprintf "%vd", pack("C0U*",1,20,300,4000));
 
 my $rslt = $Is_EBCDIC ? "156 67" : "199 162";