1 | #!./perl |
---|
2 | |
---|
3 | # $RCSfile: subval.t,v $$Revision: 1.1.1.4 $$Date: 2003-01-10 13:40:49 $ |
---|
4 | |
---|
5 | sub foo1 { |
---|
6 | 'true1'; |
---|
7 | if ($_[0]) { 'true2'; } |
---|
8 | } |
---|
9 | |
---|
10 | sub foo2 { |
---|
11 | 'true1'; |
---|
12 | if ($_[0]) { return 'true2'; } else { return 'true3'; } |
---|
13 | 'true0'; |
---|
14 | } |
---|
15 | |
---|
16 | sub foo3 { |
---|
17 | 'true1'; |
---|
18 | unless ($_[0]) { 'true2'; } |
---|
19 | } |
---|
20 | |
---|
21 | sub foo4 { |
---|
22 | 'true1'; |
---|
23 | unless ($_[0]) { 'true2'; } else { 'true3'; } |
---|
24 | } |
---|
25 | |
---|
26 | sub foo5 { |
---|
27 | 'true1'; |
---|
28 | 'true2' if $_[0]; |
---|
29 | } |
---|
30 | |
---|
31 | sub foo6 { |
---|
32 | 'true1'; |
---|
33 | 'true2' unless $_[0]; |
---|
34 | } |
---|
35 | |
---|
36 | print "1..36\n"; |
---|
37 | |
---|
38 | if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";} |
---|
39 | if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";} |
---|
40 | if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";} |
---|
41 | if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";} |
---|
42 | |
---|
43 | if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";} |
---|
44 | if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";} |
---|
45 | if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";} |
---|
46 | if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";} |
---|
47 | |
---|
48 | if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";} |
---|
49 | if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";} |
---|
50 | if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";} |
---|
51 | if (&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 | |
---|
55 | sub 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 | |
---|
71 | for ($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 | |
---|
81 | sub ary1 { |
---|
82 | (1,2,3); |
---|
83 | } |
---|
84 | |
---|
85 | print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n"; |
---|
86 | |
---|
87 | print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n"; |
---|
88 | |
---|
89 | sub ary2 { |
---|
90 | do { |
---|
91 | return (1,2,3); |
---|
92 | (3,2,1); |
---|
93 | }; |
---|
94 | 0; |
---|
95 | } |
---|
96 | |
---|
97 | print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n"; |
---|
98 | |
---|
99 | $x = join(':',&ary2); |
---|
100 | print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n"; |
---|
101 | |
---|
102 | sub 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 | |
---|
110 | package foo; |
---|
111 | &main'somesub(28, 'foo', __FILE__, __LINE__); |
---|
112 | |
---|
113 | package main; |
---|
114 | $i = 28; |
---|
115 | open(FOO,">Cmd_subval.tmp"); |
---|
116 | print FOO "blah blah\n"; |
---|
117 | close FOO or die "Can't close Cmd_subval.tmp: $!"; |
---|
118 | |
---|
119 | &file_main(*F); |
---|
120 | close F or die "Can't close: $!"; |
---|
121 | &info_main; |
---|
122 | |
---|
123 | &file_package(*F); |
---|
124 | close F or die "Can't close: $!"; |
---|
125 | &info_package; |
---|
126 | |
---|
127 | unlink 'Cmd_subval.tmp'; |
---|
128 | |
---|
129 | sub 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 | |
---|
137 | sub 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 | |
---|
147 | sub 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 | |
---|
181 | sub autov { $_[0] = 23 }; |
---|
182 | |
---|
183 | my $href = {}; |
---|
184 | print keys %$href ? 'not ' : '', "ok 35\n"; |
---|
185 | autov($href->{b}); |
---|
186 | print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n"; |
---|