integrate cfgperl contents into mainline

p4raw-id: //depot/perl@3516

11 files changed, 183 insertions, 94 deletions

diff --git a/t/TEST b/t/TEST
index 3685c2a45f..25b8a395ba 100755
--- a/t/TEST
+++ b/t/TEST
@@ -1,6 +1,6 @@
 #!./perl
 
-# Last change: Fri Jan 10 09:57:03 WET 1997
+# Last change: Fri May 28 03:16:57 BST 1999
 
 # This is written in a peculiar style, since we're trying to avoid
 # most of the constructs we'll be testing for.
@@ -150,12 +150,12 @@ EOT
 	}
     }
     else {
-	$pct = sprintf("%.2f", $good / $total * 100);
+	$pct = sprintf("%.2f", ($files - $bad) / $files * 100);
 	if ($bad == 1) {
-	    warn "Failed 1 test script out of $total, $pct% okay.\n";
+	    warn "Failed 1 test script out of $files, $pct% okay.\n";
 	}
 	else {
-	    warn "Failed $bad test scripts out of $total, $pct% okay.\n";
+	    warn "Failed $bad test scripts out of $files, $pct% okay.\n";
 	}
 	warn <<'SHRDLU';
    ### Since not all tests were successful, you may want to run some
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 1c72440478..37949c4546 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -61,6 +61,7 @@ if ($^O eq 'vmesa') {
 	exec 'echo', 'not ok 6';
     }
 }
+wait;				# Collect from $pid
 
 pipe(READER,WRITER) || die "Can't open pipe";
 close READER;
@@ -134,7 +135,6 @@ else {
 }
 
 # check that status for the correct process is collected
-wait;				# Collect from $pid
 my $zombie = fork or exit 37;
 my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
 $SIG{ALRM} = sub { return };
diff --git a/t/lib/bigfloatpm.t b/t/lib/bigfloatpm.t
index ebec667280..42cd9583d1 100755
--- a/t/lib/bigfloatpm.t
+++ b/t/lib/bigfloatpm.t
@@ -185,9 +185,9 @@ $Math::BigFloat::rnd_mode = 'trunc'
 -1.35:-1:-1.3
 -0.006:-1:0
 -0.006:-2:0
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = 'zero'
 +2.23:-1:2.2
 -2.23:-1:-2.2
@@ -198,10 +198,10 @@ $Math::BigFloat::rnd_mode = 'zero'
 +2.35:-1:2.3
 -2.35:-1:-2.3
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = '+inf'
 +3.23:-1:3.2
 -3.23:-1:-3.2
@@ -212,10 +212,10 @@ $Math::BigFloat::rnd_mode = '+inf'
 +3.35:-1:3.4
 -3.35:-1:-3.3
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = '-inf'
 +4.23:-1:4.2
 -4.23:-1:-4.2
@@ -226,10 +226,10 @@ $Math::BigFloat::rnd_mode = '-inf'
 +4.35:-1:4.3
 -4.35:-1:-4.4
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.007
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = 'odd'
 +5.23:-1:5.2
 -5.23:-1:-5.2
@@ -240,10 +240,10 @@ $Math::BigFloat::rnd_mode = 'odd'
 +5.35:-1:5.3
 -5.35:-1:-5.3
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.007
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 $Math::BigFloat::rnd_mode = 'even'
 +6.23:-1:6.2
 -6.23:-1:-6.2
@@ -254,10 +254,10 @@ $Math::BigFloat::rnd_mode = 'even'
 +6.35:-1:6.4
 -6.35:-1:-6.4
 -0.0065:-1:0
--0.0065:-2:-0.01
--0.0065:-3:-0.006
--0.0065:-4:-0.0065
--0.0065:-5:-0.0065
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.0065|-6\.5e-03
+-0.0065:-5:/-0\.0065|-6\.5e-03
 &fcmp
 abc:abc:
 abc:+0:
diff --git a/t/lib/io_linenum.t b/t/lib/io_linenum.t
index 0d28e1898c..3503215201 100755
--- a/t/lib/io_linenum.t
+++ b/t/lib/io_linenum.t
@@ -1,19 +1,27 @@
 #!./perl
 
-# test added 29th April 1998 by Paul Johnson (pjcj@transeda.com)
+# test added 29th April 1999 by Paul Johnson (pjcj@transeda.com)
+# updated    28th May   1999 by Paul Johnson
 
