Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
79072805 | 3 | # $RCSfile: subval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:13 $ |
8d063cd8 LW |
4 | |
5 | sub foo1 { | |
6 | 'true1'; | |
7 | if ($_[0]) { 'true2'; } | |
8 | } | |
9 | ||
10 | sub foo2 { | |
11 | 'true1'; | |
a687059c LW |
12 | if ($_[0]) { return 'true2'; } else { return 'true3'; } |
13 | 'true0'; | |
8d063cd8 LW |
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 | ||
39c3038c | 36 | print "1..34\n"; |
8d063cd8 | 37 | |
93a17b20 LW |
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";} | |
8d063cd8 | 42 | |
93a17b20 LW |
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";} | |
8d063cd8 | 47 | |
93a17b20 LW |
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";} | |
378cc40b LW |
52 | |
53 | # Now test to see that recursion works using a Fibonacci number generator | |
54 | ||
55 | sub fib { | |
93a17b20 LW |
56 | my($arg) = @_; |
57 | my($foo); | |
378cc40b LW |
58 | $level++; |
59 | if ($arg <= 2) { | |
60 | $foo = 1; | |
61 | } | |
62 | else { | |
93a17b20 | 63 | $foo = &fib($arg-1) + &fib($arg-2); |
378cc40b LW |
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; | |
93a17b20 | 73 | if (&fib($i) == $good[$i]) { |
378cc40b LW |
74 | print "ok $foo\n"; |
75 | } | |
76 | else { | |
77 | print "not ok $foo\n"; | |
78 | } | |
79 | } | |
a687059c LW |
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 | ||
39c3038c LW |
102 | sub somesub { |
103 | local($num,$P,$F,$L) = @_; | |
104 | ($p,$f,$l) = caller; | |
de3bb511 | 105 | print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n"; |
39c3038c LW |
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; | |
118 | ||
119 | &file_main(*F); | |
120 | close F; | |
121 | &info_main; | |
122 | ||
123 | &file_package(*F); | |
124 | close F; | |
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; | |
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 | } |