1N/A#!./perl
1N/A
1N/A# $RCSfile: do.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:45 $
1N/A
1N/Asub foo1
1N/A{
1N/A ok($_[0]);
1N/A 'value';
1N/A}
1N/A
1N/Asub foo2
1N/A{
1N/A shift;
1N/A ok($_[0]);
1N/A $x = 'value';
1N/A $x;
1N/A}
1N/A
1N/Amy $test = 1;
1N/Asub ok {
1N/A my($ok, $name) = @_;
1N/A
1N/A # You have to do it this way or VMS will get confused.
1N/A printf "%s %d%s\n", $ok ? "ok" : "not ok",
1N/A $test,
1N/A defined $name ? " - $name" : '';
1N/A
1N/A printf "# Failed test at line %d\n", (caller)[2] unless $ok;
1N/A
1N/A $test++;
1N/A return $ok;
1N/A}
1N/A
1N/Aprint "1..22\n";
1N/A
1N/A# Test do &sub and proper @_ handling.
1N/A$_[0] = 0;
1N/A$result = do foo1(1);
1N/A
1N/Aok( $result eq 'value', ":$result: eq :value:" );
1N/Aok( $_[0] == 0 );
1N/A
1N/A$_[0] = 0;
1N/A$result = do foo2(0,1,0);
1N/Aok( $result eq 'value', ":$result: eq :value:" );
1N/Aok( $_[0] == 0 );
1N/A
1N/A$result = do{ ok 1; 'value';};
1N/Aok( $result eq 'value', ":$result: eq :value:" );
1N/A
1N/Asub blather {
1N/A ok 1 foreach @_;
1N/A}
1N/A
1N/Ado blather("ayep","sho nuff");
1N/A@x = ("jeepers", "okydoke");
1N/A@y = ("uhhuh", "yeppers");
1N/Ado blather(@x,"noofie",@y);
1N/A
1N/Aunshift @INC, '.';
1N/A
1N/Aif (open(DO, ">$$.16")) {
1N/A print DO "ok(1, 'do in scalar context') if defined wantarray && not wantarray\n";
1N/A close DO or die "Could not close: $!";
1N/A}
1N/A
1N/Amy $a = do "$$.16";
1N/A
1N/Aif (open(DO, ">$$.17")) {
1N/A print DO "ok(1, 'do in list context') if defined wantarray && wantarray\n";
1N/A close DO or die "Could not close: $!";
1N/A}
1N/A
1N/Amy @a = do "$$.17";
1N/A
1N/Aif (open(DO, ">$$.18")) {
1N/A print DO "ok(1, 'do in void context') if not defined wantarray\n";
1N/A close DO or die "Could not close: $!";
1N/A}
1N/A
1N/Ado "$$.18";
1N/A
1N/A# bug ID 20010920.007
1N/Aeval qq{ do qq(a file that does not exist); };
1N/Aok( !$@, "do on a non-existing file, first try" );
1N/A
1N/Aeval qq{ do uc qq(a file that does not exist); };
1N/Aok( !$@, "do on a non-existing file, second try" );
1N/A
1N/A# 6 must be interpreted as a file name here
1N/Aok( (!defined do 6) && $!, "'do 6' : $!" );
1N/A
1N/A# [perl #19545]
1N/Apush @t, ($u = (do {} . "This should be pushed."));
1N/Aok( $#t == 0, "empty do result value" );
1N/A
1N/AEND {
1N/A 1 while unlink("$$.16", "$$.17", "$$.18");
1N/A}