-BEGIN {
-    chdir 't' if -d 't';
-    unshift @INC, '../lib' if -d '../lib';
+my $File;
+
+BEGIN
+{
+  $File = __FILE__;
+  if (-d 't')
+  {
+    chdir 't';
+    $File =~ s/^t\W+//;                                 # Remove first directory
+  }
+  unshift @INC, '../lib' if -d '../lib';
+  require strict; import strict;
 }
 
-use strict;
-use IO::File;
 use Test;
 
-BEGIN {
-    plan tests => 9 #, todo => [10]
-}
+BEGIN { plan tests => 12 }
+
+use IO::File;
 
 sub lineno
 {
@@ -21,49 +29,52 @@ sub lineno
   my $l;
   $l .= "$. ";
   $l .= $f->input_line_number;
-  $l .= " $.";
+  $l .= " $.";                     # check $. before and after input_line_number
   $l;
 }
 
-sub OK
-{
-  my $s = select STDOUT;                     # work around a bug in Test.pm 1.04
-  &ok;
-  select $s;
-}
-
 my $t;
 
-open (Q, __FILE__) or die $!;
-my $w = IO::File->new(__FILE__) or die $!;
+open (F, $File) or die $!;
+my $io = IO::File->new($File) or die $!;
+
+<F> for (1 .. 10);
+ok(lineno($io), "10 0 10");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "5 5 5");
 
-<Q> for (1 .. 10);
-OK(lineno($w), "10 0 10");
+<F>;
+ok(lineno($io), "11 5 11");
 
-$w->getline for (1 .. 5);
-OK(lineno($w), "5 5 5");
+$io->getline;
+ok(lineno($io), "6 6 6");
 
-<Q>;
-OK(lineno($w), "11 5 11");
+$t = tell F;                                        # tell F; provokes a warning
+ok(lineno($io), "11 6 11");
 
-$w->getline;
-OK(lineno($w), "6 6 6");
+<F>;
+ok(lineno($io), "12 6 12");
 
-$t = tell Q;         # tell Q; provokes a warning - the world is full of bugs...
-OK(lineno($w), "11 6 11");
+select F;
+ok(lineno($io), "12 6 12");
 
-<Q>;
-OK(lineno($w), "12 6 12");
+<F> for (1 .. 10);
+ok(lineno($io), "22 6 22");
 
-select Q;
-OK(lineno($w), "12 6 12");
+$io->getline for (1 .. 5);
+ok(lineno($io), "11 11 11");
 
-<Q> for (1 .. 10);
-OK(lineno($w), "22 6 22");
+$t = tell F;
+# We used to have problems here before local $. worked.
+# input_line_number() used to use select and tell.  When we did the
+# same, that mechanism broke.  It should work now.
+ok(lineno($io), "22 11 22");
+
+{
+  local $.;
+  $io->getline for (1 .. 5);
+  ok(lineno($io), "16 16 16");
+}
 
-$w->getline for (1 .. 5);
-OK(lineno($w), "11 11 11");
-__END__
-# This test doesn't work.  It probably won't until local $. does.
-$t = tell Q;
-OK(lineno($w), "22 11 22", 'waiting for local $.');
+ok(lineno($io), "22 16 22");
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index e236f5f399..782f2554c8 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -134,7 +134,7 @@ if($pid = fork()) {
     }
 
     # some machines seem to suffer from a race condition here
