Merge maint-5.004 branch (5.004_03) with mainline.

MANIFEST is out of sync.

p4raw-id: //depot/perl@114

23 files changed, 1230 insertions, 126 deletions

diff --git a/t/TEST b/t/TEST
index a6cca53373..ae436667db 100755
--- a/t/TEST
+++ b/t/TEST
@@ -101,7 +101,7 @@ while ($test = shift) {
 	}
     } else {
 	$next += 1;
-	print "FAILED on test $next\n";
+	print "FAILED at test $next\n";
 	$bad = $bad + 1;
 	$_ = $test;
 	if (/^base/) {
@@ -113,6 +113,7 @@ while ($test = shift) {
 if ($bad == 0) {
     if ($ok) {
 	print "All tests successful.\n";
+	# XXX add mention of 'perlbug -ok' ?
     } else {
 	die "FAILED--no tests were run for some reason.\n";
     }
diff --git a/t/base/lex.t b/t/base/lex.t
index 7e0ca70fd7..6d03b9e8df 100755
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
 
-print "1..26\n";
+print "1..27\n";
 
 $x = 'x';
 
@@ -103,3 +103,5 @@ print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n";
 print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
 print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
 print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
+
+print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 27\n" : "not ok 27\n");
diff --git a/t/comp/cmdopt.t b/t/comp/cmdopt.t
index 4d5c78a4cb..3f701a456a 100755
--- a/t/comp/cmdopt.t
+++ b/t/comp/cmdopt.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: cmdopt.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:17 $
 
-print "1..40\n";
+print "1..44\n";
 
 # test the optimization of constants
 
@@ -81,3 +81,10 @@ if ($a !~ /a/ || $x) { print "ok 38\n";} else { print "not ok 38\n";}
 $x = '';
 if ($a =~ /a/ || $x) { print "ok 39\n";} else { print "not ok 39\n";}
 if ($a !~ /a/ || $x) { print "not ok 40\n";} else { print "ok 40\n";}
+
+$x = 1;
+if ($a eq 'a' xor $x) { print "not ok 41\n";} else { print "ok 41\n";}
+if ($a ne 'a' xor $x) { print "ok 42\n";} else { print "not ok 42\n";}
+$x = '';
+if ($a eq 'a' xor $x) { print "ok 43\n";} else { print "not ok 43\n";}
+if ($a ne 'a' xor $x) { print "not ok 44\n";} else { print "ok 44\n";}
diff --git a/t/comp/term.t b/t/comp/term.t
index b248e9b161..eb9968003e 100755
--- a/t/comp/term.t
+++ b/t/comp/term.t
@@ -4,7 +4,7 @@
 
 # tests that aren't important enough for base.term
 
-print "1..14\n";
+print "1..22\n";
 
 $x = "\\n";
 print "#1\t:$x: eq " . ':\n:' . "\n";
@@ -33,3 +33,38 @@ if ("$foo[1]b" eq "2b") { print "ok 12\n";} else {print "not ok 12\n";}
 if ("@foo[0..1]b" eq "1 2b") { print "ok 13\n";} else {print "not ok 13\n";}
 $" = '::';
 if ("@foo[0..1]b" eq "1::2b") { print "ok 14\n";} else {print "not ok 14\n";}
+
+# test if C<eval "{...}"> distinguishes between blocks and hashrefs
+
+$a = "{ '\\'' , 'foo' }";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 15\n";} else {print "not ok 15\n";}
+
+$a = "{ '\\\\\\'abc' => 'foo' }";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 16\n";} else {print "not ok 16\n";}
+
+$a = "{'a\\\n\\'b','foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 17\n";} else {print "not ok 17\n";}
+
+$a = "{'\\\\\\'\\\\'=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 18\n";} else {print "not ok 18\n";}
+
+$a = "{q,a'b,,'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 19\n";} else {print "not ok 19\n";}
+
+$a = "{q[[']]=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 20\n";} else {print "not ok 20\n";}
+
+# needs disambiguation if first term is a variable
+$a = "+{ \$a , 'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 21\n";} else {print "not ok 21\n";}
+
+$a = "+{ \$a=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 22\n";} else {print "not ok 22\n";}
diff --git a/t/lib/complex.t b/t/lib/complex.t
index 80a56254ba..c05f40f2d3 100755
--- a/t/lib/complex.t
+++ b/t/lib/complex.t
@@ -62,6 +62,21 @@ sub test_dbz {
     }
 }
 
