[inseparable changes from patch to perl 5.004_04]perl-5.004_04

[editor's note: this one imported like a charm!]

 TESTS  -

Subject: Improve pragma/locale test 102 - and don't fail, just warn
From: Jarkko Hietaniemi <jhi@anna.in-berlin.de>
Files: t/pragma/locale.t

Subject: Invalid test output in t/op/taint.t in trial 1
From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
Files: t/op/taint.t

    t/op/taint.t prints out invalid ok messages for tests it skips.
    Rather than printing "ok 136" it prints "136 ok".
    
    p5p-msgid: 3.0.3.32.19970919160918.00857a50@stargate.lbcc.cc.or.us

 UTILITIES  -

Subject: Perldoc tiny patch to avoid $0
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: utils/perldoc.PL
Msg-ID: 199709122141.RAA16846@monk.mps.ohio-state.edu

    (applied based on p5p patch as commit 0b166b6635cf199f072db516b2a523ee659394d5)

Subject: h2ph broken in 5.004_02
From: David Mazieres <dm@reeducation-labor.lcs.mit.edu>
Files: utils/h2ph.PL
Msg-ID: 199708201700.KAA02621@www.chapin.edu

    (applied based on p5p patch as commit 4a8e146e38ec2045f1f817a7cb578e1b1f80f39f)

Subject: add key_t caddr_t to h2ph
From: Tony Sanders <sanders@bsdi.com>
Files: eg/sysvipc/ipcsem utils/h2ph.PL
Msg-ID: 199708272301.RAA12803@austin.bsdi.com

    (applied based on p5p patch as commit 0806a92ffc3a74ca70aa81051cdf2a306cd0a8af)

Subject: perldoc search ., lib and blib/* if -f 'Makefile.PL'
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

    Subject: perldoc finds wrong pod2man
    
    (from perldoc source)
    
        # We must look both in @INC for library modules and in PATH
        # for executables, like h2xs or perldoc itself.
    
    Unfortunately, searching PATH for installed perl executables like
    pod2man is INCORRECT.  perldoc should start by searching the
    directory it was executed from, which might not be in the PATH
    at all.
    
    Credited: Joseph "Moof-in'" Hall <joseph@cscaper.com>
    
    p5p-msgid: 199708251732.KAA19299@gadget.cscaper.com

Subject: 5.004m4t1: perlbug: NIS domainname gets into wrong places
From: Andreas J. Koenig <koenig@anna.mind.de>
Files: utils/perlbug.PL
Msg-ID: sfcg1qy38as.fsf@anna.in-berlin.de

    (applied based on p5p patch as commit 41f926b844140b7f7eaa9302113e45df3a9f9ff4)

Subject: add better local patch info to perlbug
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perlbug.PL

Subject: perldoc - suggest modules if requested module not found
From: Anthony David <adavid@netinfo.com.au>
Files: utils/perldoc.PL

    private-msgid: 3439CD83.6969@netinfo.com.au

Subject: perldoc mail::foo tries to read binary /usr/ucb/mail
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

    Subject: perldoc weirdness
    
    perldoc mail::imap yields:
    
    {joseph}:79% perldoc mail::foo
    can't open /usr/ucb/mail: Permission denied at ./pod2man line 362.
    
    Credited: Joseph "Moof-in'" Hall <joseph@cscaper.com>
    
    p5p-msgid: 199710082014.NAA00808@gadget.cscaper.com

Subject: perldoc -f setpwent (for example) returns no descriptive text
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

Subject: perldoc diffs: don't search auto - much faster
From: "Joseph N. Hall" <joseph@5sigma.com>
Files: utils/perldoc.PL
Msg-ID: MailDrop1.2d7dPPC.971012211957@screechy.cscaper.com

    (applied based on p5p patch as commit 62b753c6ae4ab9bf22fbb6ec7ceac820bcef8fe4)

11 files changed, 317 insertions, 36 deletions

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
index e69de29bb2..7398a14065 100755
--- a/t/lib/dosglob.t
+++ 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/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/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