summaryrefslogtreecommitdiff
path: root/t/cmd
diff options
context:
space:
mode:
Diffstat (limited to 't/cmd')
-rw-r--r--t/cmd/elsif.t25
-rw-r--r--t/cmd/for.t49
-rw-r--r--t/cmd/mod.t33
-rw-r--r--t/cmd/subval.t179
-rw-r--r--t/cmd/switch.t75
-rw-r--r--t/cmd/while.t110
6 files changed, 471 insertions, 0 deletions
diff --git a/t/cmd/elsif.t b/t/cmd/elsif.t
new file mode 100644
index 0000000000..975acef4f7
--- /dev/null
+++ b/t/cmd/elsif.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# $Header: elsif.t,v 4.0 91/03/20 01:49:21 lwall Locked $
+
+sub foo {
+ if ($_[0] == 1) {
+ 1;
+ }
+ elsif ($_[0] == 2) {
+ 2;
+ }
+ elsif ($_[0] == 3) {
+ 3;
+ }
+ else {
+ 4;
+ }
+}
+
+print "1..4\n";
+
+if (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
+if (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";}
+if (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";}
+if (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";}
diff --git a/t/cmd/for.t b/t/cmd/for.t
new file mode 100644
index 0000000000..16745b5b28
--- /dev/null
+++ b/t/cmd/for.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $Header: for.t,v 4.0 91/03/20 01:49:26 lwall Locked $
+
+print "1..7\n";
+
+for ($i = 0; $i <= 10; $i++) {
+ $x[$i] = $i;
+}
+$y = $x[10];
+print "#1 :$y: eq :10:\n";
+$y = join(' ', @x);
+print "#1 :$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n";
+if (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') {
+ print "ok 1\n";
+} else {
+ print "not ok 1\n";
+}
+
+$i = $c = 0;
+for (;;) {
+ $c++;
+ last if $i++ > 10;
+}
+if ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$foo = 3210;
+@ary = (1,2,3,4,5);
+foreach $foo (@ary) {
+ $foo *= 2;
+}
+if (join('',@ary) eq '246810') {print "ok 3\n";} else {print "not ok 3\n";}
+
+for (@ary) {
+ s/(.*)/ok $1\n/;
+}
+
+print $ary[1];
+
+# test for internal scratch array generation
+# this also tests that $foo was restored to 3210 after test 3
+for (split(' ','a b c d e')) {
+ $foo .= $_;
+}
+if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5 $foo\n";}
+
+foreach $foo (("ok 6\n","ok 7\n")) {
+ print $foo;
+}
diff --git a/t/cmd/mod.t b/t/cmd/mod.t
new file mode 100644
index 0000000000..787aade307
--- /dev/null
+++ b/t/cmd/mod.t
@@ -0,0 +1,33 @@
+#!./perl
+
+# $Header: mod.t,v 4.0 91/03/20 01:49:33 lwall Locked $
+
+print "1..7\n";
+
+print "ok 1\n" if 1;
+print "not ok 1\n" unless 1;
+
+print "ok 2\n" unless 0;
+print "not ok 2\n" if 0;
+
+1 && (print "not ok 3\n") if 0;
+1 && (print "ok 3\n") if 1;
+0 || (print "not ok 4\n") if 0;
+0 || (print "ok 4\n") if 1;
+
+$x = 0;
+do {$x[$x] = $x;} while ($x++) < 10;
+if (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
+ print "ok 5\n";
+} else {
+ print "not ok 5\n";
+}
+
+$x = 15;
+$x = 10 while $x < 10;
+if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
+
+open(foo,'TEST') || open(foo,'t/TEST');
+$x = 0;
+$x++ while <foo>;
+print $x > 50 && $x < 1000 ? "ok 7\n" : "not ok 7\n";
diff --git a/t/cmd/subval.t b/t/cmd/subval.t
new file mode 100644
index 0000000000..ba4d833d3a
--- /dev/null
+++ b/t/cmd/subval.t
@@ -0,0 +1,179 @@
+#!./perl
+
+# $Header: subval.t,v 4.0 91/03/20 01:49:40 lwall Locked $
+
+sub foo1 {
+ 'true1';
+ if ($_[0]) { 'true2'; }
+}
+
+sub foo2 {
+ 'true1';
+ if ($_[0]) { return 'true2'; } else { return 'true3'; }
+ 'true0';
+}
+
+sub foo3 {
+ 'true1';
+ unless ($_[0]) { 'true2'; }
+}
+
+sub foo4 {
+ 'true1';
+ unless ($_[0]) { 'true2'; } else { 'true3'; }
+}
+
+sub foo5 {
+ 'true1';
+ 'true2' if $_[0];
+}
+
+sub foo6 {
+ 'true1';
+ 'true2' unless $_[0];
+}
+
+print "1..34\n";
+
+if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
+if (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
+if (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
+
+if (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
+if (do foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
+if (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
+if (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if (do foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
+if (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
+if (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
+if (do foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
+
+# Now test to see that recursion works using a Fibonacci number generator
+
+sub fib {
+ local($arg) = @_;
+ local($foo);
+ $level++;
+ if ($arg <= 2) {
+ $foo = 1;
+ }
+ else {
+ $foo = do fib($arg-1) + do fib($arg-2);
+ }
+ $level--;
+ $foo;
+}
+
+@good = (0,1,1,2,3,5,8,13,21,34,55,89);
+
+for ($i = 1; $i <= 10; $i++) {
+ $foo = $i + 12;
+ if (do fib($i) == $good[$i]) {
+ print "ok $foo\n";
+ }
+ else {
+ print "not ok $foo\n";
+ }
+}
+
+sub ary1 {
+ (1,2,3);
+}
+
+print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n";
+
+print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n";
+
+sub ary2 {
+ do {
+ return (1,2,3);
+ (3,2,1);
+ };
+ 0;
+}
+
+print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n";
+
+$x = join(':',&ary2);
+print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
+
+sub somesub {
+ local($num,$P,$F,$L) = @_;
+ ($p,$f,$l) = caller;
+ print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num\n";
+}
+
+&somesub(27, 'main', __FILE__, __LINE__);
+
+package foo;
+&main'somesub(28, 'foo', __FILE__, __LINE__);
+
+package main;
+$i = 28;
+open(FOO,">Cmd_subval.tmp");
+print FOO "blah blah\n";
+close FOO;
+
+&file_main(*F);
+close F;
+&info_main;
+
+&file_package(*F);
+close F;
+&info_package;
+
+unlink 'Cmd_subval.tmp';
+
+sub file_main {
+ local(*F) = @_;
+
+ open(F, 'Cmd_subval.tmp') || die "can't open\n";
+ $i++;
+ eof F ? print "not ok $i\n" : print "ok $i\n";
+}
+
+sub info_main {
+ local(*F);
+
+ open(F, 'Cmd_subval.tmp') || die "test: can't open\n";
+ $i++;
+ eof F ? print "not ok $i\n" : print "ok $i\n";
+ &iseof(*F);
+ close F;
+}
+
+sub iseof {
+ local(*UNIQ) = @_;
+
+ $i++;
+ eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n";
+}
+
+{package foo;
+
+ sub main'file_package {
+ local(*F) = @_;
+
+ open(F, 'Cmd_subval.tmp') || die "can't open\n";
+ $main'i++;
+ eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+ }
+
+ sub main'info_package {
+ local(*F);
+
+ open(F, 'Cmd_subval.tmp') || die "can't open\n";
+ $main'i++;
+ eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+ &iseof(*F);
+ }
+
+ sub iseof {
+ local(*UNIQ) = @_;
+
+ $main'i++;
+ eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
+ }
+}
diff --git a/t/cmd/switch.t b/t/cmd/switch.t
new file mode 100644
index 0000000000..2af2c9e971
--- /dev/null
+++ b/t/cmd/switch.t
@@ -0,0 +1,75 @@
+#!./perl
+
+# $Header: switch.t,v 4.0 91/03/20 01:49:44 lwall Locked $
+
+print "1..18\n";
+
+sub foo1 {
+ $_ = shift(@_);
+ $a = 0;
+ until ($a++) {
+ next if $_ eq 1;
+ next if $_ eq 2;
+ next if $_ eq 3;
+ next if $_ eq 4;
+ return 20;
+ }
+ continue {
+ return $_;
+ }
+}
+
+print do foo1(0) == 20 ? "ok 1\n" : "not ok 1\n";
+print do foo1(1) == 1 ? "ok 2\n" : "not ok 2\n";
+print do foo1(2) == 2 ? "ok 3\n" : "not ok 3\n";
+print do foo1(3) == 3 ? "ok 4\n" : "not ok 4\n";
+print do foo1(4) == 4 ? "ok 5\n" : "not ok 5\n";
+print do foo1(5) == 20 ? "ok 6\n" : "not ok 6\n";
+
+sub foo2 {
+ $_ = shift(@_);
+ {
+ last if $_ == 1;
+ last if $_ == 2;
+ last if $_ == 3;
+ last if $_ == 4;
+ }
+ continue {
+ return 20;
+ }
+ return $_;
+}
+
+print do foo2(0) == 20 ? "ok 7\n" : "not ok 1\n";
+print do foo2(1) == 1 ? "ok 8\n" : "not ok 8\n";
+print do foo2(2) == 2 ? "ok 9\n" : "not ok 9\n";
+print do foo2(3) == 3 ? "ok 10\n" : "not ok 10\n";
+print do foo2(4) == 4 ? "ok 11\n" : "not ok 11\n";
+print do foo2(5) == 20 ? "ok 12\n" : "not ok 12\n";
+
+sub foo3 {
+ $_ = shift(@_);
+ if (/^1/) {
+ return 1;
+ }
+ elsif (/^2/) {
+ return 2;
+ }
+ elsif (/^3/) {
+ return 3;
+ }
+ elsif (/^4/) {
+ return 4;
+ }
+ else {
+ return 20;
+ }
+ return 40;
+}
+
+print do foo3(0) == 20 ? "ok 13\n" : "not ok 13\n";
+print do foo3(1) == 1 ? "ok 14\n" : "not ok 14\n";
+print do foo3(2) == 2 ? "ok 15\n" : "not ok 15\n";
+print do foo3(3) == 3 ? "ok 16\n" : "not ok 16\n";
+print do foo3(4) == 4 ? "ok 17\n" : "not ok 17\n";
+print do foo3(5) == 20 ? "ok 18\n" : "not ok 18\n";
diff --git a/t/cmd/while.t b/t/cmd/while.t
new file mode 100644
index 0000000000..9876095c1c
--- /dev/null
+++ b/t/cmd/while.t
@@ -0,0 +1,110 @@
+#!./perl
+
+# $Header: while.t,v 4.0 91/03/20 01:49:51 lwall Locked $
+
+print "1..10\n";
+
+open (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp.";
+print tmp "tvi925\n";
+print tmp "tvi920\n";
+print tmp "vt100\n";
+print tmp "Amiga\n";
+print tmp "paper\n";
+close tmp;
+
+# test "last" command
+
+open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
+while (<fh>) {
+ last if /vt100/;
+}
+if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
+
+# test "next" command
+
+$bad = '';
+open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
+while (<fh>) {
+ next if /vt100/;
+ $bad = 1 if /vt100/;
+}
+if (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
+
+# test "redo" command
+
+$bad = '';
+open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
+while (<fh>) {
+ if (s/vt100/VT100/g) {
+ s/VT100/Vt100/g;
+ redo;
+ }
+ $bad = 1 if /vt100/;
+ $bad = 1 if /VT100/;
+}
+if (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
+
+# now do the same with a label and a continue block
+
+# test "last" command
+
+$badcont = '';
+open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
+line: while (<fh>) {
+ if (/vt100/) {last line;}
+} continue {
+ $badcont = 1 if /vt100/;
+}
+if (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
+if (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
+
+# test "next" command
+
+$bad = '';
+$badcont = 1;
+open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
+entry: while (<fh>) {
+ next entry if /vt100/;
+ $bad = 1 if /vt100/;
+} continue {
+ $badcont = '' if /vt100/;
+}
+if (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
+if (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
+
+# test "redo" command
+
+$bad = '';
+$badcont = '';
+open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
+loop: while (<fh>) {
+ if (s/vt100/VT100/g) {
+ s/VT100/Vt100/g;
+ redo loop;
+ }
+ $bad = 1 if /vt100/;
+ $bad = 1 if /VT100/;
+} continue {
+ $badcont = 1 if /vt100/;
+}
+if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
+if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
+
+`/bin/rm -f Cmd.while.tmp`;
+
+#$x = 0;
+#while (1) {
+# if ($x > 1) {last;}
+# next;
+#} continue {
+# if ($x++ > 10) {last;}
+# next;
+#}
+#
+#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
+
+$i = 9;
+{
+ $i++;
+}
+print "ok $i\n";
View Lorry Controller Status