First stab at 5.003 -> 5.004 integration.

p4raw-id: //depot/perl@18

8 files changed, 709 insertions, 9 deletions

diff --git a/t/comp/colon.t b/t/comp/colon.t
new file mode 100755
index 0000000000..d2c64fe4c5
--- /dev/null
+++ b/t/comp/colon.t
@@ -0,0 +1,138 @@
+#!./perl
+
+#
+# Ensure that syntax using colons (:) is parsed correctly.
+# The tests are done on the following tokens (by default):
+# ABC LABEL XYZZY m q qq qw qx s tr y AUTOLOAD and alarm 
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+$_ = '';	# to avoid undef warning on m// etc.
+
+sub ok {
+    my($test,$ok) = @_;
+    print "not " unless $ok;
+    print "ok $test\n";
+}
+
+$SIG{__WARN__} = sub { 1; }; # avoid some spurious warnings
+
+print "1..25\n";
+
+ok 1, (eval "package ABC; sub zyx {1}; 1;" and
+	eval "ABC::zyx" and
+	not eval "ABC:: eq ABC||" and
+	not eval "ABC::: >= 0");
+
+ok 2, (eval "package LABEL; sub zyx {1}; 1;" and
+	eval "LABEL::zyx" and
+	not eval "LABEL:: eq LABEL||" and
+	not eval "LABEL::: >= 0");
+
+ok 3, (eval "package XYZZY; sub zyx {1}; 1;" and
+	eval "XYZZY::zyx" and
+	not eval "XYZZY:: eq XYZZY||" and
+	not eval "XYZZY::: >= 0");
+
+ok 4, (eval "package m; sub zyx {1}; 1;" and
+	not eval "m::zyx" and
+	eval "m:: eq m||" and
+	not eval "m::: >= 0");
+
+ok 5, (eval "package q; sub zyx {1}; 1;" and
+	not eval "q::zyx" and
+	eval "q:: eq q||" and
+	not eval "q::: >= 0");
+
+ok 6, (eval "package qq; sub zyx {1}; 1;" and
+	not eval "qq::zyx" and
+	eval "qq:: eq qq||" and
+	not eval "qq::: >= 0");
+
+ok 7, (eval "package qw; sub zyx {1}; 1;" and
+	not eval "qw::zyx" and
+	eval "qw:: eq qw||" and
+	not eval "qw::: >= 0");
+
+ok 8, (eval "package qx; sub zyx {1}; 1;" and
+	not eval "qx::zyx" and
+	eval "qx:: eq qx||" and
+	not eval "qx::: >= 0");
+
+ok 9, (eval "package s; sub zyx {1}; 1;" and
+	not eval "s::zyx" and
+	not eval "s:: eq s||" and
+	eval "s::: >= 0");
+
+ok 10, (eval "package tr; sub zyx {1}; 1;" and
+	not eval "tr::zyx" and
+	not eval "tr:: eq tr||" and
+	eval "tr::: >= 0");
+
+ok 11, (eval "package y; sub zyx {1}; 1;" and
+	not eval "y::zyx" and
+	not eval "y:: eq y||" and
+	eval "y::: >= 0");
+
+ok 12, (eval "ABC:1" and
+	not eval "ABC:echo: eq ABC|echo|" and
+	not eval "ABC:echo:ohce: >= 0");
+
+ok 13, (eval "LABEL:1" and
+	not eval "LABEL:echo: eq LABEL|echo|" and
+	not eval "LABEL:echo:ohce: >= 0");
+
+ok 14, (eval "XYZZY:1" and
+	not eval "XYZZY:echo: eq XYZZY|echo|" and
+	not eval "XYZZY:echo:ohce: >= 0");
+
+ok 15, (not eval "m:1" and
+	eval "m:echo: eq m|echo|" and
+	not eval "m:echo:ohce: >= 0");
+
+ok 16, (not eval "q:1" and
+	eval "q:echo: eq q|echo|" and
+	not eval "q:echo:ohce: >= 0");
+
+ok 17, (not eval "qq:1" and
+	eval "qq:echo: eq qq|echo|" and
+	not eval "qq:echo:ohce: >= 0");
+
+ok 18, (not eval "qw:1" and
+	eval "qw:echo: eq qw|echo|" and
+	not eval "qw:echo:ohce: >= 0");
+
+ok 19, (not eval "qx:1" and
+	eval "qx:echo 1: eq qx|echo 1|" and	# echo without args may warn
+	not eval "qx:echo:ohce: >= 0");
+
+ok 20, (not eval "s:1" and
+	not eval "s:echo: eq s|echo|" and
+	eval "s:echo:ohce: >= 0");
+
+ok 21, (not eval "tr:1" and
+	not eval "tr:echo: eq tr|echo|" and
+	eval "tr:echo:ohce: >= 0");
+
+ok 22, (not eval "y:1" and
+	not eval "y:echo: eq y|echo|" and
+	eval "y:echo:ohce: >= 0");
+
+ok 23, (eval "AUTOLOAD:1" and
+	not eval "AUTOLOAD:echo: eq AUTOLOAD|echo|" and
+	not eval "AUTOLOAD:echo:ohce: >= 0");
+
+ok 24, (eval "and:1" and
+	not eval "and:echo: eq and|echo|" and
+	not eval "and:echo:ohce: >= 0");
+
+ok 25, (eval "alarm:1" and
+	not eval "alarm:echo: eq alarm|echo|" and
+	not eval "alarm:echo:ohce: >= 0");
diff --git a/t/comp/cpp.t b/t/comp/cpp.t
index 880aed836e..86e7359524 100755
--- a/t/comp/cpp.t
+++ b/t/comp/cpp.t
@@ -8,8 +8,9 @@ BEGIN {
 }
 
 use Config;
