perl 5.004_04

7 files changed, 60 insertions, 14 deletions

diff --git a/gnu/usr.bin/perl/t/comp/cmdopt.t b/gnu/usr.bin/perl/t/comp/cmdopt.t
index 4d5c78a4cb5..3f701a456ac 100644
--- a/gnu/usr.bin/perl/t/comp/cmdopt.t
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/t/comp/cpp.aux b/gnu/usr.bin/perl/t/comp/cpp.aux
index fcec0c7abf1..377c74c6c61 100644
--- a/gnu/usr.bin/perl/t/comp/cpp.aux
+++ b/gnu/usr.bin/perl/t/comp/cpp.aux
@@ -1,6 +1,6 @@
 #!./perl -P
 
-# $RCSfile: cpp.aux,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:11 $
+# $RCSfile: cpp.aux,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:02 $
 
 print "1..3\n";
 
diff --git a/gnu/usr.bin/perl/t/comp/cpp.t b/gnu/usr.bin/perl/t/comp/cpp.t
index e62d7b82eec..b9693d060c8 100644
--- a/gnu/usr.bin/perl/t/comp/cpp.t
+++ b/gnu/usr.bin/perl/t/comp/cpp.t
@@ -1,6 +1,6 @@
 #!./perl
 
-# $RCSfile: cpp.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:11 $
+# $RCSfile: cpp.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:03 $
 
 BEGIN {
     chdir 't' if -d '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/gnu/usr.bin/perl/t/comp/multiline.t b/gnu/usr.bin/perl/t/comp/multiline.t
index 634b06a7a84..fc1eedc8d25 100644
--- a/gnu/usr.bin/perl/t/comp/multiline.t
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/t/comp/package.t b/gnu/usr.bin/perl/t/comp/package.t
index ca800bb3647..cef02c5cb4f 100644
--- a/gnu/usr.bin/perl/t/comp/package.t
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/t/comp/script.t b/gnu/usr.bin/perl/t/comp/script.t
index a36564a04b2..3731ca078ea 100644
--- a/gnu/usr.bin/perl/t/comp/script.t
+++ b/gnu/usr.bin/perl/t/comp/script.t
@@ -1,10 +1,11 @@
 #!./perl
 
-# $RCSfile: script.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:12 $
+# $RCSfile: script.t,v $$Revision: 1.2 $$Date: 1997/11/30 08:00:08 $
 
 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/gnu/usr.bin/perl/t/comp/term.t b/gnu/usr.bin/perl/t/comp/term.t
index b248e9b1613..eb9968003e7 100644
--- a/gnu/usr.bin/perl/t/comp/term.t
+++ b/gnu/usr.bin/perl/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";}