+# test the logofzeros
+
+sub test_loz {
+    for my $op (@_) {
+	$test++;
+
+#	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";));
+    }
+}
+
+my $minusi = cplx(0, -1);
+
 test_dbz(
 	 'i/0',
 #	 'tan(pi/2)',	# may succeed thanks to floating point inaccuracies
@@ -69,9 +84,11 @@ test_dbz(
 	 'csc(0)',
 	 'cot(0)',
 	 'atan(i)',
+	 'atan($minusi)',
 	 'asec(0)',
 	 'acsc(0)',
 	 'acot(i)',
+	 'acot($minusi)',
 #	 'tanh(pi/2)',	# may succeed thanks to floating point inaccuracies
 #	 'sech(pi/2)',	# may succeed thanks to floating point inaccuracies
 	 'csch(0)',
@@ -79,7 +96,12 @@ test_dbz(
 	 'atanh(1)',
 	 'asech(0)',
 	 'acsch(0)',
-	 'acoth(1)'
+	 'acoth(1)',
+	);
+
+test_loz(
+	 'atanh(-1)',
+	 'acoth(-1)',
 	);
 
 # test the 0**0
@@ -342,7 +364,7 @@ __END__
 |'z - ~z':'2*i*Im(z)'
 |'z * ~z':'abs(z) * abs(z)'
 
-{ (2,3); [3,2]; (-3,2); (0,2); 3; 1.2; (-3, 0); (-2, -1); [2,1] }
+{ (0.5, 0); (-0.5, 0); (2,3); [3,2]; (-3,2); (0,2); 3; 1.2; (-3, 0); (-2, -1); [2,1] }
 
 |'(root(z, 4))[1] ** 4':'z'
 |'(root(z, 5))[3] ** 5':'z'
@@ -350,8 +372,8 @@ __END__
 |'abs(z)':'r'
 |'acot(z)':'acotan(z)'
 |'acsc(z)':'acosec(z)'
-|'acsc(z)':'asin(1 / z)'
-|'asec(z)':'acos(1 / z)'
+|'abs(acsc(z))':'abs(asin(1 / z))'
+|'abs(asec(z))':'abs(acos(1 / z))'
 |'cbrt(z)':'cbrt(r) * exp(i * t/3)'
 |'cos(acos(z))':'z'
 |'cos(z) ** 2 + sin(z) ** 2':1
@@ -409,144 +431,346 @@ __END__
 |'atanh(tanh(z))':'z'
 
 &sin
+(-2.0,0):(  -0.90929742682568,  0               )
+(-1.0,0):(  -0.84147098480790,  0               )
+(-0.5,0):(  -0.47942553860420,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.47942553860420,  0               )
+( 1.0,0):(   0.84147098480790,  0               )
+( 2.0,0):(   0.90929742682568,  0               )
+
+&sin
 ( 2, 3):(  9.15449914691143, -4.16890695996656)
 (-2, 3):( -9.15449914691143, -4.16890695996656)
 (-2,-3):( -9.15449914691143,  4.16890695996656)
 ( 2,-3):(  9.15449914691143,  4.16890695996656)
 
 &cos
+(-2.0,0):(  -0.41614683654714,  0               )
+(-1.0,0):(   0.54030230586814,  0               )
+(-0.5,0):(   0.87758256189037,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   0.87758256189037,  0               )
+( 1.0,0):(   0.54030230586814,  0               )
+( 2.0,0):(  -0.41614683654714,  0               )
+
+&cos
 ( 2, 3):( -4.18962569096881, -9.10922789375534)
 (-2, 3):( -4.18962569096881,  9.10922789375534)
 (-2,-3):( -4.18962569096881, -9.10922789375534)
 ( 2,-3):( -4.18962569096881,  9.10922789375534)
 
 &tan
+(-2.0,0):(   2.18503986326152,  0               )
+(-1.0,0):(  -1.55740772465490,  0               )
+(-0.5,0):(  -0.54630248984379,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.54630248984379,  0               )
+( 1.0,0):(   1.55740772465490,  0               )
+( 2.0,0):(  -2.18503986326152,  0               )
+
+&tan
 ( 2, 3):( -0.00376402564150,  1.00323862735361)
 (-2, 3):(  0.00376402564150,  1.00323862735361)
 (-2,-3):(  0.00376402564150, -1.00323862735361)
 ( 2,-3):( -0.00376402564150, -1.00323862735361)
 
 &sec
+(-2.0,0):(  -2.40299796172238,  0               )
+(-1.0,0):(   1.85081571768093,  0               )
+(-0.5,0):(   1.13949392732455,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   1.13949392732455,  0               )
+( 1.0,0):(   1.85081571768093,  0               )
+( 2.0,0):(  -2.40299796172238,  0               )
+
+&sec
 ( 2, 3):( -0.04167496441114,  0.09061113719624)
 (-2, 3):( -0.04167496441114, -0.09061113719624)
 (-2,-3):( -0.04167496441114,  0.09061113719624)
 ( 2,-3):( -0.04167496441114, -0.09061113719624)
 
 &csc
+(-2.0,0):(  -1.09975017029462,  0               )
+(-1.0,0):(  -1.18839510577812,  0               )
+(-0.5,0):(  -2.08582964293349,  0               )
+( 0.5,0):(   2.08582964293349,  0               )
+( 1.0,0):(   1.18839510577812,  0               )
+( 2.0,0):(   1.09975017029462,  0               )
+
+&csc
 ( 2, 3):(  0.09047320975321,  0.04120098628857)
 (-2, 3):( -0.09047320975321,  0.04120098628857)
 (-2,-3):( -0.09047320975321, -0.04120098628857)
 ( 2,-3):(  0.09047320975321, -0.04120098628857)
 
 &cot
+(-2.0,0):(   0.45765755436029,  0               )
+(-1.0,0):(  -0.64209261593433,  0               )
+(-0.5,0):(  -1.83048772171245,  0               )
+( 0.5,0):(   1.83048772171245,  0               )
+( 1.0,0):(   0.64209261593433,  0               )
+( 2.0,0):(  -0.45765755436029,  0               )
+
+&cot
 ( 2, 3):( -0.00373971037634, -0.99675779656936)
 (-2, 3):(  0.00373971037634, -0.99675779656936)
 (-2,-3):(  0.00373971037634,  0.99675779656936)
 ( 2,-3):( -0.00373971037634,  0.99675779656936)
 
 &asin
+(-2.0,0):(  -1.57079632679490,  1.31695789692482)
+(-1.0,0):(  -1.57079632679490,  0               )
+(-0.5,0):(  -0.52359877559830,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.52359877559830,  0               )
+( 1.0,0):(   1.57079632679490,  0               )
+( 2.0,0):(   1.57079632679490, -1.31695789692482)
+
+&asin
 ( 2, 3):(  0.57065278432110,  1.98338702991654)
 (-2, 3):( -0.57065278432110,  1.98338702991654)
 (-2,-3):( -0.57065278432110, -1.98338702991654)
 ( 2,-3):(  0.57065278432110, -1.98338702991654)
 
 &acos
+(-2.0,0):(   3.14159265358979, -1.31695789692482)
+(-1.0,0):(   3.14159265358979,  0               )
+(-0.5,0):(   2.09439510239320,  0               )
+( 0.0,0):(   1.57079632679490,  0               )
+( 0.5,0):(   1.04719755119660,  0               )
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   0               ,  1.31695789692482)
+
+&acos
 ( 2, 3):(  1.00014354247380, -1.98338702991654)
 (-2, 3):(  2.14144911111600, -1.98338702991654)
 (-2,-3):(  2.14144911111600,  1.98338702991654)
 ( 2,-3):(  1.00014354247380,  1.98338702991654)
 
 &atan
+(-2.0,0):(  -1.10714871779409,  0               )
+(-1.0,0):(  -0.78539816339745,  0               )
+(-0.5,0):(  -0.46364760900081,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.46364760900081,  0               )
+( 1.0,0):(   0.78539816339745,  0               )
+( 2.0,0):(   1.10714871779409,  0               )
+
+&atan
 ( 2, 3):(  1.40992104959658,  0.22907268296854)
 (-2, 3):( -1.40992104959658,  0.22907268296854)
 (-2,-3):( -1.40992104959658, -0.22907268296854)
 ( 2,-3):(  1.40992104959658, -0.22907268296854)
 
 &asec
+(-2.0,0):(   2.09439510239320,  0               )
+(-1.0,0):(   3.14159265358979,  0               )
+(-0.5,0):(   3.14159265358979, -1.31695789692482)
+( 0.5,0):(   0               ,  1.31695789692482)
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   1.04719755119660,  0               )
+
+&asec
 ( 2, 3):(  1.42041072246703,  0.23133469857397)
 (-2, 3):(  1.72118193112276,  0.23133469857397)
 (-2,-3):(  1.72118193112276, -0.23133469857397)
 ( 2,-3):(  1.42041072246703, -0.23133469857397)
 
 &acsc
+(-2.0,0):(  -0.52359877559830,  0               )
+(-1.0,0):(  -1.57079632679490,  0               )
+(-0.5,0):(  -1.57079632679490,  1.31695789692482)
+( 0.5,0):(   1.57079632679490, -1.31695789692482)
+( 1.0,0):(   1.57079632679490,  0               )
+( 2.0,0):(   0.52359877559830,  0               )
+
+&acsc
 ( 2, 3):(  0.15038560432786, -0.23133469857397)
 (-2, 3):( -0.15038560432786, -0.23133469857397)
 (-2,-3):( -0.15038560432786,  0.23133469857397)
 ( 2,-3):(  0.15038560432786,  0.23133469857397)
 
 &acot
+(-2.0,0):(  -0.46364760900081,  0               )
+(-1.0,0):(  -0.78539816339745,  0               )
+(-0.5,0):(  -1.10714871779409,  0               )
+( 0.5,0):(   1.10714871779409,  0               )
+( 1.0,0):(   0.78539816339745,  0               )
+( 2.0,0):(   0.46364760900081,  0               )
+
+&acot
 ( 2, 3):(  0.16087527719832, -0.22907268296854)
 (-2, 3):( -0.16087527719832, -0.22907268296854)
 (-2,-3):( -0.16087527719832,  0.22907268296854)
 ( 2,-3):(  0.16087527719832,  0.22907268296854)
 
 &sinh
+(-2.0,0):(  -3.62686040784702,  0               )
+(-1.0,0):(  -1.17520119364380,  0               )
+(-0.5,0):(  -0.52109530549375,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.52109530549375,  0               )
+( 1.0,0):(   1.17520119364380,  0               )
+( 2.0,0):(   3.62686040784702,  0               )
+
+&sinh
 ( 2, 3):( -3.59056458998578,  0.53092108624852)
 (-2, 3):(  3.59056458998578,  0.53092108624852)
 (-2,-3):(  3.59056458998578, -0.53092108624852)
 ( 2,-3):( -3.59056458998578, -0.53092108624852)
 
 &cosh
