8 files changed, 324 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/t/comp/cmdopt.t b/gnu/usr.bin/perl/t/comp/cmdopt.t
new file mode 100644
index 00000000000..4d5c78a4cb5
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/cmdopt.t
@@ -0,0 +1,83 @@
+#!./perl
+
+# $RCSfile: cmdopt.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:17 $
+
+print "1..40\n";
+
+# test the optimization of constants
+
+if (1) { print "ok 1\n";} else { print "not ok 1\n";}
+unless (0) { print "ok 2\n";} else { print "not ok 2\n";}
+
+if (0) { print "not ok 3\n";} else { print "ok 3\n";}
+unless (1) { print "not ok 4\n";} else { print "ok 4\n";}
+
+unless (!1) { print "ok 5\n";} else { print "not ok 5\n";}
+if (!0) { print "ok 6\n";} else { print "not ok 6\n";}
+
+unless (!0) { print "not ok 7\n";} else { print "ok 7\n";}
+if (!1) { print "not ok 8\n";} else { print "ok 8\n";}
+
+$x = 1;
+if (1 && $x) { print "ok 9\n";} else { print "not ok 9\n";}
+if (0 && $x) { print "not ok 10\n";} else { print "ok 10\n";}
+$x = '';
+if (1 && $x) { print "not ok 11\n";} else { print "ok 11\n";}
+if (0 && $x) { print "not ok 12\n";} else { print "ok 12\n";}
+
+$x = 1;
+if (1 || $x) { print "ok 13\n";} else { print "not ok 13\n";}
+if (0 || $x) { print "ok 14\n";} else { print "not ok 14\n";}
+$x = '';
+if (1 || $x) { print "ok 15\n";} else { print "not ok 15\n";}
+if (0 || $x) { print "not ok 16\n";} else { print "ok 16\n";}
+
+
+# test the optimization of variables
+
+$x = 1;
+if ($x) { print "ok 17\n";} else { print "not ok 17\n";}
+unless ($x) { print "not ok 18\n";} else { print "ok 18\n";}
+
+$x = '';
+if ($x) { print "not ok 19\n";} else { print "ok 19\n";}
+unless ($x) { print "ok 20\n";} else { print "not ok 20\n";}
+
+# test optimization of string operations
+
+$a = 'a';
+if ($a eq 'a') { print "ok 21\n";} else { print "not ok 21\n";}
+if ($a ne 'a') { print "not ok 22\n";} else { print "ok 22\n";}
+
+if ($a =~ /a/) { print "ok 23\n";} else { print "not ok 23\n";}
+if ($a !~ /a/) { print "not ok 24\n";} else { print "ok 24\n";}
+# test interaction of logicals and other operations
+
+$a = 'a';
+$x = 1;
+if ($a eq 'a' and $x) { print "ok 25\n";} else { print "not ok 25\n";}
+if ($a ne 'a' and $x) { print "not ok 26\n";} else { print "ok 26\n";}
+$x = '';
+if ($a eq 'a' and $x) { print "not ok 27\n";} else { print "ok 27\n";}
+if ($a ne 'a' and $x) { print "not ok 28\n";} else { print "ok 28\n";}
+
+$x = 1;
+if ($a eq 'a' or $x) { print "ok 29\n";} else { print "not ok 29\n";}
+if ($a ne 'a' or $x) { print "ok 30\n";} else { print "not ok 30\n";}
+$x = '';
+if ($a eq 'a' or $x) { print "ok 31\n";} else { print "not ok 31\n";}
+if ($a ne 'a' or $x) { print "not ok 32\n";} else { print "ok 32\n";}
+
+$x = 1;
+if ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";}
+if ($a !~ /a/ && $x) { print "not ok 34\n";} else { print "ok 34\n";}
+$x = '';
+if ($a =~ /a/ && $x) { print "not ok 35\n";} else { print "ok 35\n";}
+if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
+
+$x = 1;
+if ($a =~ /a/ || $x) { print "ok 37\n";} else { print "not ok 37\n";}
+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";}
diff --git a/gnu/usr.bin/perl/t/comp/cpp.aux b/gnu/usr.bin/perl/t/comp/cpp.aux
new file mode 100644
index 00000000000..fcec0c7abf1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/cpp.aux
@@ -0,0 +1,39 @@
+#!./perl -P
+
+# $RCSfile: cpp.aux,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:11 $
+
+print "1..3\n";
+
+#this is a comment
+#define MESS "ok 1\n"
+print MESS;
+
+#If you capitalize, it's a comment.
+#ifdef MESS
+	print "ok 2\n";
+#else
+	print "not ok 2\n";
+#endif
+
+open(TRY,">Comp.cpp.tmp") || die "Can't open temp perl file.";
+
+($prog = <<'END') =~ s/X//g;
+X$ok = "not ok 3\n";
+X#include "Comp.cpp.inc"
+X#ifdef OK
+X$ok = OK;
+X#endif
+Xprint $ok;
+END
+print TRY $prog;
+close TRY;
+
+open(TRY,">Comp.cpp.inc") || (die "Can't open temp include file.");
+print TRY '#define OK "ok 3\n"' . "\n";
+close TRY;
+
+$pwd=`pwd`;
+$pwd =~ s/\n//;
+$x = `./perl -P Comp.cpp.tmp`;
+print $x;
+unlink "Comp.cpp.tmp", "Comp.cpp.inc";
diff --git a/gnu/usr.bin/perl/t/comp/cpp.t b/gnu/usr.bin/perl/t/comp/cpp.t
new file mode 100644
index 00000000000..e62d7b82eec
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/cpp.t
@@ -0,0 +1,17 @@
+#!./perl
+
+# $RCSfile: cpp.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:11 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+if ( ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
+     ( ! -x $Config{'scriptdir'} . "/cppstdin") ) {
+    print "1..0\n";
+    exit; 		# Cannot test till after install, alas.
+}
+
+system "./perl -P comp/cpp.aux"
diff --git a/gnu/usr.bin/perl/t/comp/decl.t b/gnu/usr.bin/perl/t/comp/decl.t
new file mode 100644
index 00000000000..32b8509df77
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/decl.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $RCSfile: decl.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:19 $
+
+# check to see if subroutine declarations work everwhere
+
+sub one {
+    print "ok 1\n";
+}
+format one =
+ok 5
+.
+
+print "1..7\n";
+
+do one();
+do two();
+
+sub two {
+    print "ok 2\n";
+}
+format two =
+@<<<
+$foo
+.
+
+if ($x eq $x) {
+    sub three {
+	print "ok 3\n";
+    }
+    do three();
+}
+
+do four();
+$~ = 'one';
+write;
+$~ = 'two';
+$foo = "ok 6";
+write;
+$~ = 'three';
+write;
+
+format three =
+ok 7
+.
+
+sub four {
+    print "ok 4\n";
+}
diff --git a/gnu/usr.bin/perl/t/comp/multiline.t b/gnu/usr.bin/perl/t/comp/multiline.t
new file mode 100644
index 00000000000..634b06a7a84
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/multiline.t
@@ -0,0 +1,40 @@
+#!./perl
+
+# $RCSfile: multiline.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:20 $
+
+print "1..5\n";
+
+open(try,'>Comp.try') || (die "Can't open temp file.");
+
+$x = 'now is the time
+for all good men
+to come to.
+';
+
+$y = 'now is the time' . "\n" .
+'for all good men' . "\n" .
+'to come to.' . "\n";
+
+if ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";}
+
+print try $x;
+close try;
+
+open(try,'Comp.try') || (die "Can't reopen temp file.");
+$count = 0;
+$z = '';
+while (<try>) {
+    $z .= $_;
+    $count = $count + 1;
+}
+
+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`;
+
+if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
+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
new file mode 100644
index 00000000000..ca800bb3647
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/package.t
@@ -0,0 +1,35 @@
+#!./perl
+
+print "1..7\n";
+
+$blurfl = 123;
+$foo = 3;
+
+package XYZ;
+
+$bar = 4;
+
+{
+    package ABC;
+    $blurfl = 5;
+    $main'a = $'b;
+}
+
+$ABC'dyick = 6;
+
+$xyz = 2;
+
+$main = join(':', sort(keys %main::));
+$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 $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
+print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
+
+package ABC;
+
+print $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
+eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
+eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
+print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
diff --git a/gnu/usr.bin/perl/t/comp/script.t b/gnu/usr.bin/perl/t/comp/script.t
new file mode 100644
index 00000000000..a36564a04b2
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/script.t
@@ -0,0 +1,26 @@
+#!./perl
+
+# $RCSfile: script.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:12 $
+
+print "1..3\n";
+
+$x = `./perl -e 'print "ok\n";'`;
+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";}
+
+open(try,">Comp.script") || (die "Can't open temp file.");
+print try 'print "ok\n";'; print try "\n";
+close try;
+
+$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`;
+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";}
+
+unlink 'Comp.script' || `/bin/rm -f Comp.script`;
diff --git a/gnu/usr.bin/perl/t/comp/term.t b/gnu/usr.bin/perl/t/comp/term.t
new file mode 100644
index 00000000000..b248e9b1613
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/term.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:24 $
+
+# tests that aren't important enough for base.term
+
+print "1..14\n";
+
+$x = "\\n";
+print "#1\t:$x: eq " . ':\n:' . "\n";
+if ($x eq '\n') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$x = "#2\t:$x: eq :\\n:\n";
+print $x;
+unless (index($x,'\\\\')>0) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (length('\\\\') == 2) {print "ok 3\n";} else {print "not ok 3\n";}
+
+$one = 'a';
+
+if (length("\\n") == 2) {print "ok 4\n";} else {print "not ok 4\n";}
+if (length("\\\n") == 2) {print "ok 5\n";} else {print "not ok 5\n";}
+if (length("$one\\n") == 3) {print "ok 6\n";} else {print "not ok 6\n";}
+if (length("$one\\\n") == 3) {print "ok 7\n";} else {print "not ok 7\n";}
+if (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";}
+if (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";}
+if (length("\\${one}") == 2) {print "ok 10\n";} else {print "not ok 10\n";}
+
+if ("${one}b" eq "ab") { print "ok 11\n";} else {print "not ok 11\n";}
+
+@foo = (1,2,3);
+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";}