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