-if ( ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
-     ( ! -x $Config{'scriptdir'} . "/cppstdin") ) {
+if ( $^O eq 'MSWin32' or
+     ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
+     ( ! -x $Config{'binexp'} . "/cppstdin") ) {
     print "1..0\n";
     exit; 		# Cannot test till after install, alas.
 }
diff --git a/t/comp/multiline.t b/t/comp/multiline.t
index 634b06a7a8..fc1eedc8d2 100755
--- a/t/comp/multiline.t
+++ b/t/comp/multiline.t
@@ -32,9 +32,11 @@ if ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
 
 if ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";}
 
-$_ = `cat Comp.try`;
+$_ = ($^O eq 'MSWin32') ? `type Comp.try` : `cat Comp.try`;
 
 if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+close(try) || (die "Can't close temp file.");
 unlink 'Comp.try' || `/bin/rm -f Comp.try`;
 
 if ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";}
diff --git a/t/comp/package.t b/t/comp/package.t
index ca800bb364..cef02c5cb4 100755
--- a/t/comp/package.t
+++ b/t/comp/package.t
@@ -5,7 +5,7 @@ print "1..7\n";
 $blurfl = 123;
 $foo = 3;
 
-package XYZ;
+package xyz;
 
 $bar = 4;
 
@@ -20,10 +20,10 @@ $ABC'dyick = 6;
 $xyz = 2;
 
 $main = join(':', sort(keys %main::));
-$XYZ = join(':', sort(keys %XYZ::));
+$xyz = join(':', sort(keys %xyz::));
 $ABC = join(':', sort(keys %ABC::));
 
-print $XYZ eq 'ABC:XYZ:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$XYZ'\n";
+print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
 print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
 print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
 
diff --git a/t/comp/proto.t b/t/comp/proto.t
new file mode 100755
index 0000000000..197ea78272
--- /dev/null
+++ b/t/comp/proto.t
@@ -0,0 +1,377 @@
+#!./perl
+#
+# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+#
+# So far there are tests for the following prototypes.
+# none, () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@)
+#
+# It is impossible to test every prototype that can be specified, but
+# we should test as many as we can.
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+print "1..74\n";
+
+my $i = 1;
+
+sub testing (&$) {
+    my $p = prototype(shift);
+    my $c = shift;
+    my $what = defined $c ? '(' . $p . ')' : 'no prototype';   
+    print '#' x 25,"\n";
+    print '# Testing ',$what,"\n";
+    print '#' x 25,"\n";
+    print "not "
+	if((defined($p) && defined($c) && $p ne $c)
+	   || (defined($p) != defined($c)));
+    printf "ok %d\n",$i++;
+}
+
+@_ = qw(a b c d);
+my @array;
+my %hash;
+
+##
+##
+##
+
+testing \&no_proto, undef;
+
+sub no_proto {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 0 == no_proto();
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == no_proto(5);
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &no_proto;
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == no_proto +6;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == no_proto(@_);
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+
+testing \&no_args, '';
+
+sub no_args () {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 0 == no_args();
+printf "ok %d\n",$i++;
+
+print "not " unless 0 == no_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == no_args +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &no_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &no_args(1,2);
+printf "ok %d\n",$i++;
+
+eval "no_args(1)";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&one_args, '$';
+
+sub one_args ($) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == one_args(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == one_args +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &one_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &one_args(1,2);
+printf "ok %d\n",$i++;
+
+eval "one_args(1,2)";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+eval "one_args()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub one_a_args ($) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ == 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+one_a_args(@_);
+
+##
+##
+##
+
+testing \&over_one_args, '$@';
+
+sub over_one_args ($@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == over_one_args(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == over_one_args(1,2);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == over_one_args +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &over_one_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &over_one_args(1,2);
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == &over_one_args(1,@_);
+printf "ok %d\n",$i++;
+
+eval "over_one_args()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub over_one_a_args ($@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ >= 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+over_one_a_args(@_);
+over_one_a_args(@_,1);
+over_one_a_args(@_,1,2);
+over_one_a_args(@_,@_);
+
+##
+##
+##
+
+testing \&scalar_and_hash, '$%';
+
+sub scalar_and_hash ($%) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == scalar_and_hash(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 3 == scalar_and_hash(1,2,3);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == scalar_and_hash +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &scalar_and_hash;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &scalar_and_hash(1,2);
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == &scalar_and_hash(1,@_);
+printf "ok %d\n",$i++;
+
+eval "scalar_and_hash()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub scalar_and_hash_a ($@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ >= 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+scalar_and_hash_a(@_);
+scalar_and_hash_a(@_,1);
+scalar_and_hash_a(@_,1,2);
+scalar_and_hash_a(@_,@_);
+
+##
+##
+##
+
+testing \&one_or_two, '$;$';
+
+sub one_or_two ($;$) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == one_or_two(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == one_or_two(1,3);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == one_or_two +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &one_or_two;
+printf "ok %d\n",$i++;
+
+print "not " unless 3 == &one_or_two(1,2,3);
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == &one_or_two(1,@_);
+printf "ok %d\n",$i++;
+
+eval "one_or_two()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+eval "one_or_two(1,2,3)";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub one_or_two_a ($;$) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ >= 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+one_or_two_a(@_);
+one_or_two_a(@_,1);
+one_or_two_a(@_,@_);
+
+##
+##
+##
+
+testing \&a_sub, '&';
+
+sub a_sub (&) {
+    print "# \@_ = (",join(",",@_),")\n";
+    &{$_[0]};
+}
+
+sub tmp_sub_1 { printf "ok %d\n",$i++ }
+
+a_sub { printf "ok %d\n",$i++ };
+a_sub \&tmp_sub_1;
+
+@array = ( \&tmp_sub_1 );
+eval 'a_sub @array';
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&sub_aref, '&\@';
+
+sub sub_aref (&\@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    my($sub,$array) = @_;
+    print "not " unless @_ == 2 && @{$array} == 4;
+    print map { &{$sub}($_) } @{$array}
+}
+
+@array = (qw(O K)," ", $i++);
+sub_aref { lc shift } @array;
+print "\n";
+
+##
+##
+##
+
+testing \&sub_array, '&@';
+
+sub sub_array (&@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ == 5;
+    my $sub = shift;
+    print map { &{$sub}($_) } @_
+}
+
+@array = (qw(O K)," ", $i++);
+sub_array { lc shift } @array;
+print "\n";
+
+##
+##
+##
+
+testing \&a_hash, '%';
+
+sub a_hash (%) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_);
+}
+
+print "not " unless 1 == a_hash 'a';
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == a_hash 'a','b';
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&a_hash_ref, '\%';
+
+sub a_hash_ref (\%) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless ref($_[0]) && $_[0]->{'a'};
+    printf "ok %d\n",$i++;
+    $_[0]->{'b'} = 2;
+}
+
+%hash = ( a => 1);
+a_hash_ref %hash;
+print "not " unless $hash{'b'} == 2;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&an_array_ref, '\@';
+
+sub an_array_ref (\@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless ref($_[0]) && 1 == @{$_[0]};
+    printf "ok %d\n",$i++;
+    @{$_[0]} = (qw(ok)," ",$i++,"\n");
+}
+
+@array = ('a');
+an_array_ref @array;
+print "not " unless @array == 4;
+print @array;
diff --git a/t/comp/redef.t b/t/comp/redef.t
new file mode 100755
index 0000000000..07e978bb86
--- /dev/null
+++ b/t/comp/redef.t
@@ -0,0 +1,80 @@
+#!./perl -w
+#
+# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+
+BEGIN {
+    $warn = "";
+    $SIG{__WARN__} = sub { $warn .= join("",@_) }
+}
+
+sub ok ($$) { 
+    print $_[1] ? "ok " : "not ok ", $_[0], "\n";
+}
+
+print "1..18\n";
+
+my $NEWPROTO = 'Prototype mismatch:';
+
+sub sub0 { 1 }
+sub sub0 { 2 }
+
+ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;
+
+sub sub1    { 1 }
+sub sub1 () { 2 }
+
+ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1 vs ()\E[^\n]+\n//s;
+ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;
+
+sub sub2     { 1 }
+sub sub2 ($) { 2 }
+
+ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2 vs ($)\E[^\n]+\n//s;
+ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;
+
+sub sub3 () { 1 }
+sub sub3    { 2 }
+
+ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s;
+ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;
+
+sub sub4 () { 1 }
+sub sub4 () { 2 }
+
+ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;
+
+sub sub5 ()  { 1 }
+sub sub5 ($) { 2 }
+
+ok  9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s;
+ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;
+
+sub sub6 ($) { 1 }
+sub sub6     { 2 }
+
+ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s;
+ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;
+
+sub sub7 ($) { 1 }
+sub sub7 ()  { 2 }
+
+ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s;
+ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;
+
+sub sub8 ($) { 1 }
+sub sub8 ($) { 2 }
+
+ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;
+
+sub sub9 ($@) { 1 }
+sub sub9 ($)  { 2 }
+
+ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s;
+ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;
+
+ok 18, $_ eq '';
+
+# If we got any errors that we were not expecting, then print them
+print $_ if length $_;
+
+
diff --git a/t/comp/script.t b/t/comp/script.t
index f37e46bb66..d0c12e9552 100755
--- a/t/comp/script.t
+++ b/t/comp/script.t
@@ -4,7 +4,8 @@
 
 print "1..3\n";
 
-$x = `./perl -e 'print "ok\n";'`;
+$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
+$x = `$PERL -le "print 'ok';"`;
 if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "print ""ok\n""";`; }
 
 if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
@@ -13,12 +14,12 @@ open(try,">Comp.script") || (die "Can't open temp file.");
 print try 'print "ok\n";'; print try "\n";
 close try;
 
-$x = `./perl Comp.script`;
+$x = `$PERL Comp.script`;
 if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. Comp.script`; }
 
 if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
-$x = `./perl <Comp.script`;
+$x = `$PERL <Comp.script`;
 if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. <Comp.script`; }
 
 if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/t/comp/use.t b/t/comp/use.t
new file mode 100755
index 0000000000..a6ce2a4d56
--- /dev/null
+++ b/t/comp/use.t
@@ -0,0 +1,101 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..14\n";
+
+my $i = 1;
+
+eval "use 5.000;";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval sprintf "use %.5f;", $];
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+
+eval sprintf "use %.5f;", $] - 0.000001;
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval sprintf("use %.5f;", $] + 1);
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval sprintf "use %.5f;", $] + 0.00001;
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+
+
+use lib; # I know that this module will be there.
+
+
+local $lib::VERSION = 1.0;
+
+eval "use lib 0.9";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval "use lib 1.0";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval "use lib 1.01";
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+
+eval "use lib 0.9 qw(fred)";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+print "not " unless $INC[0] eq "fred";
+print "ok ",$i++,"\n";
+
+eval "use lib 1.0 qw(joe)";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+print "not " unless $INC[0] eq "joe";
+print "ok ",$i++,"\n";
+
+eval "use lib 1.01 qw(freda)";
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+print "not " if $INC[0] eq "freda";
+print "ok ",$i++,"\n";