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