1#!./perl 2 3sub foo1 4{ 5 ok($_[0]); 6 'value'; 7} 8 9sub foo2 10{ 11 shift; 12 ok($_[0]); 13 $x = 'value'; 14 $x; 15} 16 17my $test = 1; 18sub ok { 19 my($ok, $name) = @_; 20 21 # You have to do it this way or VMS will get confused. 22 printf "%s %d%s\n", $ok ? "ok" : "not ok", 23 $test, 24 defined $name ? " - $name" : ''; 25 26 printf "# Failed test at line %d\n", (caller)[2] unless $ok; 27 28 $test++; 29 return $ok; 30} 31 32print "1..22\n"; 33 34# Test do &sub and proper @_ handling. 35$_[0] = 0; 36$result = do foo1(1); 37 38ok( $result eq 'value', ":$result: eq :value:" ); 39ok( $_[0] == 0 ); 40 41$_[0] = 0; 42$result = do foo2(0,1,0); 43ok( $result eq 'value', ":$result: eq :value:" ); 44ok( $_[0] == 0 ); 45 46$result = do{ ok 1; 'value';}; 47ok( $result eq 'value', ":$result: eq :value:" ); 48 49sub blather { 50 ok 1 foreach @_; 51} 52 53do blather("ayep","sho nuff"); 54@x = ("jeepers", "okydoke"); 55@y = ("uhhuh", "yeppers"); 56do blather(@x,"noofie",@y); 57 58unshift @INC, '.'; 59 60if (open(DO, ">$$.16")) { 61 print DO "ok(1, 'do in scalar context') if defined wantarray && not wantarray\n"; 62 close DO or die "Could not close: $!"; 63} 64 65my $a = do "$$.16"; die $@ if $@; 66 67if (open(DO, ">$$.17")) { 68 print DO "ok(1, 'do in list context') if defined wantarray && wantarray\n"; 69 close DO or die "Could not close: $!"; 70} 71 72my @a = do "$$.17"; die $@ if $@; 73 74if (open(DO, ">$$.18")) { 75 print DO "ok(1, 'do in void context') if not defined wantarray\n"; 76 close DO or die "Could not close: $!"; 77} 78 79do "$$.18"; die $@ if $@; 80 81# bug ID 20010920.007 82eval qq{ do qq(a file that does not exist); }; 83ok( !$@, "do on a non-existing file, first try" ); 84 85eval qq{ do uc qq(a file that does not exist); }; 86ok( !$@, "do on a non-existing file, second try" ); 87 88# 6 must be interpreted as a file name here 89ok( (!defined do 6) && $!, "'do 6' : $!" ); 90 91# [perl #19545] 92push @t, ($u = (do {} . "This should be pushed.")); 93ok( $#t == 0, "empty do result value" ); 94 95END { 96 1 while unlink("$$.16", "$$.17", "$$.18"); 97} 98