summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rwxr-xr-xt/TEST1
-rwxr-xr-xt/comp/proto.t15
-rwxr-xr-xt/lib/complex.t69
-rw-r--r--t/lib/dosglob.t94
-rwxr-xr-xt/lib/io_sock.t4
-rwxr-xr-xt/lib/io_udp.t4
-rwxr-xr-xt/op/glob.t5
-rwxr-xr-xt/op/method.t13
-rwxr-xr-xt/op/misc.t7
-rwxr-xr-xt/op/ref.t16
-rwxr-xr-xt/op/runlevel.t2
-rwxr-xr-xt/op/split.t16
-rwxr-xr-xt/op/sprintf.t29
-rwxr-xr-xt/op/subst.t7
-rwxr-xr-xt/op/taint.t59
-rwxr-xr-xt/pragma/locale.t28
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
View Lorry Controller Status