diff options
Diffstat (limited to 'contrib/perl5/t/cmd')
| -rwxr-xr-x | contrib/perl5/t/cmd/elsif.t | 25 | ||||
| -rwxr-xr-x | contrib/perl5/t/cmd/for.t | 49 | ||||
| -rwxr-xr-x | contrib/perl5/t/cmd/mod.t | 54 | ||||
| -rwxr-xr-x | contrib/perl5/t/cmd/subval.t | 186 | ||||
| -rwxr-xr-x | contrib/perl5/t/cmd/switch.t | 75 | ||||
| -rwxr-xr-x | contrib/perl5/t/cmd/while.t | 111 |
6 files changed, 500 insertions, 0 deletions
diff --git a/contrib/perl5/t/cmd/elsif.t b/contrib/perl5/t/cmd/elsif.t new file mode 100755 index 0000000..7eace16 --- /dev/null +++ b/contrib/perl5/t/cmd/elsif.t @@ -0,0 +1,25 @@ +#!./perl + +# $RCSfile: elsif.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:08 $ + +sub foo { + if ($_[0] == 1) { + 1; + } + elsif ($_[0] == 2) { + 2; + } + elsif ($_[0] == 3) { + 3; + } + else { + 4; + } +} + +print "1..4\n"; + +if (($x = &foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";} +if (($x = &foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";} +if (($x = &foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";} +if (($x = &foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";} diff --git a/contrib/perl5/t/cmd/for.t b/contrib/perl5/t/cmd/for.t new file mode 100755 index 0000000..e45f050 --- /dev/null +++ b/contrib/perl5/t/cmd/for.t @@ -0,0 +1,49 @@ +#!./perl + +# $RCSfile: for.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:09 $ + +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/contrib/perl5/t/cmd/mod.t b/contrib/perl5/t/cmd/mod.t new file mode 100755 index 0000000..e2ab777 --- /dev/null +++ b/contrib/perl5/t/cmd/mod.t @@ -0,0 +1,54 @@ +#!./perl + +# $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $ + +print "1..12\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 @x\n"; +} + +$x = 15; +$x = 10 while $x < 10; +if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";} + +$y[$_] = $_ * 2 foreach @x; +if (join(' ',@y) eq '0 2 4 6 8 10 12 14 16 18 20') { + print "ok 7\n"; +} else { + print "not ok 7 @y\n"; +} + +open(foo,'./TEST') || open(foo,'TEST') || open(foo,'t/TEST'); +$x = 0; +$x++ while <foo>; +print $x > 50 && $x < 1000 ? "ok 8\n" : "not ok 8\n"; + +$x = -0.5; +print "not " if scalar($x) < 0 and $x >= 0; +print "ok 9\n"; + +print "not " unless (-(-$x) < 0) == ($x < 0); +print "ok 10\n"; + +print "ok 11\n" if $x < 0; +print "not ok 11\n" unless $x < 0; + +print "ok 12\n" unless $x > 0; +print "not ok 12\n" if $x > 0; + diff --git a/contrib/perl5/t/cmd/subval.t b/contrib/perl5/t/cmd/subval.t new file mode 100755 index 0000000..3c60690 --- /dev/null +++ b/contrib/perl5/t/cmd/subval.t @@ -0,0 +1,186 @@ +#!./perl + +# $RCSfile: subval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:13 $ + +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..36\n"; + +if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";} +if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";} +if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";} +if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";} + +if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";} +if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";} +if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";} +if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";} + +if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";} +if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";} +if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";} +if (&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 { + my($arg) = @_; + my($foo); + $level++; + if ($arg <= 2) { + $foo = 1; + } + else { + $foo = &fib($arg-1) + &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 (&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 $p:$f:$l ne $P:$F:$L\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"; + } +} + +sub autov { $_[0] = 23 }; + +my $href = {}; +print keys %$href ? 'not ' : '', "ok 35\n"; +autov($href->{b}); +print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n"; diff --git a/contrib/perl5/t/cmd/switch.t b/contrib/perl5/t/cmd/switch.t new file mode 100755 index 0000000..faa5de4 --- /dev/null +++ b/contrib/perl5/t/cmd/switch.t @@ -0,0 +1,75 @@ +#!./perl + +# $RCSfile: switch.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:14 $ + +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 7\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/contrib/perl5/t/cmd/while.t b/contrib/perl5/t/cmd/while.t new file mode 100755 index 0000000..c6e464d --- /dev/null +++ b/contrib/perl5/t/cmd/while.t @@ -0,0 +1,111 @@ +#!./perl + +# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $ + +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";} + +close(fh) || die "Can't close Cmd_while.tmp."; +unlink 'Cmd_while.tmp' || `/bin/rm 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"; |
