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 | 57 | ||||
| -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 | 179 |
6 files changed, 0 insertions, 576 deletions
diff --git a/contrib/perl5/t/cmd/elsif.t b/contrib/perl5/t/cmd/elsif.t deleted file mode 100755 index 7eace16..0000000 --- a/contrib/perl5/t/cmd/elsif.t +++ /dev/null @@ -1,25 +0,0 @@ -#!./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 deleted file mode 100755 index d70af57..0000000 --- a/contrib/perl5/t/cmd/for.t +++ /dev/null @@ -1,57 +0,0 @@ -#!./perl - -print "1..10\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; -} - -sub foo { - for $i (1..5) { - return $i if $_[0] == $i; - } -} - -print foo(1) == 1 ? "ok" : "not ok", " 8\n"; -print foo(2) == 2 ? "ok" : "not ok", " 9\n"; -print foo(5) == 5 ? "ok" : "not ok", " 10\n"; diff --git a/contrib/perl5/t/cmd/mod.t b/contrib/perl5/t/cmd/mod.t deleted file mode 100755 index e2ab777..0000000 --- a/contrib/perl5/t/cmd/mod.t +++ /dev/null @@ -1,54 +0,0 @@ -#!./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 deleted file mode 100755 index 3c60690..0000000 --- a/contrib/perl5/t/cmd/subval.t +++ /dev/null @@ -1,186 +0,0 @@ -#!./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 deleted file mode 100755 index faa5de4..0000000 --- a/contrib/perl5/t/cmd/switch.t +++ /dev/null @@ -1,75 +0,0 @@ -#!./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 deleted file mode 100755 index ecc15ed..0000000 --- a/contrib/perl5/t/cmd/while.t +++ /dev/null @@ -1,179 +0,0 @@ -#!./perl - -print "1..22\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"; - -# Check curpm is reset when jumping out of a scope -'abc' =~ /b/; -WHILE: -while (1) { - $i++; - print "#$`,$&,$',\nnot " unless $` . $& . $' eq "abc"; - print "ok $i\n"; - { # Localize changes to $` and friends - 'end' =~ /end/; - redo WHILE if $i == 11; - next WHILE if $i == 12; - # 13 do a normal loop - last WHILE if $i == 14; - } -} -$i++; -print "not " unless $` . $& . $' eq "abc"; -print "ok $i\n"; - -# check that scope cleanup happens right when there's a continue block -{ - my $var = 16; - while (my $i = ++$var) { - next if $i == 17; - last if $i > 17; - my $i = 0; - } - continue { - print "ok ", $var-1, "\nok $i\n"; - } -} - -{ - local $l = 18; - { - local $l = 0 - } - continue { - print "ok $l\n" - } -} - -{ - local $l = 19; - my $x = 0; - while (!$x++) { - local $l = 0 - } - continue { - print "ok $l\n" - } -} - -$i = 20; -{ - while (1) { - my $x; - print $x if defined $x; - $x = "not "; - print "ok $i\n"; ++$i; - if ($i == 21) { - next; - } - last; - } - continue { - print "ok $i\n"; ++$i; - } -} |