+(-2.0,0):(   3.76219569108363,  0               )
+(-1.0,0):(   1.54308063481524,  0               )
+(-0.5,0):(   1.12762596520638,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   1.12762596520638,  0               )
+( 1.0,0):(   1.54308063481524,  0               )
+( 2.0,0):(   3.76219569108363,  0               )
+
+&cosh
 ( 2, 3):( -3.72454550491532,  0.51182256998738)
 (-2, 3):( -3.72454550491532, -0.51182256998738)
 (-2,-3):( -3.72454550491532,  0.51182256998738)
 ( 2,-3):( -3.72454550491532, -0.51182256998738)
 
 &tanh
+(-2.0,0):(  -0.96402758007582,  0               )
+(-1.0,0):(  -0.76159415595576,  0               )
+(-0.5,0):(  -0.46211715726001,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.46211715726001,  0               )
+( 1.0,0):(   0.76159415595576,  0               )
+( 2.0,0):(   0.96402758007582,  0               )
+
+&tanh
 ( 2, 3):(  0.96538587902213, -0.00988437503832)
 (-2, 3):( -0.96538587902213, -0.00988437503832)
 (-2,-3):( -0.96538587902213,  0.00988437503832)
 ( 2,-3):(  0.96538587902213,  0.00988437503832)
 
 &sech
+(-2.0,0):(   0.26580222883408,  0               )
+(-1.0,0):(   0.64805427366389,  0               )
+(-0.5,0):(   0.88681888397007,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   0.88681888397007,  0               )
+( 1.0,0):(   0.64805427366389,  0               )
+( 2.0,0):(   0.26580222883408,  0               )
+
+&sech
 ( 2, 3):( -0.26351297515839, -0.03621163655877)
 (-2, 3):( -0.26351297515839,  0.03621163655877)
 (-2,-3):( -0.26351297515839, -0.03621163655877)
 ( 2,-3):( -0.26351297515839,  0.03621163655877)
 
 &csch
+(-2.0,0):(  -0.27572056477178,  0               )
+(-1.0,0):(  -0.85091812823932,  0               )
+(-0.5,0):(  -1.91903475133494,  0               )
+( 0.5,0):(   1.91903475133494,  0               )
+( 1.0,0):(   0.85091812823932,  0               )
+( 2.0,0):(   0.27572056477178,  0               )
+
+&csch
 ( 2, 3):( -0.27254866146294, -0.04030057885689)
 (-2, 3):(  0.27254866146294, -0.04030057885689)
 (-2,-3):(  0.27254866146294,  0.04030057885689)
 ( 2,-3):( -0.27254866146294,  0.04030057885689)
 
 &coth
+(-2.0,0):(  -1.03731472072755,  0               )
+(-1.0,0):(  -1.31303528549933,  0               )
+(-0.5,0):(  -2.16395341373865,  0               )
+( 0.5,0):(   2.16395341373865,  0               )
+( 1.0,0):(   1.31303528549933,  0               )
+( 2.0,0):(   1.03731472072755,  0               )
+
+&coth
 ( 2, 3):(  1.03574663776500,  0.01060478347034)
 (-2, 3):( -1.03574663776500,  0.01060478347034)
 (-2,-3):( -1.03574663776500, -0.01060478347034)
 ( 2,-3):(  1.03574663776500, -0.01060478347034)
 
 &asinh
+(-2.0,0):(  -1.44363547517881,  0               )
+(-1.0,0):(  -0.88137358701954,  0               )
+(-0.5,0):(  -0.48121182505960,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.48121182505960,  0               )
+( 1.0,0):(   0.88137358701954,  0               )
+( 2.0,0):(   1.44363547517881,  0               )
+
+&asinh
 ( 2, 3):(  1.96863792579310,  0.96465850440760)
 (-2, 3):( -1.96863792579310,  0.96465850440761)
 (-2,-3):( -1.96863792579310, -0.96465850440761)
 ( 2,-3):(  1.96863792579310, -0.96465850440760)
 
 &acosh
+(-2.0,0):(  -1.31695789692482,  3.14159265358979)
+(-1.0,0):(   0,                 3.14159265358979)
+(-0.5,0):(   0,                 2.09439510239320)
+( 0.0,0):(   0,                 1.57079632679490)
+( 0.5,0):(   0,                 1.04719755119660)
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   1.31695789692482,  0               )
+
+&acosh
 ( 2, 3):(  1.98338702991654,  1.00014354247380)
 (-2, 3):( -1.98338702991653, -2.14144911111600)
 (-2,-3):( -1.98338702991653,  2.14144911111600)
 ( 2,-3):(  1.98338702991654, -1.00014354247380)
 
 &atanh
+(-2.0,0):(  -0.54930614433405,  1.57079632679490)
+(-0.5,0):(  -0.54930614433405,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.54930614433405,  0               )
+( 2.0,0):(   0.54930614433405,  1.57079632679490)
+
+&atanh
 ( 2, 3):(  0.14694666622553,  1.33897252229449)
 (-2, 3):( -0.14694666622553,  1.33897252229449)
 (-2,-3):( -0.14694666622553, -1.33897252229449)
 ( 2,-3):(  0.14694666622553, -1.33897252229449)
 
 &asech
+(-2.0,0):(   0               , 2.09439510239320)
+(-1.0,0):(   0               , 3.14159265358979)
+(-0.5,0):(  -1.31695789692482, 3.14159265358979)
+( 0.5,0):(   1.31695789692482, 0               )
+( 1.0,0):(   0               , 0               )
+( 2.0,0):(   0               , 1.04719755119660)
+
+&asech
 ( 2, 3):(  0.23133469857397, -1.42041072246703)
 (-2, 3):( -0.23133469857397,  1.72118193112276)
 (-2,-3):( -0.23133469857397, -1.72118193112276)
 ( 2,-3):(  0.23133469857397,  1.42041072246703)
 
 &acsch
+(-2.0,0):(  -0.48121182505960, 0               )
+(-1.0,0):(  -0.88137358701954, 0               )
+(-0.5,0):(  -1.44363547517881, 0               )
+( 0.5,0):(   1.44363547517881, 0               )
+( 1.0,0):(   0.88137358701954, 0               )
+( 2.0,0):(   0.48121182505960, 0               )
+
+&acsch
 ( 2, 3):(  0.15735549884499, -0.22996290237721)
 (-2, 3):( -0.15735549884499, -0.22996290237721)
 (-2,-3):( -0.15735549884499,  0.22996290237721)
 ( 2,-3):(  0.15735549884499,  0.22996290237721)
 
 &acoth
+(-2.0,0):(  -0.54930614433405, 0               )
+(-0.5,0):(  -0.54930614433405, 1.57079632679490)
+( 0.5,0):(   0.54930614433405, 1.57079632679490)
+( 2.0,0):(   0.54930614433405, 0               )
+
+&acoth
 ( 2, 3):(  0.14694666622553, -0.23182380450040)
 (-2, 3):( -0.14694666622553, -0.23182380450040)
 (-2,-3):( -0.14694666622553,  0.23182380450040)
diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
index c90c9d7d98..bebb63df8d 100755
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..92\n";
+print "1..102\n";
 
 sub ok
 {
@@ -91,7 +91,7 @@ ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
-ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos');
+ok(20, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 : 0640) || $^O eq 'amigaos');
 
 while (($key,$value) = each(%h)) {
     $i++;
@@ -513,4 +513,96 @@ unlink $Dfile1 ;
     unlink $filename ;
 }
 
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+	my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+	$_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+    eval 'use SubDB ; ';
+    main::ok(93, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbbtree.tmp", O_RDWR|O_CREAT, 0640, $DB_BTREE );
+	' ;
+
+    main::ok(94, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(95, $@ eq "") ;
+    main::ok(96, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
+    main::ok(97, $@ eq "") ;
+    main::ok(98, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(99, $@ eq "" ) ;
+    main::ok(100, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("joe") ' ;
+    main::ok(101, $@ eq "") ;
+    main::ok(102, $ret eq "[[11]]") ;
+
+    unlink "SubDB.pm", "dbbtree.tmp" ;
+
+}
+
 exit ;
diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
index 471ee0283b..9df918cce5 100755
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..52\n";
+print "1..62\n";
 
 sub ok
 {
@@ -70,7 +70,7 @@ ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
-ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos');
+ok(16, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 : 0640) || $^O eq 'amigaos');
 
 while (($key,$value) = each(%h)) {
     $i++;
@@ -320,4 +320,95 @@ untie %h ;
     unlink $filename ;
 }
 
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+	my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+	$_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+    eval 'use SubDB ; ';
+    main::ok(53, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640, $DB_HASH );
+	' ;
+
+    main::ok(54, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(55, $@ eq "") ;
+    main::ok(56, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
+    main::ok(57, $@ eq "") ;
+    main::ok(58, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(59, $@ eq "" ) ;
+    main::ok(60, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("joe") ' ;
+    main::ok(61, $@ eq "") ;
+    main::ok(62, $ret eq "[[11]]") ;
+
+    unlink "SubDB.pm", "dbhash.tmp" ;
+
+}
+
 exit ;
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index 338edd0db5..9950741ffe 100755
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -41,7 +41,7 @@ sub bad_one
 EOM
 }
 
-print "1..56\n";
+print "1..66\n";
 
 my $Dfile = "recno.tmp";
 unlink $Dfile ;
@@ -93,7 +93,7 @@ my $X  ;
 my @h ;
 ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
 
-ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
+ok(18, ((stat($Dfile))[2] & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 : 0640)
 	|| $^O eq 'amigaos') ;
 
 #my $l = @h ;
@@ -198,6 +198,17 @@ untie(@h);
 
 unlink $Dfile;
 
+sub docat
+{
+    my $file = shift;
+    local $/ = undef;
+    open(CAT,$file) || die "Cannot open $file:$!";
+    my $result = <CAT>;
+    close(CAT);
+    return $result;
+}
+
+
 {
     # Check bval defaults to \n
 
@@ -208,7 +219,7 @@ unlink $Dfile;
     $h[1] = "def" ;
     $h[3] = "ghi" ;
     untie @h ;
-    my $x = `cat $Dfile` ;
+    my $x = docat($Dfile) ;
     unlink $Dfile;
     ok(49, $x eq "abc\ndef\n\nghi\n") ;
 }
@@ -224,7 +235,7 @@ unlink $Dfile;
     $h[1] = "def" ;
     $h[3] = "ghi" ;
     untie @h ;
-    my $x = `cat $Dfile` ;
+    my $x = docat($Dfile) ;
     unlink $Dfile;
     my $ok = ($x eq "abc-def--ghi-") ;
     bad_one() unless $ok ;
@@ -243,7 +254,7 @@ unlink $Dfile;
     $h[1] = "def" ;
     $h[3] = "ghi" ;
     untie @h ;
-    my $x = `cat $Dfile` ;
+    my $x = docat($Dfile) ;
     unlink $Dfile;
     my $ok = ($x eq "abc  def       ghi  ") ;
     bad_one() unless $ok ;
@@ -263,7 +274,7 @@ unlink $Dfile;
     $h[1] = "def" ;
     $h[3] = "ghi" ;
     untie @h ;
-    my $x = `cat $Dfile` ;
+    my $x = docat($Dfile) ;
     unlink $Dfile;
     my $ok = ($x eq "abc--def-------ghi--") ;
     bad_one() unless $ok ;
@@ -280,4 +291,95 @@ unlink $Dfile;
     unlink $filename ;
 }
 
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+	my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+	$_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }   
+    eval 'use SubDB ; ';
+    main::ok(57, $@ eq "") ;
+    my @h ;
+    my $X ;
+    eval '
+	$X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
+	' ;
+
+    main::ok(58, $@ eq "") ;
+
+    my $ret = eval '$h[3] = 3 ; return $h[3] ' ;
+    main::ok(59, $@ eq "") ;
+    main::ok(60, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put(1, 4) ; $X->get(1, $value) ; return $value' ;
+    main::ok(61, $@ eq "") ;
+    main::ok(62, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(63, $@ eq "" ) ;
+    main::ok(64, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method(1) ' ;
+    main::ok(65, $@ eq "") ;
+    main::ok(66, $ret eq "[[11]]") ;
+
+    unlink "SubDB.pm", "recno.tmp" ;
+
+}
+
 exit ;
diff --git a/t/lib/filehand.t b/t/lib/filehand.t
index c23a7e0475..cedc2ebcb8 100755
--- a/t/lib/filehand.t
+++ b/t/lib/filehand.t
@@ -43,7 +43,7 @@ print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
 print "ok 5\n";
 
 $fh->seek(0,0);
-print "not " unless (<$fh> eq $buffer);
+print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
 print "ok 6\n";
 
 $fh->seek(0,2);
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index a0f081fa1e..37660c26c6 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use GDBM_File;
 
-print "1..12\n";
+print "1..20\n";
 
 unlink <Op.dbmx*>;
 
@@ -121,3 +121,86 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use GDBM_File;
+   @ISA=qw(GDBM_File);
+   @EXPORT = @GDBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; ';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval ' &GDBM_WRCREAT eq &main::GDBM_WRCREAT ' ;
+    main::ok(17, $@ eq "" ) ;
+    main::ok(18, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(19, $@ eq "") ;
+    main::ok(20, $ret eq "[[5]]") ;
+
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
index b10d7c26d4..27f3ec5066 100755
--- a/t/lib/ndbm.t
+++ b/t/lib/ndbm.t
@@ -16,7 +16,7 @@ require NDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..12\n";
+print "1..18\n";
 
 unlink <Op.dbmx*>;
 
@@ -124,3 +124,82 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use NDBM_File;
+   @ISA=qw(NDBM_File);
+   @EXPORT = @NDBM_File::EXPORT if defined @NDBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ; ';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/t/lib/odbm.t b/t/lib/odbm.t
index 06ba844029..6cfefdaee5 100755
--- a/t/lib/odbm.t
+++ b/t/lib/odbm.t
@@ -16,7 +16,7 @@ require ODBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..12\n";
+print "1..18\n";
 
 unlink <Op.dbmx*>;
 
@@ -124,3 +124,82 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use ODBM_File;
+   @ISA=qw(ODBM_File);
+   @EXPORT = @ODBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index 9928847b94..c8ae09285b 100755
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -15,7 +15,7 @@ require SDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..12\n";
+print "1..18\n";
 
 unlink <Op.dbmx*>;
 
@@ -124,3 +124,82 @@ print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use SDBM_File;
+   @ISA=qw(SDBM_File);
+   @EXPORT = @SDBM_File::EXPORT if defined @SDBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/t/op/local.t b/t/op/local.t
index 043201072d..f527c9c9a9 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
 
-print "1..20\n";
+print "1..23\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -43,3 +43,12 @@ $d{''} = "ok 18\n";
 print &foo2("ok 11\n","ok 12\n");
 
 print $a,@b,@c,%d,$x,$y;
+
+eval 'local($$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n";
+
+eval 'local(@$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
+
+eval 'local(%$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
diff --git a/t/op/magic.t b/t/op/magic.t
index 49caab56b4..bddcd27679 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -46,9 +46,9 @@ else {
 
     $| = 1;		# command buffering
 
-    $SIG{"INT"} = "ok3"; kill "INT",$$;
-    $SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";
-    $SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";
+    $SIG{"INT"} = "ok3";     kill "INT",$$;
+    $SIG{"INT"} = "IGNORE";  kill "INT",$$; print "ok 4\n";
+    $SIG{"INT"} = "DEFAULT"; kill "INT",$$; print "not ok\n";
 
     sub ok3 {
 	if (($x = pop(@_)) eq "INT") {
@@ -106,24 +106,41 @@ ok 17, $@ eq "foo\n", $@;
 ok 18, $$ > 0, $$;
 
 # $^X and $0
-if ($Is_MSWin32) {
-    for (19 .. 25) { ok $_, 1 }
-}
-else {
+{
     if ($^O eq 'qnx') {
 	chomp($wd = `pwd`);
     }
     else {
 	$wd = '.';
     }
+    my $perl = "$wd/perl";
+    my $headmaybe = '';
+    my $tailmaybe = '';
     $script = "$wd/show-shebang";
-    $s1 = $s2 = "\$^X is $wd/perl, \$0 is $script\n";
+    if ($Is_MSWin32) {
+	chomp($wd = `cd`);
+	$perl = "$wd\\perl.exe";
+	$script = "$wd\\show-shebang.bat";
+	$headmaybe = <<EOH ;
+\@rem ='
+\@echo off
+$perl -x \%0
+goto endofperl
+\@rem ';
+EOH
+	$tailmaybe = <<EOT ;
+
+__END__
+:endofperl
+EOT
+    }
+    $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
     if ($^O eq 'os2') {
 	# Started by ksh, which adds suffixes '.exe' and '.' to perl and script
 	$s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n";
     }
     ok 19, open(SCRIPT, ">$script"), $!;
-    ok 20, print(SCRIPT <<EOB . <<'EOF'), $!;
+    ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
 #!$wd/perl
 EOB
 print "\$^X is $^X, \$0 is $0\n";
@@ -132,10 +149,10 @@ EOF
     ok 22, chmod(0755, $script), $!;
     $_ = `$script`;
     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
-    s{is perl}{is $wd/perl}; # for systems where $^X is only a basename
-    ok 23, $_ eq $s2, ":$_:!=:$s2:";
-    $_ = `$wd/perl $script`;
-    ok 24, $_ eq $s1, ":$_:!=:$s1: after `$wd/perl $script`";
+    s{is perl}{is $perl}; # for systems where $^X is only a basename
+    ok 23, ($Is_MSWin32 ? uc($_) eq uc($s2) : $_ eq $s2), ":$_:!=:$s2:";
+    $_ = `$perl $script`;
+    ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
     ok 25, unlink($script), $!;
 }
 
diff --git a/t/op/pack.t b/t/op/pack.t
index 223b9d169b..f9a89a3ec0 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
 
-print "1..25\n";
+print "1..29\n";
 
 $format = "c2 x5 C C x s d i l a6";
 # Need the expression in here to force ary[5] to be numeric.  This avoids
@@ -76,3 +76,27 @@ print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
 eval { $x = unpack 'w', pack 'C*', 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
 print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
 
+#
+# test the "p" template
+
+# literals
+print((unpack("p",pack("p","foo")) eq "foo" ? "ok " : "not ok "),$test++,"\n");
+
+# scalars
+print((unpack("p",pack("p",$test)) == $test ? "ok " : "not ok "),$test++,"\n");
+
+# temps
+sub foo { my $a = "a"; return $a . $a++ . $a++ }
+{
+  local $^W = 1;
+  my $last = $test;
+  local $SIG{__WARN__} = sub {
+	print "ok ",$test++,"\n" if $_[0] =~ /temporary val/
+  };
+  my $junk = pack("p", &foo);
+  print "not ok ", $test++, "\n" if $last == $test;
+}
+
+# undef should give null pointer
+print((pack("p", undef) =~ /^\0+/ ? "ok " : "not ok "),$test++,"\n");
+
diff --git a/t/op/re_tests b/t/op/re_tests
index 77d97e2aeb..ce4c5a51a2 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -42,9 +42,9 @@ a[b-d]e	ace	y	$&	ace
 a[b-d]	aac	y	$&	ac
 a[-b]	a-	y	$&	a-
 a[b-]	a-	y	$&	a-
-a[b-a]	-	c	-	-
-a[]b	-	c	-	-
-a[	-	c	-	-
+a[b-a]	-	c	-	/a[b-a]/: invalid [] range in regexp
+a[]b	-	c	-	/a[]b/: unmatched [] in regexp
+a[	-	c	-	/a[/: unmatched [] in regexp
 a]	a]	y	$&	a]
 a[]]b	a]b	y	$&	a]b
 a[^bc]d	aed	y	$&	aed
@@ -92,21 +92,21 @@ a[\S]b	a-b	y	-	-
 ab|cd	abc	y	$&	ab
 ab|cd	abcd	y	$&	ab
 ()ef	def	y	$&-$1	ef-
-*a	-	c	-	-
-(*)b	-	c	-	-
+*a	-	c	-	/*a/: ?+*{} follows nothing in regexp
+(*)b	-	c	-	/(*)b/: ?+*{} follows nothing in regexp
 $b	b	n	-	-
-a\	-	c	-	-
+a\	-	c	-	Search pattern not terminated
 a\(b	a(b	y	$&-$1	a(b-
 a\(*b	ab	y	$&	ab
 a\(*b	a((b	y	$&	a((b
 a\\b	a\b	y	$&	a\b
-abc)	-	c	-	-
-(abc	-	c	-	-
+abc)	-	c	-	/abc)/: unmatched () in regexp
+(abc	-	c	-	/(abc/: unmatched () in regexp
 ((a))	abc	y	$&-$1-$2	a-a-a
 (a)b(c)	abc	y	$&-$1-$2	abc-a-c
 a+b+c	aabbabc	y	$&	abc
 a{1,}b{1,}c	aabbabc	y	$&	abc
-a**	-	c	-	-
+a**	-	c	-	/a**/: nested *?+ in regexp
 a.+?c	abcabc	y	$&	abc
 (a+|b)*	ab	y	$&-$1	ab-b
 (a+|b){0,}	ab	y	$&-$1	ab-b
@@ -114,7 +114,7 @@ a.+?c	abcabc	y	$&	abc
 (a+|b){1,}	ab	y	$&-$1	ab-b
 (a+|b)?	ab	y	$&-$1	a-a
 (a+|b){0,1}	ab	y	$&-$1	a-a
-)(	-	c	-	-
+)(	-	c	-	/)(/: unmatched () in regexp
 [^ab]*	cde	y	$&	cde
 abc		n	-	-
 a*		y	$&	
@@ -205,9 +205,9 @@ a[-]?c	ac	y	$&	ac
 'a[b-d]'i	AAC	y	$&	AC
 'a[-b]'i	A-	y	$&	A-
 'a[b-]'i	A-	y	$&	A-
-'a[b-a]'i	-	c	-	-
-'a[]b'i	-	c	-	-
-'a['i	-	c	-	-
+'a[b-a]'i	-	c	-	/a[b-a]/: invalid [] range in regexp
+'a[]b'i	-	c	-	/a[]b/: unmatched [] in regexp
+'a['i	-	c	-	/a[/: unmatched [] in regexp
 'a]'i	A]	y	$&	A]
 'a[]]b'i	A]B	y	$&	A]B
 'a[^bc]d'i	AED	y	$&	AED
@@ -219,21 +219,21 @@ a[-]?c	ac	y	$&	ac
 'ab|cd'i	ABC	y	$&	AB
 'ab|cd'i	ABCD	y	$&	AB
 '()ef'i	DEF	y	$&-$1	EF-
-'*a'i	-	c	-	-
-'(*)b'i	-	c	-	-
+'*a'i	-	c	-	/*a/: ?+*{} follows nothing in regexp
+'(*)b'i	-	c	-	/(*)b/: ?+*{} follows nothing in regexp
 '$b'i	B	n	-	-
-'a\'i	-	c	-	-
+'a\'i	-	c	-	Search pattern not terminated
 'a\(b'i	A(B	y	$&-$1	A(B-
 'a\(*b'i	AB	y	$&	AB
 'a\(*b'i	A((B	y	$&	A((B
 'a\\b'i	A\B	y	$&	A\B
-'abc)'i	-	c	-	-
-'(abc'i	-	c	-	-
+'abc)'i	-	c	-	/abc)/: unmatched () in regexp
+'(abc'i	-	c	-	/(abc/: unmatched () in regexp
 '((a))'i	ABC	y	$&-$1-$2	A-A-A
 '(a)b(c)'i	ABC	y	$&-$1-$2	ABC-A-C
 'a+b+c'i	AABBABC	y	$&	ABC
 'a{1,}b{1,}c'i	AABBABC	y	$&	ABC
-'a**'i	-	c	-	-
+'a**'i	-	c	-	/a**/: nested *?+ in regexp
 'a.+?c'i	ABCABC	y	$&	ABC
 'a.*?c'i	ABCABC	y	$&	ABC
 'a.{0,5}?c'i	ABCABC	y	$&	ABC
@@ -244,7 +244,7 @@ a[-]?c	ac	y	$&	ac
 '(a+|b)?'i	AB	y	$&-$1	A-A
 '(a+|b){0,1}'i	AB	y	$&-$1	A-A
 '(a+|b){0,1}?'i	AB	y	$&-$1	-
-')('i	-	c	-	-
+')('i	-	c	-	/)(/: unmatched () in regexp
 '[^ab]*'i	CDE	y	$&	CDE
 'abc'i		n	-	-
 'a*'i		y	$&	
@@ -304,3 +304,5 @@ a(?:b|(c|e){1,2}?|d)+?(.)	ace	y	$1$2	ce
 '([a-z]+)\s\1'i	Aa aa 	y	$&-$1	Aa aa-Aa
 '([a-z]+)\s\1'i	Ab ab 	y	$&-$1	Ab ab-Ab
 foo\w*\d{4}baz	foobar1234baz	y	$&	foobar1234baz
+((foo)|(bar))*	foobar	y	$1-$2-$3	bar-foo-bar
+:(?:	-	c	-	Sequence (? incomplete
diff --git a/t/op/ref.t b/t/op/ref.t
index 4e024d8828..e83a04fbee 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..47\n";
+print "1..50\n";
 
 # Test glob operations.
 
@@ -207,12 +207,28 @@ print @baa == 3 ? "ok 42\n" : "not ok 42\n";
 print grep(ref($_), @baa) == 3 ? "ok 43\n" : "not ok 43\n";
 print @bzz == 3 ? "ok 44\n" : "not ok 44\n";
 
+# test for proper destruction of lexical objects
+
+sub larry::DESTROY { print "# larry\nok 45\n"; }
+sub curly::DESTROY { print "# curly\nok 46\n"; }
+sub moe::DESTROY   { print "# moe\nok 47\n"; }
+
+{
+    my ($joe, @curly, %larry);
+    my $moe = bless \$joe, 'moe';
+    my $curly = bless \@curly, 'curly';
+    my $larry = bless \%larry, 'larry';
+    print "# leaving block\n";
+}
+
+print "# left block\n";
+
 package FINALE;
 
 {
-    $ref3 = bless ["ok 47\n"];		# package destruction
-    my $ref2 = bless ["ok 46\n"];	# lexical destruction
-    local $ref1 = bless ["ok 45\n"];	# dynamic destruction
+    $ref3 = bless ["ok 50\n"];		# package destruction
+    my $ref2 = bless ["ok 49\n"];	# lexical destruction
+    local $ref1 = bless ["ok 48\n"];	# dynamic destruction
     1;					# flush any temp values on stack
 }
 
diff --git a/t/op/regexp.t b/t/op/regexp.t
index ea470f879b..803f1d0dab 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -14,7 +14,7 @@
 # 	n	expect no match
 # 	c	expect an error
 #
-# Columns 4 and 5 are used only of column 3 contains C<y>.
+# Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
 #
 # Column 4 contains a string, usually C<$&>.
 #
@@ -35,11 +35,11 @@ TEST:
 while (<TESTS>) {
     ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
     $input = join(':',$pat,$subject,$result,$repl,$expect);
-    $pat = "'$pat'" unless $pat =~ /^'/;
+    $pat = "'$pat'" unless $pat =~ /^[:']/;
     for $study ("", "study \$subject") {
 	eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";";
 	if ($result eq 'c') {
-	    if ($@ eq '') { print "not ok $.\n"; next TEST }
+	    if ($@ !~ m!^\Q$expect!) { print "not ok $.\n"; next TEST }
 	    last;  # no need to study a syntax error
 	}
 	elsif ($result eq 'n') {
diff --git a/t/op/stat.t b/t/op/stat.t
index aea5cc147c..97f8192885 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -75,8 +75,8 @@ if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
 eval '$> = $olduid;';		# switch uid back (may not be implemented)
 print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
 
-if ($Is_MSWin32 or ! -x 'Op.stat.tmp') {print "ok 11\n";}
-else                                   {print "not ok 11\n";}
+if (! -x 'Op.stat.tmp') {print "ok 11\n";}
+else                    {print "not ok 11\n";}
 
 foreach ((12,13,14,15,16,17)) {
     print "ok $_\n";		#deleted tests
diff --git a/t/op/substr.t b/t/op/substr.t
index e34216fb17..bb655f5209 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -2,25 +2,40 @@
 
 # $RCSfile: substr.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:31 $
 
-print "1..25\n";
+print "1..97\n";
+
+#P = start of string  Q = start of substr  R = end of substr  S = end of string
 
 $a = 'abcdefxyz';
+BEGIN { $^W = 1 };
+
+$SIG{__WARN__} = sub {
+     if ($_[0] =~ /^substr outside of string/) {
+          $w++;
+     } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
+          $w += 2;
+     } else {
+          warn @_;
+     }
+};
 
-print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");
-print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");
-print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n");
-print (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n");
-print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n");
-print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");
+sub fail { !defined(shift) && $w-- };
+
+print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");   # P=Q R S
+print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");   # P Q R S
+print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); # P Q S R
+print (fail(substr($a,999,999)) ? "ok 4\n" : "not ok 4\n");  # P R Q S
+print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n");  # P=Q R S
+print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");    # P Q R S
 
 $[ = 1;
 
-print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");
-print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");
-print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n");
-print (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n");
-print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");
-print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");
+print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");   # P=Q R S
+print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");   # P Q R S
+print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); # P Q S R
+print (fail(substr($a,999,999)) ? "ok 10\n" : "not ok 10\n");# P R Q S
+print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");# P=Q R S
+print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");  # P Q R S
 
 $[ = 0;
 
@@ -28,7 +43,6 @@ substr($a,3,3) = 'XYZ';
 print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
 substr($a,0,2) = '';
 print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
-y/a/a/;
 substr($a,0,0) = 'ab';
 print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
 substr($a,0,0) = '12345678';
@@ -42,9 +56,103 @@ print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
 
 $a = 'abcdefxyz';
 
-print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");
-print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");
-print (substr($a,999) eq '' ? "ok 22\n" : "not ok 22\n");
+print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");   # P Q R=S
+print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");  # P Q R=S
+print (fail(substr($a,999)) ? "ok 22\n" : "not ok 22\n");    # P R=S Q
+print (substr($a,0) eq 'abcdefxyz' ? "ok 23\n" : "not ok 23\n");# P=Q R=S
+print (substr($a,9) eq '' ? "ok 24\n" : "not ok 24\n");      # P Q=R=S
+print (substr($a,-11) eq 'abcdefxyz' ? "ok 25\n" : "not ok 25\n");# Q P R=S
+print (substr($a,-9) eq 'abcdefxyz' ? "ok 26\n" : "not ok 26\n");  # P=Q R=S
+
+$a = '54321';
+
+print (fail(substr($a,-7, 1)) ? "ok 27\n" : "not ok 27\n");  # Q R P S
+print (fail(substr($a,-7,-6)) ? "ok 28\n" : "not ok 28\n");  # Q R P S
+print (substr($a,-5,-7) eq '' ? "ok 29\n" : "not ok 29\n");  # R P=Q S
+print (substr($a, 2,-7) eq '' ? "ok 30\n" : "not ok 30\n");  # R P Q S
+print (substr($a,-3,-7) eq '' ? "ok 31\n" : "not ok 31\n");  # R P Q S
+print (substr($a, 2,-5) eq '' ? "ok 32\n" : "not ok 32\n");  # P=R Q S
+print (substr($a,-3,-5) eq '' ? "ok 33\n" : "not ok 33\n");  # P=R Q S
+print (substr($a, 2,-4) eq '' ? "ok 34\n" : "not ok 34\n");  # P R Q S
+print (substr($a,-3,-4) eq '' ? "ok 35\n" : "not ok 35\n");  # P R Q S
+print (substr($a, 5,-6) eq '' ? "ok 36\n" : "not ok 36\n");  # R P Q=S
+print (substr($a, 5,-5) eq '' ? "ok 37\n" : "not ok 37\n");  # P=R Q S
+print (substr($a, 5,-3) eq '' ? "ok 38\n" : "not ok 38\n");  # P R Q=S
+print (fail(substr($a, 7,-7)) ? "ok 39\n" : "not ok 39\n");  # R P S Q
+print (fail(substr($a, 7,-5)) ? "ok 40\n" : "not ok 40\n");  # P=R S Q
+print (fail(substr($a, 7,-3)) ? "ok 41\n" : "not ok 41\n");  # P R S Q
+print (fail(substr($a, 7, 0)) ? "ok 42\n" : "not ok 42\n");  # P S Q=R
+
+print (substr($a,-7,2) eq '' ? "ok 43\n" : "not ok 43\n");   # Q P=R S
+print (substr($a,-7,4) eq '54' ? "ok 44\n" : "not ok 44\n"); # Q P R S
+print (substr($a,-7,7) eq '54321' ? "ok 45\n" : "not ok 45\n");# Q P R=S
+print (substr($a,-7,9) eq '54321' ? "ok 46\n" : "not ok 46\n");# Q P S R
+print (substr($a,-5,0) eq '' ? "ok 47\n" : "not ok 47\n");   # P=Q=R S
+print (substr($a,-5,3) eq '543' ? "ok 48\n" : "not ok 48\n");# P=Q R S
+print (substr($a,-5,5) eq '54321' ? "ok 49\n" : "not ok 49\n");# P=Q R=S
+print (substr($a,-5,7) eq '54321' ? "ok 50\n" : "not ok 50\n");# P=Q S R
+print (substr($a,-3,0) eq '' ? "ok 51\n" : "not ok 51\n");   # P Q=R S
+print (substr($a,-3,3) eq '321' ? "ok 52\n" : "not ok 52\n");# P Q R=S
+print (substr($a,-2,3) eq '21' ? "ok 53\n" : "not ok 53\n"); # P Q S R
+print (substr($a,0,-5) eq '' ? "ok 54\n" : "not ok 54\n");   # P=Q=R S
+print (substr($a,2,-3) eq '' ? "ok 55\n" : "not ok 55\n");   # P Q=R S
+print (substr($a,0,0) eq '' ? "ok 56\n" : "not ok 56\n");    # P=Q=R S
+print (substr($a,0,5) eq '54321' ? "ok 57\n" : "not ok 57\n");# P=Q R=S
+print (substr($a,0,7) eq '54321' ? "ok 58\n" : "not ok 58\n");# P=Q S R
+print (substr($a,2,0) eq '' ? "ok 59\n" : "not ok 59\n");    # P Q=R S
+print (substr($a,2,3) eq '321' ? "ok 60\n" : "not ok 60\n"); # P Q R=S
+print (substr($a,5,0) eq '' ? "ok 61\n" : "not ok 61\n");    # P Q=R=S
+print (substr($a,5,2) eq '' ? "ok 62\n" : "not ok 62\n");    # P Q=S R
+print (substr($a,-7,-5) eq '' ? "ok 63\n" : "not ok 63\n");  # Q P=R S
+print (substr($a,-7,-2) eq '543' ? "ok 64\n" : "not ok 64\n");# Q P R S
+print (substr($a,-5,-5) eq '' ? "ok 65\n" : "not ok 65\n");  # P=Q=R S
+print (substr($a,-5,-2) eq '543' ? "ok 66\n" : "not ok 66\n");# P=Q R S
+print (substr($a,-3,-3) eq '' ? "ok 67\n" : "not ok 67\n");  # P Q=R S
+print (substr($a,-3,-1) eq '32' ? "ok 68\n" : "not ok 68\n");# P Q R S
+
+$a = '';
+
+print (substr($a,-2,2) eq '' ? "ok 69\n" : "not ok 69\n");   # Q P=R=S
+print (substr($a,0,0) eq '' ? "ok 70\n" : "not ok 70\n");    # P=Q=R=S
+print (substr($a,0,1) eq '' ? "ok 71\n" : "not ok 71\n");    # P=Q=S R
+print (substr($a,-2,3) eq '' ? "ok 72\n" : "not ok 72\n");   # Q P=S R
+print (substr($a,-2) eq '' ? "ok 73\n" : "not ok 73\n");     # Q P=R=S
+print (substr($a,0) eq '' ? "ok 74\n" : "not ok 74\n");      # P=Q=R=S
+
+
+print (substr($a,0,-1) eq '' ? "ok 75\n" : "not ok 75\n");   # R P=Q=S
+print (fail(substr($a,-2,0)) ? "ok 76\n" : "not ok 76\n");   # Q=R P=S
+print (fail(substr($a,-2,1)) ? "ok 77\n" : "not ok 77\n");   # Q R P=S
+print (fail(substr($a,-2,-1)) ? "ok 78\n" : "not ok 78\n");  # Q R P=S
+print (fail(substr($a,-2,-2)) ? "ok 79\n" : "not ok 79\n");  # Q=R P=S
+print (fail(substr($a,1,-2)) ? "ok 80\n" : "not ok 81\n");   # R P=S Q
+print (fail(substr($a,1,1)) ? "ok 81\n" : "not ok 81\n");    # P=S Q R
+print (fail(substr($a,1,0)) ? "ok 82\n" : "not ok 82\n");    # P=S Q=R
+print (fail(substr($a,1)) ? "ok 83\n" : "not ok 83\n");      # P=R=S Q
+
+
+my $a = 'zxcvbnm';
+substr($a,2,0) = '';
+print $a eq 'zxcvbnm' ? "ok 84\n" : "not ok 84\n";
+substr($a,7,0) = '';
+print $a eq 'zxcvbnm' ? "ok 85\n" : "not ok 85\n";
+substr($a,5,0) = '';
+print $a eq 'zxcvbnm' ? "ok 86\n" : "not ok 86\n";
+substr($a,0,2) = 'pq';
+print $a eq 'pqcvbnm' ? "ok 87\n" : "not ok 87\n";
+substr($a,2,0) = 'r';
+print $a eq 'pqrcvbnm' ? "ok 88\n" : "not ok 88\n";
+substr($a,8,0) = 'asd';
+print $a eq 'pqrcvbnmasd' ? "ok 89\n" : "not ok 89\n";
+substr($a,0,2) = 'iop';
+print $a eq 'ioprcvbnmasd' ? "ok 90\n" : "not ok 90\n";
+substr($a,0,5) = 'fgh';
+print $a eq 'fghvbnmasd' ? "ok 91\n" : "not ok 91\n";
+substr($a,3,5) = 'jkl';
+print $a eq 'fghjklsd' ? "ok 92\n" : "not ok 92\n";
+substr($a,3,2) = '1234';
+print $a eq 'fgh1234lsd' ? "ok 93\n" : "not ok 93\n";
+
 
 # with lexicals (and in re-entered scopes)
 for (0,1) {
@@ -52,17 +160,21 @@ for (0,1) {
   unless ($_) {
     $txt = "Foo";
     substr($txt, -1) = "X";
-    print $txt eq "FoX" ? "ok 23\n" : "not ok 23\n";
+    print $txt eq "FoX" ? "ok 94\n" : "not ok 94\n";
   }
   else {
+    local $^W = 0;    # because of (spurious?) "uninitialised value"
     substr($txt, 0, 1) = "X";
-    print $txt eq "X" ? "ok 24\n" : "not ok 24\n";
+    print $txt eq "X" ? "ok 95\n" : "not ok 95\n";
   }
 }
 
-# coersion of references
+# coercion of references
 {
   my $s = [];
   substr($s, 0, 1) = 'Foo';
-  print substr($s,0,7) eq "FooRRAY" ? "ok 25\n" : "not ok 25\n";
+  print substr($s,0,7) eq "FooRRAY" && !($w-=2) ? "ok 96\n" : "not ok 96\n";
 }
+
+# check no spurious warnings
+print $w ? "not ok 97\n" : "ok 97\n";
diff --git a/t/op/universal.t b/t/op/universal.t
index 03f0fbdd9d..bd6c73afe9 100755
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -3,7 +3,12 @@
 # check UNIVERSAL
 #
 
-print "1..11\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+print "1..72\n";
 
 $a = {};
 bless $a, "Bob";
@@ -21,35 +26,71 @@ package Alice;
 sub drink {}
 sub new { bless {} }
 
+$Alice::VERSION = 2.718;
+
 package main;
+
+my $i = 2;
+sub test { print "not " unless shift; print "ok $i\n"; $i++; }
+
 $a = new Alice;
 
-print "not " unless $a->isa("Alice");
-print "ok 2\n";
+test $a->isa("Alice");
 
-print "not " unless $a->isa("Bob");
-print "ok 3\n";
+test $a->isa("Bob");
+
+test $a->isa("Female");
+
+test $a->isa("Human");
+
+test ! $a->isa("Male");
+
+test $a->can("drink");
+
+test $a->can("eat");
+
+test ! $a->can("sleep");
+
+my $b = 'abc';
+my @refs = qw(SCALAR SCALAR     LVALUE      GLOB ARRAY HASH CODE);
+my @vals = (  \$b,   \3.14, \substr($b,1,1), \*b,  [],  {}, sub {} );
+for ($p=0; $p < @refs; $p++) {
+    for ($q=0; $q < @vals; $q++) {
+        test UNIVERSAL::isa($vals[$p], $refs[$q]) eq ($p==$q or $p+$q==1);
+    };
+};
+
+test ! UNIVERSAL::can(23, "can");
+
+test $a->can("VERSION");
+
+test $a->can("can");
+test ! $a->can("export_tags");	# a method in Exporter
+
+test (eval { $a->VERSION }) == 2.718;
+
+test ! (eval { $a->VERSION(2.719) }) &&
+         $@ =~ /^Alice version 2.719 required--this is only version 2.718 at /;
+
+test (eval { $a->VERSION(2.718) }) && ! $@;
 
-print "not " unless $a->isa("Female");
-print "ok 4\n";
+my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
+test $subs eq "VERSION can isa";
 
-print "not " unless $a->isa("Human");
-print "ok 5\n";
+test $a->isa("UNIVERSAL");
 
-print "not " if $a->isa("Male");
-print "ok 6\n";
+# now use UNIVERSAL.pm and see what changes
+eval "use UNIVERSAL";
 
-print "not " unless $a->can("drink");
-print "ok 7\n";
+test $a->isa("UNIVERSAL");
 
-print "not " unless $a->can("eat");
-print "ok 8\n";
+my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
+# XXX import being here is really a bug
+test $sub2 eq "VERSION can import isa";
 
-print "not " if $a->can("sleep");
-print "ok 9\n";
+eval 'sub UNIVERSAL::sleep {}';
+test $a->can("sleep");
 
-print "not " unless UNIVERSAL::isa([], "ARRAY");
-print "ok 10\n";
+test ! UNIVERSAL::can($b, "can");
 
-print "not " unless UNIVERSAL::isa({}, "HASH");
-print "ok 11\n";
+test ! $a->can("export_tags");	# a method in Exporter
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index d4b73b8f91..e1ec5a800f 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -395,10 +395,14 @@ for (map { chr } 0..255) {
 print "ok 101\n";
 
 # 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";
 {
-    my ($from, $to, $lesser, $greater, @test, %test, $test);
+    my ($from, $to, $lesser, $greater, @test, %test, $test, $yes, $no, $sign);
 
     for (0..9) {
 	# Select a slice.
@@ -410,24 +414,25 @@ print "# testing 102\n";
 	$from++; $to++;
         $to = $#Locale if ($to > $#Locale);
 	$greater = join('', @Locale[$from..$to]);
+	($yes, $no, $sign) = ($lesser lt $greater
+				? ("    ", "not ", 1)
+				: ("not ", "    ", -1));
+	# all these tests should FAIL (return 0).
 	@test = 
 	    (
-	     'not ($lesser  lt $greater)', # 0
-	     'not ($lesser  le $greater)', # 1
-	     'not ($lesser  ne $greater)', # 2
-	     '    ($lesser  eq $greater)', # 3
-	     '    ($lesser  ge $greater)', # 4
-	     '    ($lesser  gt $greater)', # 5
-	     '    ($greater lt $lesser )', # 6
-	     '    ($greater le $lesser )', # 7
-	     'not ($greater ne $lesser )', # 8
-	     '    ($greater eq $lesser )', # 9
-	     'not ($greater ge $lesser )', # 10
-	     'not ($greater gt $lesser )', # 11
-	     # Well, these two are sort of redundant
-	     # because @Locale was derived using cmp.
-	     'not (($lesser  cmp $greater) == -1)', # 12
-	     'not (($greater cmp $lesser ) ==  1)'  # 13
+	     $no.'    ($lesser  lt $greater)',  # 0
+	     $no.'    ($lesser  le $greater)',  # 1
+	     $no.'    ($lesser  ne $greater)',  # 2
+	     $yes.'    ($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
+	     $no.'     ($greater ge $lesser )', # 10
+	     $no.'     ($greater gt $lesser )', # 11
+	     'not (($lesser cmp $greater) == -$sign)' # 12
 	     );
 	@test{@test} = 0 x @test;
 	$test = 0;
@@ -436,6 +441,8 @@ print "# testing 102\n";
 	    print "# failed 102 at:\n";
 	    print "# lesser  = '$lesser'\n";
 	    print "# greater = '$greater'\n";
+	    print "# lesser cmp greater = ", $lesser cmp $greater, "\n";
+	    print "# greater cmp lesser = ", $greater cmp $lesser, "\n";
 	    print "# (greater) from = $from, to = $to\n";
 	    for my $ti (@test) {
 		printf("# %-40s %-4s", $ti,
@@ -452,3 +459,5 @@ print "# testing 102\n";
     }
 }
 print "ok 102\n";
+
+# eof