This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pulling ancient RCS comments
[perl5.git] / t / op / do.t
1 #!./perl
2
3 sub foo1
4 {
5     ok($_[0]);
6     'value';
7 }
8
9 sub foo2
10 {
11     shift;
12     ok($_[0]);
13     $x = 'value';
14     $x;
15 }
16
17 my $test = 1;
18 sub 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
32 print "1..22\n";
33
34 # Test do &sub and proper @_ handling.
35 $_[0] = 0;
36 $result = do foo1(1);
37
38 ok( $result eq 'value',  ":$result: eq :value:" );
39 ok( $_[0] == 0 );
40
41 $_[0] = 0;
42 $result = do foo2(0,1,0);
43 ok( $result eq 'value', ":$result: eq :value:" );
44 ok( $_[0] == 0 );
45
46 $result = do{ ok 1; 'value';};
47 ok( $result eq 'value',  ":$result: eq :value:" );
48
49 sub blather {
50     ok 1 foreach @_;
51 }
52
53 do blather("ayep","sho nuff");
54 @x = ("jeepers", "okydoke");
55 @y = ("uhhuh", "yeppers");
56 do blather(@x,"noofie",@y);
57
58 unshift @INC, '.';
59
60 if (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
65 my $a = do "$$.16";
66
67 if (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
72 my @a = do "$$.17";
73
74 if (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
79 do "$$.18";
80
81 # bug ID 20010920.007
82 eval qq{ do qq(a file that does not exist); };
83 ok( !$@, "do on a non-existing file, first try" );
84
85 eval qq{ do uc qq(a file that does not exist); };
86 ok( !$@, "do on a non-existing file, second try"  );
87
88 # 6 must be interpreted as a file name here
89 ok( (!defined do 6) && $!, "'do 6' : $!" );
90
91 # [perl #19545]
92 push @t, ($u = (do {} . "This should be pushed."));
93 ok( $#t == 0, "empty do result value" );
94
95 END {
96     1 while unlink("$$.16", "$$.17", "$$.18");
97 }