Maintenance 5.004_04 changes

p4raw-id: //depot/maint-5.004/perl@128

16 files changed, 330 insertions, 39 deletions

diff --git a/t/TEST b/t/TEST
index ae436667db..cae81031c2 100755
--- a/t/TEST
+++ b/t/TEST
@@ -51,6 +51,7 @@ while ($test = shift) {
     chop($te);
     print "$te" . '.' x (18 - length($te));
     if ($sharpbang) {
+	-x $test || (print "isn't executable.\n");
 	open(RESULTS,"./$test |") || (print "can't run.\n");
     } else {
 	open(SCRIPT,"$test") || die "Can't run $test.\n";
diff --git a/t/comp/proto.t b/t/comp/proto.t
index 197ea78272..d1cfede8af 100755
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict;
 
-print "1..74\n";
+print "1..76\n";
 
 my $i = 1;
 
@@ -375,3 +375,16 @@ sub an_array_ref (\@) {
 an_array_ref @array;
 print "not " unless @array == 4;
 print @array;
+
+# correctly note too-short parameter lists that don't end with '$',
+#  a possible regression.
+
+sub foo1 ($\@);
+eval q{ foo1 "s" };
+print "not " unless $@ =~ /^Not enough/;
+print "ok ", $i++, "\n";
+
+sub foo2 ($\%);
+eval q{ foo2 "s" };
+print "not " unless $@ =~ /^Not enough/;
+print "ok ", $i++, "\n";
diff --git a/t/lib/complex.t b/t/lib/complex.t
index c05f40f2d3..3390334d34 100755
--- a/t/lib/complex.t
+++ b/t/lib/complex.t
@@ -1,10 +1,15 @@
 #!./perl
 
-# $RCSfile$
+# $RCSfile: complex.t,v $
 #
 # Regression tests for the Math::Complex pacakge
-# -- Raphael Manfredi, September 1996
-# -- Jarkko Hietaniemi, March-April 1997
+# -- Raphael Manfredi	September 1996
+# -- Jarkko Hietaniemi	March-October 1997
+# -- Daniel S. Lewart	September-October 1997
+
+$VERSION = '1.05';
+
+# $Id: complex.t,v 1.1 1997/10/15 10:02:15 jhi Exp jhi $
 
 BEGIN {
     chdir 't' if -d 't';
@@ -13,9 +18,14 @@ BEGIN {
 
 use Math::Complex;
 
+my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
+
 $test = 0;
 $| = 1;
-@script = ();
+my @script = (
+    'my ($res, $s0,$s1,$s2,$s3,$s4,$s5,$s6,$s7,$s8,$s9,$s10, $z0,$z1,$z2);' .
+	"\n\n"
+);
 my $eps = 1e-11;
 
 while (<DATA>) {
@@ -58,7 +68,7 @@ sub test_dbz {
 #	push(@script, qq(print "# '$op'\n";));
 	push(@script, qq(eval '$op';));
 	push(@script, qq(print 'not ' unless (\$@ =~ /Division by zero/);));
-	push(@script, qq(print "ok $test\n";));
+	push(@script, qq( print "ok $test\\n";\n));
     }
 }
 
@@ -71,7 +81,7 @@ sub test_loz {
 #	push(@script, qq(print "# '$op'\n";));
 	push(@script, qq(eval '$op';));
 	push(@script, qq(print 'not ' unless (\$@ =~ /Logarithm of zero/);));
-	push(@script, qq(print "ok $test\n";));
+	push(@script, qq( print "ok $test\\n";\n));
     }
 }
 
@@ -99,7 +109,10 @@ test_dbz(
 	 'acoth(1)',
 	);
 
+my $zero = cplx(0, 0);
+
 test_loz(
+	 'log($zero)',
 	 'atanh(-1)',
 	 'acoth(-1)',
 	);
@@ -112,7 +125,7 @@ sub test_ztz {
 #	push(@script, qq(print "# 0**0\n";));
 	push(@script, qq(eval 'cplx(0)**cplx(0)';));
 	push(@script, qq(print 'not ' unless (\$@ =~ /zero raised to the/);));
-	push(@script, qq(print "ok $test\n";));
+	push(@script, qq( print "ok $test\\n";\n));
 }
 
 test_ztz;
@@ -126,7 +139,7 @@ sub test_broot {
 #	push(@script, qq(print "# root(2, $op)\n";));
 	push(@script, qq(eval 'root(2, $op)';));
 	push(@script, qq(print 'not ' unless (\$@ =~ /root must be/);));
-	push(@script, qq(print "ok $test\n";));
+	push(@script, qq( print "ok $test\\n";\n));
     }
 }
 
@@ -173,11 +186,11 @@ sub test {
 			# check the op= works
 			push @script, <<EOB;
 {
-        my \$za = cplx(ref \$z0 ? \@{\$z0->cartesian} : (\$z0, 0));
+	my \$za = cplx(ref \$z0 ? \@{\$z0->cartesian} : (\$z0, 0));
 
 	my (\$z1r, \$z1i) = ref \$z1 ? \@{\$z1->cartesian} : (\$z1, 0);
 
-        my \$zb = cplx(\$z1r, \$z1i);
+	my \$zb = cplx(\$z1r, \$z1i);
 
 	\$za $op= \$zb;
 	my (\$zbr, \$zbi) = \@{\$zb->cartesian};
@@ -187,7 +200,7 @@ EOB
 			$test++;
 			# check that the rhs has not changed
 			push @script, qq(print "not " unless (\$zbr == \$z1r and \$zbi == \$z1i););
-			push @script, qq(print "ok $test\n";);
+			push @script, qq( print "ok $test\\n";\n);
 			push @script, "}\n";
 		}
 	}
@@ -249,6 +262,17 @@ sub check {
 		print "# '$try' expected: '$expected' got: '$got' for $args\n";
 	}
 }
+
+sub addsq {
+    my ($z1, $z2) = @_;
+    return ($z1 + i*$z2) * ($z1 - i*$z2);
+}
+
+sub subsq {
+    my ($z1, $z2) = @_;
+    return ($z1 + $z2) * ($z1 - $z2);
+}
+
 __END__
 &+;=
 (3,4):(3,4):(6,8)
@@ -372,13 +396,13 @@ __END__
 |'abs(z)':'r'
 |'acot(z)':'acotan(z)'
 |'acsc(z)':'acosec(z)'
-|'abs(acsc(z))':'abs(asin(1 / z))'
-|'abs(asec(z))':'abs(acos(1 / z))'
+|'acsc(z)':'asin(1 / z)'
+|'asec(z)':'acos(1 / z)'
 |'cbrt(z)':'cbrt(r) * exp(i * t/3)'
 |'cos(acos(z))':'z'
-|'cos(z) ** 2 + sin(z) ** 2':1
+|'addsq(cos(z), sin(z))':1
 |'cos(z)':'cosh(i*z)'
-|'cosh(z) ** 2 - sinh(z) ** 2':1
+|'subsq(cosh(z), sinh(z))':1
 |'cot(acot(z))':'z'
 |'cot(z)':'1 / tan(z)'
 |'cot(z)':'cotan(z)'
@@ -430,6 +454,20 @@ __END__
 |'atan(tan(z))':'z'
 |'atanh(tanh(z))':'z'
 
+&log
+(-2.0,0):(   0.69314718055995,  3.14159265358979)
+(-1.0,0):(   0               ,  3.14159265358979)
+(-0.5,0):(  -0.69314718055995,  3.14159265358979)
+( 0.5,0):(  -0.69314718055995,  0               )
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   0.69314718055995,  0               )
+
+&log
+( 2, 3):(    1.28247467873077,  0.98279372324733)
+(-2, 3):(    1.28247467873077,  2.15879893034246)
+(-2,-3):(    1.28247467873077, -2.15879893034246)
+( 2,-3):(    1.28247467873077, -0.98279372324733)
+
 &sin
 (-2.0,0):(  -0.90929742682568,  0               )
 (-1.0,0):(  -0.84147098480790,  0               )
@@ -777,3 +815,4 @@ __END__
 ( 2,-3):(  0.14694666622553,  0.23182380450040)
 
 # eof
+
diff --git a/t/lib/dosglob.t b/t/lib/dosglob.t
new file mode 100644
index 0000000000..7398a14065
--- /dev/null
+++ b/t/lib/dosglob.t
@@ -0,0 +1,94 @@
+#!./perl
+
+#
+# test glob() in File::DosGlob
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..9\n";
+
+# override it in main::
+use File::DosGlob 'glob';
+
+# test if $_ takes as the default
+$_ = "lib/a*.t";
+my @r = glob;
+print "not " if $_ ne 'lib/a*.t';
+print "ok 1\n";
+# we should have at least abbrev.t, anydbm.t, autoloader.t
+print "# |@r|\nnot " if @r < 3;
+print "ok 2\n";
+
+# check if <*/*> works
+@r = <*/a*.t>;
+# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
+print "not " if @r < 9;
+print "ok 3\n";
+my $r = scalar @r;
+
+# check if scalar context works
+@r = ();
+while (defined($_ = <*/a*.t>)) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 4\n";
+
+# check if array context works
+@r = ();
+for (<*/a*.t>) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+while (<*/a*.t>) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if explicit glob() gets assign magic too
+my @s = ();
+while (glob '*/a*.t') {
+    print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 7\n";
+
+# how about in a different package, like?
+package Foo;
+use File::DosGlob 'glob';
+@s = ();
+while (glob '*/a*.t') {
+    print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 8\n";
+
+# test if different glob ops maintain independent contexts
+@s = ();
+while (<*/a*.t>) {
+    my $i = 0;
+    print "# $_ <";
+    push @s, $_;
+    while (<*/b*.t>) {
+        print " $_";
+	$i++;
+    }
+    print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 9\n";
+
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index 06a973cc70..0971e7803f 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -52,6 +52,10 @@ if($pid = fork()) {
 
 } elsif(defined $pid) {
 
+    # This can fail if localhost is undefined or the
+    # special 'loopback' address 127.0.0.1 is not configured
+    # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+
     $sock = IO::Socket::INET->new(PeerPort => $port,
 				  Proto => 'tcp',
 				  PeerAddr => 'localhost'
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index d8377f6446..3e16714118 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -27,6 +27,10 @@ print "1..3\n";
 use Socket;
 use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
 
+    # This can fail if localhost is undefined or the
+    # special 'loopback' address 127.0.0.1 is not configured
+    # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+
 $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
 $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
 
diff --git a/t/op/glob.t b/t/op/glob.t
index dd95e980d5..253e4a312f 100755
--- a/t/op/glob.t
+++ b/t/op/glob.t
@@ -6,11 +6,12 @@ print "1..6\n";
 
 @oops = @ops = <op/*>;
 
-map { $files{$_}++ } <op/*>;
 if ($^O eq 'MSWin32') {
-  map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op"`;
+  map { $files{lc($_)}++ } <op/*>;
+  map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op & dir /b /l /ah op 2>nul"`,
 }
 else {
+  map { $files{$_}++ } <op/*>;
   map { delete $files{$_} } split /[\s\n]/, `echo op/*`;
 }
 if (keys %files) {
diff --git a/t/op/method.t b/t/op/method.t
index 21d7c8f397..d955705d1a 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -4,7 +4,7 @@
 # test method calls and autoloading.
 #
 
-print "1..20\n";
+print "1..24\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -25,6 +25,14 @@ test( A->d, "C::d");		# Update hash table;
 test (A->d, "D::d");		# Update hash table;
 
 {
+    local @A::ISA = qw(C);	# Update hash table with split() assignment
+    test (A->d, "C::d");
+    $#A::ISA = -1;
+    test (eval { A->d } || "fail", "fail");
+}
+test (A->d, "D::d");
+
+{
     local *B::d;
     eval 'sub B::d {"B::d1"}';	# Import now.
     test (A->d, "B::d1");	# Update hash table;
@@ -109,3 +117,6 @@ test(Y->f(), "B: In Y::f, 3");	# Which sticks
 
 test(A->eee(), "new B: In A::eee, 4");	# We get a correct $autoload
 test(A->eee(), "new B: In A::eee, 4");	# Which sticks
+
+# this test added due to bug discovery
+test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
diff --git a/t/op/misc.t b/t/op/misc.t
index 660049b3f1..6156ac2f21 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -1,5 +1,8 @@
 #!./perl
 
+# NOTE: Please don't add tests to this file unless they *need* to be run in
+# separate executable and can't simply use eval.
+
 chdir 't' if -d 't';
 @INC = "../lib";
 $ENV{PERL5LIB} = "../lib";
@@ -18,8 +21,8 @@ $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
 
 for (@prgs){
     my $switch;
-    if (s/^\s*-\w+//){
-	$switch = $&;
+    if (s/^\s*(-\w.*)//){
+	$switch = $1;
     }
     my($prog,$expected) = split(/\nEXPECT\n/, $_);
     if ($^O eq 'MSWin32') {
diff --git a/t/op/ref.t b/t/op/ref.t
index e83a04fbee..9fcc8ac15c 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..50\n";
+print "1..51\n";
 
 # Test glob operations.
 
@@ -223,12 +223,20 @@ sub moe::DESTROY   { print "# moe\nok 47\n"; }
 
 print "# left block\n";
 
+# another glob test
+
+$foo = "not ok 48";
+{ local(*bar) = "foo" }
+$bar = "ok 48";
+local(*bar) = *bar;
+print "$bar\n";
+
 package FINALE;
 
 {
-    $ref3 = bless ["ok 50\n"];		# package destruction
-    my $ref2 = bless ["ok 49\n"];	# lexical destruction
-    local $ref1 = bless ["ok 48\n"];	# dynamic destruction
+    $ref3 = bless ["ok 51\n"];		# package destruction
+    my $ref2 = bless ["ok 50\n"];	# lexical destruction
+    local $ref1 = bless ["ok 49\n"];	# dynamic destruction
     1;					# flush any temp values on stack
 }
 
diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index 2be2eec019..6693a829a8 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -304,7 +304,7 @@ EXPECT
 0, 1, 2, 3
 ########
 sub foo {
-  goto bar if $a == 0;
+  goto bar if $a == 0 || $b == 0;
   $a <=> $b;
 }
 @a = (3, 2, 0, 1);
diff --git a/t/op/split.t b/t/op/split.t
index b449ba96fa..07246522ee 100755
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $
 
-print "1..16\n";
+print "1..20\n";
 
 $FS = ':';
 
@@ -76,3 +76,17 @@ print "$a|$b" eq "2|4" ? "ok 15\n" : "not ok 15\n";
   local(undef, $a, undef, $b) = qw(1 2 3 4);
   print "$a|$b" eq "2|4" ? "ok 16\n" : "not ok 16\n";
 }
+
+# check splitting of null string
+$_ = join('|', split(/x/,   '',-1), 'Z');
+print $_ eq "Z" ? "ok 17\n" : "#$_\nnot ok 17\n";
+
+$_ = join('|', split(/x/,   '', 1), 'Z');
+print $_ eq "Z" ? "ok 18\n" : "#$_\nnot ok 18\n";
+
+$_ = join('|', split(/(p+)/,'',-1), 'Z');
+print $_ eq "Z" ? "ok 19\n" : "#$_\nnot ok 19\n";
+
+$_ = join('|', split(/.?/,  '',-1), 'Z');
+print $_ eq "Z" ? "ok 20\n" : "#$_\nnot ok 20\n";
+
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 8e1ef6958f..1450ae375f 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -2,7 +2,32 @@
 
 # $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $
 
-print "1..1\n";
+print "1..4\n";
 
+$^W = 1;
+$SIG{__WARN__} = sub {
+    if ($_[0] =~ /^Invalid conversion/) {
+	$w++;
+    } else {
+	warn @_;
+    }
+};
+
+$w = 0;
 $x = sprintf("%3s %-4s%%foo %5d%c%3.1f","hi",123,456,65,3.0999);
-if ($x eq ' hi 123 %foo   456A3.1') {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
+if ($x eq ' hi 123 %foo   456A3.1' && $w == 0) {
+    print "ok 1\n";
+} else {
+    print "not ok 1 '$x'\n";
+}
+
+for $i (2 .. 4) {
+    $f = ('%6 .6s', '%6. 6s', '%6.6 s')[$i - 2];
+    $w = 0;
+    $x = sprintf($f, '');
+    if ($x eq $f && $w == 1) {
+	print "ok $i\n";
+    } else {
+	print "not ok $i '$x' '$f' '$w'\n";
+    }
+}
diff --git a/t/op/subst.t b/t/op/subst.t
index 3b4734eadb..efea970dfc 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $
 
-print "1..61\n";
+print "1..62\n";
 
 $x = 'foo';
 $_ = "x";
@@ -234,3 +234,8 @@ print exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar'
 $_ = "abcd";
 s/../$x = $&, m#.#/eg;
 print $x eq "cd" ? "ok 61\n" : "not ok 61\n";
+
+# check parsing of split subst with comment
+eval 's{foo} # this is a comment, not a delimiter
+       {bar};';
+print @? ? "not ok 62\n" : "ok 62\n";
diff --git a/t/op/taint.t b/t/op/taint.t
index e170f284ed..8437c43c45 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -82,7 +82,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..135\n";
+print "1..140\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -515,3 +515,60 @@ else {
     test 134,     tainted $corge[1];
     test 135, not tainted $corge[2];
 }
+
+# Test for system/library calls returning string data of dubious origin.
+{
+    # No reliable %Config check for getpw*
+    if (eval { setpwent(); getpwent(); 1 }) {
+	setpwent();
+	my @getpwent = getpwent();
+	die "getpwent: $!\n" unless (@getpwent);
+	test 136,(    not tainted $getpwent[0]
+	          and not tainted $getpwent[1]
+	          and not tainted $getpwent[2]
+	          and not tainted $getpwent[3]
+	          and not tainted $getpwent[4]
+	          and not tainted $getpwent[5]
+	          and     tainted $getpwent[6] # gecos
+	          and not tainted $getpwent[7]
+		  and not tainted $getpwent[8]);
+	endpwent();
+    } else {
+	print "# getpwent() is not available\n";
+	print "ok 136\n";
+    }
+
+    if ($Config{d_readdir}) { # pretty hard to imagine not
+	local(*D);
+	opendir(D, "op") or die "opendir: $!\n";
+	my $readdir = readdir(D);
+	test 137, tainted $readdir;
+	closedir(OP);
+    } else {
+	print "# readdir() is not available\n";
+	print "ok 137\n";
+    }
+
+    if ($Config{d_readlink} && $Config{d_symlink}) {
+	my $symlink = "sl$$";
+	unlink($symlink);
+	symlink("/something/naughty", $symlink) or die "symlink: $!\n";
+	my $readlink = readlink($symlink);
+	test 138, tainted $readlink;
+	unlink($symlink);
+    } else {
+	print "# readlink() or symlink() is not available\n";
+	print "ok 138\n";
+    }
+}
+
+# test bitwise ops (regression bug)
+{
+    my $why = "y";
+    my $j = "x" | $why;
+    test 139, not tainted $j;
+    $why = $TAINT."y";
+    $j = "x" | $why;
+    test 140,     tainted $j;
+}
+
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index e1ec5a800f..8e296db8a7 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -394,13 +394,26 @@ for (map { chr } 0..255) {
 }
 print "ok 101\n";
 
+# Test for read-onlys.
+
+{
+    no locale;
+    $a = "qwerty";
+    {
+	use locale;
+	print "not " if $a cmp "qwerty";
+    }
+}
+print "ok 102\n";
+
+# This test must be the last one because its failure is not fatal.
 # The @Locale should be internally consistent.
 # Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
 # for inventing a way to test for ordering consistency
 # without requiring any particular order.
 # ++$jhi;#@iki.fi
 
-print "# testing 102\n";
+print "# testing 103\n";
 {
     my ($from, $to, $lesser, $greater, @test, %test, $test, $yes, $no, $sign);
 
@@ -422,14 +435,14 @@ print "# testing 102\n";
 	    (
 	     $no.'    ($lesser  lt $greater)',  # 0
 	     $no.'    ($lesser  le $greater)',  # 1
-	     $no.'    ($lesser  ne $greater)',  # 2
-	     $yes.'    ($lesser  eq $greater)', # 3
+	     'not      ($lesser  ne $greater)', # 2
+	     '         ($lesser  eq $greater)', # 3
 	     $yes.'    ($lesser  ge $greater)', # 4
 	     $yes.'    ($lesser  gt $greater)', # 5
 	     $yes.'    ($greater lt $lesser )', # 6
 	     $yes.'    ($greater le $lesser )', # 7
-	     $no.'     ($greater ne $lesser )', # 8
-	     $yes.'    ($greater eq $lesser )', # 9
+	     'not      ($greater ne $lesser )', # 8
+	     '         ($greater eq $lesser )', # 9
 	     $no.'     ($greater ge $lesser )', # 10
 	     $no.'     ($greater gt $lesser )', # 11
 	     'not (($lesser cmp $greater) == -$sign)' # 12
@@ -438,7 +451,7 @@ print "# testing 102\n";
 	$test = 0;
 	for my $ti (@test) { $test{$ti} = eval $ti ; $test ||= $test{$ti} }
 	if ($test) {
-	    print "# failed 102 at:\n";
+	    print "# failed 103 at:\n";
 	    print "# lesser  = '$lesser'\n";
 	    print "# greater = '$greater'\n";
 	    print "# lesser cmp greater = ", $lesser cmp $greater, "\n";
@@ -453,11 +466,10 @@ print "# testing 102\n";
 		print "\n";
 	    }
 
-	    print 'not ';
+	    warn "The locale definition on your system may have errors.\n";
 	    last;
 	}
     }
 }
-print "ok 102\n";
 
 # eof