perl 5.003_02: [no incremental changelog available]

4 files changed, 142 insertions, 8 deletions

diff --git a/t/comp/redef.t b/t/comp/redef.t
new file mode 100644
index 0000000000..6a73ae1c2e
--- /dev/null
+++ b/t/comp/redef.t
@@ -0,0 +1,79 @@
+#!./perl
+#
+# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+
+BEGIN {
+    $^W = 1;
+    $warn = "";
+    $SIG{__WARN__} = sub { $warn .= join("",@_) }
+}
+
+sub ok ($$) { 
+    print $_[1] ? "ok " : "not ok ", $_[0], "\n";
+}
+
+print "1..18\n";
+
+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/Prototype mismatch: \Q(none) 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/Prototype mismatch: \Q(none) 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/Prototype mismatch: \Q() 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/Prototype mismatch: \Q() 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/Prototype mismatch: \Q($) 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/Prototype mismatch: \Q($) 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/Prototype mismatch: \(\$\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/lib/db-btree.t b/t/lib/db-btree.t
index f3cf94487e..d5d97d7b3f 100755
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -373,10 +373,12 @@ print( "@unknown" eq "" ? "ok 78\n" : "not ok 78\n") ;
 my @smith = $YY->get_dup('Smith') ;
 print( "@smith" eq "John" ? "ok 79\n" : "not ok 79\n") ;
 
-my @wall = $YY->get_dup('Wall') ;
-my %wall ;
-@wall{@wall} = @wall ;
-print( (@wall == 3 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) ? "ok 80\n" : "not ok 80\n") ;
+{
+ my @wall = $YY->get_dup('Wall') ;
+ my %wall ;
+ @wall{@wall} = @wall ;
+ print( (@wall == 3 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) ? "ok 80\n" : "not ok 80\n") ;
+}
 
 # hash
 my %unknown = $YY->get_dup('Unknown', 1) ;
@@ -385,7 +387,7 @@ print( keys %unknown == 0 ? "ok 81\n" : "not ok 81\n") ;
 my %smith = $YY->get_dup('Smith', 1) ;
 print( (keys %smith == 1 && $smith{'John'}) ? "ok 82\n" : "not ok 82\n") ;
 
-my %wall = $YY->get_dup('Wall', 1) ;
+%wall = $YY->get_dup('Wall', 1) ;
 print( (keys %wall == 3 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) ? "ok 83\n" : "not ok 83\n") ;
 
 undef $YY ;
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 84e5067b85..e85583fdb3 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -5,7 +5,8 @@ BEGIN {
     @INC = '../lib' if -d '../lib';
     require Config; import Config;
     if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
-          $Config{'extensions'} !~ /\bIO\b/)    &&
+          $Config{'extensions'} !~ /\bIO\b/	||
+	  $^O eq 'os2')    &&
           !(($^O eq 'VMS') && $Config{d_socket})) {
 	print "1..0\n";
 	exit 0;
@@ -18,8 +19,8 @@ print "1..3\n";
 use Socket;
 use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
 
-$udpa = IO::Socket::INET->new(Proto => 'udp', Addr => 'localhost');
-$udpb = IO::Socket::INET->new(Proto => 'udp', Addr => 'localhost');
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
 
 print "ok 1\n";
 
diff --git a/t/op/inc.t b/t/op/inc.t
new file mode 100644
index 0000000000..aee91f798b
--- /dev/null
+++ b/t/op/inc.t
@@ -0,0 +1,52 @@
+#!./perl
+
+
+# $RCSfile$
+
+print "1..6\n";
+
+# Verify that addition/subtraction properly upgrade to doubles.
+# These tests are only useful on machines with 32 bit longs,
+# and one's complement negation, but shouldn't fail anywhere.
+
+$a = 2147483647;
+$a++;
+if ($a == 2147483648) 
+	{print "ok 1\n"}
+else
+	{print "not ok 1\n";}
+
+$a = 2147483647;
+$c=++$a;
+if ($a == 2147483648) 
+	{print "ok 2\n"}
+else
+	{print "not ok 2\n";}
+
+$a = 2147483647;
+$a=$a+1;
+if ($a == 2147483648) 
+	{print "ok 3\n"}
+else
+	{print "not ok 3\n";}
+
+$a = -2147483648;
+$c=$a--;
+if ($a == -2147483649) 
+	{print "ok 4\n"}
+else
+	{print "not ok 4\n";}
+
+$a = -2147483648;
+$c=--$a;
+if ($a == -2147483649) 
+	{print "ok 5\n"}
+else
+	{print "not ok 5\n";}
+
+$a = -2147483648;
+$a=$a-1;
+if ($a == -2147483649) 
+	{print "ok 6\n"}
+else
+	{print "not ok 6\n";}