-    sleep(1);
+    sleep(2);
 
     $sock = IO::Socket::INET->new("127.0.0.1:$port");
     if ($sock) {
diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
index 7a4556d215..e1c89c4ebd 100644
--- a/t/lib/io_unix.t
+++ b/t/lib/io_unix.t
@@ -21,6 +21,13 @@ BEGIN {
 	elsif ($Config{'extensions'} !~ /\bIO\b/) {
 	    $reason = 'IO extension unavailable';
 	}
+	elsif ($^O eq 'os2') {
+	    use IO::Socket;
+
+	    eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
+	      or $@ !~ /not implemented/ or
+		$reason = 'compiled without TCP/IP stack v4';
+	}
 	undef $reason if $^O eq 'VMS' and $Config{d_socket};
 	if ($reason) {
 	    print "1..0 # Skip: $reason\n";
@@ -32,12 +39,12 @@ BEGIN {
 $PATH = "/tmp/sock-$$";
 
 # Test if we can create the file within the tmp directory
-if (-e $PATH or not open(TEST, ">$PATH")) {
-    print "1..0\n";
+if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
+    print "1..0 # Skip: cannot open '$PATH' for write\n";
     exit 0;
 }
 close(TEST);
-unlink($PATH) or die "Can't unlink $PATH: $!";
+unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
 
 # Start testing
 $| = 1;
@@ -60,7 +67,7 @@ if($pid = fork()) {
     $sock->close;
 
     waitpid($pid,0);
-    unlink($PATH) || warn "Can't unlink $PATH: $!";
+    unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
 
     print "ok 5\n";
 
diff --git a/t/op/grent.t b/t/op/grent.t
index 9b06f11a3e..c9d3797533 100755
--- a/t/op/grent.t
+++ b/t/op/grent.t
@@ -3,6 +3,11 @@
 BEGIN {
     chdir 't' if -d 't';
     unshift @INC, "../lib" if -d "../lib";
+    eval {my @n = getgrgid 0};
+    if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
+	print "1..0 # Skip: $1\n";
+	exit 0;
+    }
     eval { require Config; import Config; };
     my $reason;
     if ($Config{'i_grp'} ne 'define') {
diff --git a/t/op/groups.t b/t/op/groups.t
index d22d8f07ad..f46af93bd3 100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -65,6 +65,11 @@ EOM
     quit();
 }
 
+unless (eval { getgrgid(0); 1 }) {
+    print "1..0 # Skip: getgrgid() not implemented\n";
+    exit 0;
+}
+
 # Remember that group names can contain whitespace, '-', et cetera.
 # That is: do not \w, do not \S.
 if ($groups =~ /groups=(.+)( [ug]id=|$)/) {
diff --git a/t/op/pwent.t b/t/op/pwent.t
index feee6f2b90..788d2f2701 100755
--- a/t/op/pwent.t
+++ b/t/op/pwent.t
@@ -3,6 +3,11 @@
 BEGIN {
     chdir 't' if -d 't';
     unshift @INC, "../lib" if -d "../lib";
+    eval {my @n = getpwuid 0};
+    if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
+	print "1..0 # Skip: $1\n";
+	exit 0;
+    }
     eval { require Config; import Config; };
     my $reason;
     if ($Config{'i_pwd'} ne 'define') {
diff --git a/t/op/stat.t b/t/op/stat.t
index ae627f6070..60c70f2bb7 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -19,23 +19,34 @@ chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
 $DEV = `ls -l /dev` unless $Is_Dosish;
 
 unlink "Op.stat.tmp";
-open(FOO, ">Op.stat.tmp");
-
-# hack to make Apollo update link count:
-$junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-    $blksize,$blocks) = stat(FOO);
-if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
-if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {print "ok 2\n";}
-else {print "# |$mtime| vs |$ctime|\nnot ok 2\n";}
-
-print FOO "Now is the time for all good men to come to.\n";
-close(FOO);
-
-sleep 2;
+if (open(FOO, ">Op.stat.tmp")) {
+  # hack to make Apollo update link count:
+  $junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
+
+  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(FOO);
+  if ($nlink == 1) {
+    print "ok 1\n";
+  }
+  else {
+    print "# res=$res, nlink=$nlink.\nnot ok 1\n";
+  }
+  if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {
+    print "ok 2\n";
+  }
+  else {
+    print "# |$mtime| vs |$ctime|\nnot ok 2\n";
+  }
+
+  print FOO "Now is the time for all good men to come to.\n";
+  close(FOO);
+
+  sleep 2;
+} else {
+  print "# open failed: $!\nnot ok 1\nnot ok 2\n";
+}
 
-if ($Is_Dosish) { unlink "Op.stat.tmp2" }
+if ($Is_Dosish) { unlink "Op.stat.tmp2"}
 else {
     `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
 }
@@ -65,7 +76,7 @@ else {
 }
 print "#4	:$mtime: should != :$ctime:\n";
 
-unlink "Op.stat.tmp";
+unlink "Op.stat.tmp" or print "# unlink failed: $!\n";
 if ($Is_MSWin32) {  open F, '>Op.stat.tmp' and close F }
 else             { `touch Op.stat.tmp` }
 
@@ -76,7 +87,7 @@ $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
 if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
 if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
 
-unlink 'Op.stat.tmp';
+unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
 $olduid = $>;		# can't test -r if uid == 0
 $Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
 chmod 0,'Op.stat.tmp';
@@ -95,7 +106,7 @@ foreach ((12,13,14,15,16,17)) {
 
 # in ms windows, Op.stat.tmp inherits owner uid from directory
 # not sure about os/2, but chown is harmless anyway
-chown $>,'Op.stat.tmp';
+eval { chown $>,'Op.stat.tmp'; 1 } or print "# $@" ;
 chmod 0700,'Op.stat.tmp';
 if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
 if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
@@ -261,4 +272,4 @@ $_ = 'Op.stat.tmp';
 if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
 if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
 
-unlink 'Op.stat.tmp';
+unlink 'Op.stat.tmp' or print "# unlink failed: $!\n";
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index b0202f7fdf..c72534a15f 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -87,6 +87,16 @@
      (Maybe you meant system() when you said exec()?
  	exec "true" ; my $a
 
+     defined(@array) is deprecated (and not really meaningful)
+     (Maybe you should just omit the defined()?)
+	defined @a ;
+	my @a ; defined @a ;
+	defined (@a = (1,2,3)) ;
+
+     defined(%hash) is deprecated (and not really meaningful)
+     (Maybe you should just omit the defined()?)
+	defined %h ;
+	my %h ; defined %h ;
 
 __END__
 # op.c
@@ -543,3 +553,38 @@ my $a
 EXPECT
 Statement unlikely to be reached at - line 4.
 (Maybe you meant system() when you said exec()?)
+########
+# op.c
+use warning 'deprecated' ;
+defined(@a);
+EXPECT
+defined(@array) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+my @a; defined(@a);
+EXPECT
+defined(@array) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+defined(@a = (1,2,3));
+EXPECT
+defined(@array) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+defined(%h);
+EXPECT
+defined(%hash) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)
+########
+# op.c
+use warning 'deprecated' ;
+my %h; defined(%h);
+EXPECT
+defined(%hash) is deprecated (and not really meaningful) at - line 3.
+(Maybe you should just omit the defined()?)