dslinux/user/perl/t/cmd elsif.t for.t mod.t subval.t switch.t while.t
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:01:48 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/t/cmd
In directory antilope:/tmp/cvs-serv17422/t/cmd
Added Files:
elsif.t for.t mod.t subval.t switch.t while.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: switch.t ---
#!./perl
# $RCSfile: switch.t,v $$Revision: 1.2 $$Date: 2006-12-04 17:01:46 $
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";
--- NEW FILE: for.t ---
#!./perl
print "1..78\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('', at 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";
sub bar {
return (1, 2, 4);
}
$a = 0;
foreach $b (bar()) {
$a += $b;
}
print $a == 7 ? "ok" : "not ok", " 11\n";
$loop_count = 0;
for ("-3" .. "0") {
$loop_count++;
}
print $loop_count == 4 ? "ok" : "not ok", " 12\n";
# modifying arrays in loops is a no-no
@a = (3,4);
eval { @a = () for (1,2, at a) };
print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n";
# [perl #30061] double destory when same iterator variable (eg $_) used in
# DESTROY as used in for loop that triggered the destroy
{
my $x = 0;
sub X::DESTROY {
my $o = shift;
$x++;
1 for (1);
}
my %h;
$h{foo} = bless [], 'X';
delete $h{foo} for $h{foo}, 1;
print $x == 1 ? "ok" : "not ok", " 14 - double destroy, x=$x\n";
}
# A lot of tests to check that reversed for works.
my $test = 14;
sub is {
my ($got, $expected, $name) = @_;
++$test;
if ($got eq $expected) {
print "ok $test # $name\n";
return 1;
}
print "not ok $test # $name\n";
print "# got '$got', expected '$expected'\n";
return 0;
}
@array = ('A', 'B', 'C');
for (@array) {
$r .= $_;
}
is ($r, 'ABC', 'Forwards for array');
$r = '';
for (1,2,3) {
$r .= $_;
}
is ($r, '123', 'Forwards for list');
$r = '';
for (map {$_} @array) {
$r .= $_;
}
is ($r, 'ABC', 'Forwards for array via map');
$r = '';
for (map {$_} 1,2,3) {
$r .= $_;
}
is ($r, '123', 'Forwards for list via map');
$r = '';
for (reverse @array) {
$r .= $_;
}
is ($r, 'CBA', 'Reverse for array');
$r = '';
for (reverse 1,2,3) {
$r .= $_;
}
is ($r, '321', 'Reverse for list');
$r = '';
for (reverse map {$_} @array) {
$r .= $_;
}
is ($r, 'CBA', 'Reverse for array via map');
$r = '';
for (reverse map {$_} 1,2,3) {
$r .= $_;
}
is ($r, '321', 'Reverse for list via map');
$r = '';
for my $i (@array) {
$r .= $i;
}
is ($r, 'ABC', 'Forwards for array with var');
$r = '';
for my $i (1,2,3) {
$r .= $i;
}
is ($r, '123', 'Forwards for list with var');
$r = '';
for my $i (map {$_} @array) {
$r .= $i;
}
is ($r, 'ABC', 'Forwards for array via map with var');
$r = '';
for my $i (map {$_} 1,2,3) {
$r .= $i;
}
is ($r, '123', 'Forwards for list via map with var');
$r = '';
for my $i (reverse @array) {
$r .= $i;
}
is ($r, 'CBA', 'Reverse for array with var');
$r = '';
for my $i (reverse 1,2,3) {
$r .= $i;
}
is ($r, '321', 'Reverse for list with var');
$r = '';
for my $i (reverse map {$_} @array) {
$r .= $i;
}
is ($r, 'CBA', 'Reverse for array via map with var');
$r = '';
for my $i (reverse map {$_} 1,2,3) {
$r .= $i;
}
is ($r, '321', 'Reverse for list via map with var');
# For some reason the generate optree is different when $_ is implicit.
$r = '';
for $_ (@array) {
$r .= $_;
}
is ($r, 'ABC', 'Forwards for array with explicit $_');
$r = '';
for $_ (1,2,3) {
$r .= $_;
}
is ($r, '123', 'Forwards for list with explicit $_');
$r = '';
for $_ (map {$_} @array) {
$r .= $_;
}
is ($r, 'ABC', 'Forwards for array via map with explicit $_');
$r = '';
for $_ (map {$_} 1,2,3) {
$r .= $_;
}
is ($r, '123', 'Forwards for list via map with explicit $_');
$r = '';
for $_ (reverse @array) {
$r .= $_;
}
is ($r, 'CBA', 'Reverse for array with explicit $_');
$r = '';
for $_ (reverse 1,2,3) {
$r .= $_;
}
is ($r, '321', 'Reverse for list with explicit $_');
$r = '';
for $_ (reverse map {$_} @array) {
$r .= $_;
}
is ($r, 'CBA', 'Reverse for array via map with explicit $_');
$r = '';
for $_ (reverse map {$_} 1,2,3) {
$r .= $_;
}
is ($r, '321', 'Reverse for list via map with explicit $_');
# I don't think that my is that different from our in the optree. But test a
# few:
$r = '';
for our $i (reverse @array) {
$r .= $i;
}
is ($r, 'CBA', 'Reverse for array with our var');
$r = '';
for our $i (reverse 1,2,3) {
$r .= $i;
}
is ($r, '321', 'Reverse for list with our var');
$r = '';
for our $i (reverse map {$_} @array) {
$r .= $i;
}
is ($r, 'CBA', 'Reverse for array via map with our var');
$r = '';
for our $i (reverse map {$_} 1,2,3) {
$r .= $i;
}
is ($r, '321', 'Reverse for list via map with our var');
$r = '';
for (1, reverse @array) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array with leading value');
$r = '';
for ('A', reverse 1,2,3) {
$r .= $_;
}
is ($r, 'A321', 'Reverse for list with leading value');
$r = '';
for (1, reverse map {$_} @array) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array via map with leading value');
$r = '';
for ('A', reverse map {$_} 1,2,3) {
$r .= $_;
}
is ($r, 'A321', 'Reverse for list via map with leading value');
$r = '';
for (reverse (@array), 1) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for array with trailing value');
$r = '';
for (reverse (1,2,3), 'A') {
$r .= $_;
}
is ($r, '321A', 'Reverse for list with trailing value');
$r = '';
for (reverse (map {$_} @array), 1) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for array via map with trailing value');
$r = '';
for (reverse (map {$_} 1,2,3), 'A') {
$r .= $_;
}
is ($r, '321A', 'Reverse for list via map with trailing value');
$r = '';
for $_ (1, reverse @array) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array with leading value with explicit $_');
$r = '';
for $_ ('A', reverse 1,2,3) {
$r .= $_;
}
is ($r, 'A321', 'Reverse for list with leading value with explicit $_');
$r = '';
for $_ (1, reverse map {$_} @array) {
$r .= $_;
}
is ($r, '1CBA',
'Reverse for array via map with leading value with explicit $_');
$r = '';
for $_ ('A', reverse map {$_} 1,2,3) {
$r .= $_;
}
is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_');
$r = '';
for $_ (reverse (@array), 1) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for array with trailing value with explicit $_');
$r = '';
for $_ (reverse (1,2,3), 'A') {
$r .= $_;
}
is ($r, '321A', 'Reverse for list with trailing value with explicit $_');
$r = '';
for $_ (reverse (map {$_} @array), 1) {
$r .= $_;
}
is ($r, 'CBA1',
'Reverse for array via map with trailing value with explicit $_');
$r = '';
for $_ (reverse (map {$_} 1,2,3), 'A') {
$r .= $_;
}
is ($r, '321A',
'Reverse for list via map with trailing value with explicit $_');
$r = '';
for my $i (1, reverse @array) {
$r .= $i;
}
is ($r, '1CBA', 'Reverse for array with leading value and var');
$r = '';
for my $i ('A', reverse 1,2,3) {
$r .= $i;
}
is ($r, 'A321', 'Reverse for list with leading value and var');
$r = '';
for my $i (1, reverse map {$_} @array) {
$r .= $i;
}
is ($r, '1CBA', 'Reverse for array via map with leading value and var');
$r = '';
for my $i ('A', reverse map {$_} 1,2,3) {
$r .= $i;
}
is ($r, 'A321', 'Reverse for list via map with leading value and var');
$r = '';
for my $i (reverse (@array), 1) {
$r .= $i;
}
is ($r, 'CBA1', 'Reverse for array with trailing value and var');
$r = '';
for my $i (reverse (1,2,3), 'A') {
$r .= $i;
}
is ($r, '321A', 'Reverse for list with trailing value and var');
$r = '';
for my $i (reverse (map {$_} @array), 1) {
$r .= $i;
}
is ($r, 'CBA1', 'Reverse for array via map with trailing value and var');
$r = '';
for my $i (reverse (map {$_} 1,2,3), 'A') {
$r .= $i;
}
is ($r, '321A', 'Reverse for list via map with trailing value and var');
$r = '';
for (reverse 1, @array) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for value and array');
$r = '';
for (reverse map {$_} 1, @array) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for value and array via map');
$r = '';
for (reverse (@array, 1)) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array and value');
$r = '';
for (reverse (map {$_} @array, 1)) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array and value via map');
$r = '';
for $_ (reverse 1, @array) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for value and array with explicit $_');
$r = '';
for $_ (reverse map {$_} 1, @array) {
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
$r = '';
for $_ (reverse (@array, 1)) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array and value with explicit $_');
$r = '';
for $_ (reverse (map {$_} @array, 1)) {
$r .= $_;
}
is ($r, '1CBA', 'Reverse for array and value via map with explicit $_');
$r = '';
for my $i (reverse 1, @array) {
$r .= $i;
}
is ($r, 'CBA1', 'Reverse for value and array with var');
$r = '';
for my $i (reverse map {$_} 1, @array) {
$r .= $i;
}
is ($r, 'CBA1', 'Reverse for value and array via map with var');
$r = '';
for my $i (reverse (@array, 1)) {
$r .= $i;
}
is ($r, '1CBA', 'Reverse for array and value with var');
$r = '';
for my $i (reverse (map {$_} @array, 1)) {
$r .= $i;
}
is ($r, '1CBA', 'Reverse for array and value via map with var');
--- NEW FILE: subval.t ---
#!./perl
# $RCSfile: subval.t,v $$Revision: 1.2 $$Date: 2006-12-04 17:01:46 $
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 or die "Can't close Cmd_subval.tmp: $!";
&file_main(*F);
close F or die "Can't close: $!";
&info_main;
&file_package(*F);
close F or die "Can't close: $!";
&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 or die "Can't close: $!";
}
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";
--- NEW FILE: while.t ---
#!./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 or die "Could not close: $!";
# 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;
}
}
--- NEW FILE: elsif.t ---
#!./perl
# $RCSfile: elsif.t,v $$Revision: 1.2 $$Date: 2006-12-04 17:01:46 $
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";}
--- NEW FILE: mod.t ---
#!./perl
# $RCSfile: mod.t,v $$Revision: 1.2 $$Date: 2006-12-04 17:01:46 $
print "1..13\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(' ', at 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(' ', at 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;
# This used to cause a segfault
$x = "".("".do{"foo" for (1)});
print "ok 13\n";
More information about the dslinux-commit
mailing list