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