This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
1d6fb90ef02f082942d97340929ea0eadb691d2e
[perl5.git] / t / op / do.t
1 #!./perl
2
3 # $RCSfile: do.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:45 $
4
5 sub foo1
6 {
7     ok($_[0]);
8     'value';
9 }
10
11 sub foo2
12 {
13     shift;
14     ok($_[0]);
15     $x = 'value';
16     $x;
17 }
18
19 my $test = 1;
20 sub 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
34 print "1..20\n";
35
36 # Test do &sub and proper @_ handling.
37 $_[0] = 0;
38 $result = do foo1(1);
39
40 ok( $result eq 'value',  ":$result: eq :value:" );
41 ok( $_[0] == 0 );
42
43 $_[0] = 0;
44 $result = do foo2(0,1,0);
45 ok( $result eq 'value', ":$result: eq :value:" );
46 ok( $_[0] == 0 );
47
48 $result = do{ ok 1; 'value';};
49 ok( $result eq 'value',  ":$result: eq :value:" );
50
51 sub blather {
52     ok 1 foreach @_;
53 }
54
55 do blather("ayep","sho nuff");
56 @x = ("jeepers", "okydoke");
57 @y = ("uhhuh", "yeppers");
58 do blather(@x,"noofie",@y);
59
60 unshift @INC, '.';
61
62 if (open(DO, ">$$.16")) {
63     print DO "ok(1, 'do in scalar context') if defined wantarray && not wantarray\n";
64     close DO;
65 }
66
67 my $a = do "$$.16";
68
69 if (open(DO, ">$$.17")) {
70     print DO "ok(1, 'do in list context') if defined wantarray &&     wantarray\n";
71     close DO;
72 }
73
74 my @a = do "$$.17";
75
76 if (open(DO, ">$$.18")) {
77     print DO "ok(1, 'do in void context') if not defined wantarray\n";
78     close DO;
79 }
80
81 do "$$.18";
82
83 # bug ID 20010920.007
84 eval qq{ do qq(a file that does not exist); };
85 ok( !$@ );
86
87 eval qq{ do uc qq(a file that does not exist); };
88 ok( !$@ );
89
90 eval qq{ do qq(a file that does not exist); };
91 print "not " if $@;
92 print "ok 19\n";
93
94 eval qq{ do uc qq(a file that does not exist); };
95 print "not " if $@;
96 print "ok 20\n";
97
98 END {
99     1 while unlink("$$.16", "$$.17", "$$.18");
100 }