Suppress a few compilation warnings in pp_hot.c.
[p5sagit/p5-mst-13.2.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..22\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 or die "Could not close: $!";
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 or die "Could not close: $!";
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 or die "Could not close: $!";
79 }
80
81 do "$$.18";
82
83 # bug ID 20010920.007
84 eval qq{ do qq(a file that does not exist); };
85 ok( !$@, "do on a non-existing file, first try" );
86
87 eval qq{ do uc qq(a file that does not exist); };
88 ok( !$@, "do on a non-existing file, second try"  );
89
90 # 6 must be interpreted as a file name here
91 ok( (!defined do 6) && $!, "'do 6' : $!" );
92
93 # [perl #19545]
94 push @t, ($u = (do {} . "This should be pushed."));
95 ok( $#t == 0, "empty do result value" );
96
97 END {
98     1 while unlink("$$.16", "$$.17", "$$.18");
99 }