source: trunk/third/perl/t/cmd/subval.t @ 18450

Revision 18450, 3.8 KB checked in by zacheiss, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r18449, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1#!./perl
2
3# $RCSfile: subval.t,v $$Revision: 1.1.1.4 $$Date: 2003-01-10 13:40:49 $
4
5sub foo1 {
6    'true1';
7    if ($_[0]) { 'true2'; }
8}
9
10sub foo2 {
11    'true1';
12    if ($_[0]) { return 'true2'; } else { return 'true3'; }
13    'true0';
14}
15
16sub foo3 {
17    'true1';
18    unless ($_[0]) { 'true2'; }
19}
20
21sub foo4 {
22    'true1';
23    unless ($_[0]) { 'true2'; } else { 'true3'; }
24}
25
26sub foo5 {
27    'true1';
28    'true2' if $_[0];
29}
30
31sub foo6 {
32    'true1';
33    'true2' unless $_[0];
34}
35
36print "1..36\n";
37
38if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
39if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
40if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
41if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
42
43if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
44if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
45if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
46if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
47
48if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
49if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
50if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
51if (&foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
52
53# Now test to see that recursion works using a Fibonacci number generator
54
55sub fib {
56    my($arg) = @_;
57    my($foo);
58    $level++;
59    if ($arg <= 2) {
60        $foo = 1;
61    }
62    else {
63        $foo = &fib($arg-1) + &fib($arg-2);
64    }
65    $level--;
66    $foo;
67}
68
69@good = (0,1,1,2,3,5,8,13,21,34,55,89);
70
71for ($i = 1; $i <= 10; $i++) {
72    $foo = $i + 12;
73    if (&fib($i) == $good[$i]) {
74        print "ok $foo\n";
75    }
76    else {
77        print "not ok $foo\n";
78    }
79}
80
81sub ary1 {
82    (1,2,3);
83}
84
85print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n";
86
87print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n";
88
89sub ary2 {
90    do {
91        return (1,2,3);
92        (3,2,1);
93    };
94    0;
95}
96
97print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n";
98
99$x = join(':',&ary2);
100print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
101
102sub somesub {
103    local($num,$P,$F,$L) = @_;
104    ($p,$f,$l) = caller;
105    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n";
106}
107
108&somesub(27, 'main', __FILE__, __LINE__);
109
110package foo;
111&main'somesub(28, 'foo', __FILE__, __LINE__);
112
113package main;
114$i = 28;
115open(FOO,">Cmd_subval.tmp");
116print FOO "blah blah\n";
117close FOO or die "Can't close Cmd_subval.tmp: $!";
118
119&file_main(*F);
120close F or die "Can't close: $!";
121&info_main;
122
123&file_package(*F);
124close F or die "Can't close: $!";
125&info_package;
126
127unlink 'Cmd_subval.tmp';
128
129sub file_main {
130        local(*F) = @_;
131
132        open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
133        $i++;
134        eof F ? print "not ok $i\n" : print "ok $i\n";
135}
136
137sub info_main {
138        local(*F);
139
140        open(F, 'Cmd_subval.tmp') || die "test: can't open: $!\n";
141        $i++;
142        eof F ? print "not ok $i\n" : print "ok $i\n";
143        &iseof(*F);
144        close F or die "Can't close: $!";
145}
146
147sub iseof {
148        local(*UNIQ) = @_;
149
150        $i++;
151        eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n";
152}
153
154{package foo;
155
156 sub main'file_package {
157        local(*F) = @_;
158
159        open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
160        $main'i++;
161        eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
162 }
163
164 sub main'info_package {
165        local(*F);
166
167        open(F, 'Cmd_subval.tmp') || die "can't open: $!\n";
168        $main'i++;
169        eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
170        &iseof(*F);
171 }
172
173 sub iseof {
174        local(*UNIQ) = @_;
175
176        $main'i++;
177        eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
178 }
179}
180
181sub autov { $_[0] = 23 };
182
183my $href = {};
184print keys %$href ? 'not ' : '', "ok 35\n";
185autov($href->{b});
186print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n";
Note: See TracBrowser for help on using the repository browser.