9 @ISA = qw(Bit::Vector);
11 # ======================================================================
12 # $set = Bit::Vector::new('Bit::Vector',$elements);
13 # ======================================================================
19 # test if the constructor works at all:
21 $set = Bit::Vector::new('Bit::Vector',1);
23 {print "ok $n\n";} else {print "not ok $n\n";}
25 if (ref($set) eq 'Bit::Vector')
26 {print "ok $n\n";} else {print "not ok $n\n";}
29 {print "ok $n\n";} else {print "not ok $n\n";}
32 # test if the constructor handles NULL pointers as expected:
34 eval { $ref = Bit::Vector::new('Bit::Vector',0); };
36 {print "ok $n\n";} else {print "not ok $n\n";}
39 # test if the copy of an object reference works as expected:
43 {print "ok $n\n";} else {print "not ok $n\n";}
45 if (ref($ref) eq 'Bit::Vector')
46 {print "ok $n\n";} else {print "not ok $n\n";}
49 {print "ok $n\n";} else {print "not ok $n\n";}
52 if (${$ref} == ${$set})
53 {print "ok $n\n";} else {print "not ok $n\n";}
56 # test the constructor with a large set (13,983,816 elements):
58 $set = Bit::Vector::new('Bit::Vector',&binomial(49,6));
60 {print "ok $n\n";} else {print "not ok $n\n";}
62 if (ref($set) eq 'Bit::Vector')
63 {print "ok $n\n";} else {print "not ok $n\n";}
66 {print "ok $n\n";} else {print "not ok $n\n";}
69 # are the two sets really distinct and set objects behaving as expected?
71 if (${$ref} != ${$set})
72 {print "ok $n\n";} else {print "not ok $n\n";}
75 # are set objects behaving as expected, i.e. are they write-protected?
77 eval { ${$set} = 0x00088850; };
78 if ($@ =~ /Modification of a read-only value attempted/)
79 {print "ok $n\n";} else {print "not ok $n\n";}
83 {print "ok $n\n";} else {print "not ok $n\n";}
86 eval { ${$ref} = 0x000E9CE0; };
87 if ($@ =~ /Modification of a read-only value attempted/)
88 {print "ok $n\n";} else {print "not ok $n\n";}
92 {print "ok $n\n";} else {print "not ok $n\n";}
95 # test various ways of calling the constructor:
97 # 1: $set = Bit::Vector::new('Bit::Vector',1);
98 # 2: $class = 'Bit::Vector'; $set = Bit::Vector::new($class,2);
99 # 3: $set = new Bit::Vector(3);
100 # 4: $set = Bit::Vector->new(4);
101 # 5: $ref = $set->new(5);
102 # 6: $set = $set->new(6);
104 # (test case #1 has been handled above)
108 $class = 'Bit::Vector';
109 $set = Bit::Vector::new($class,2);
111 {print "ok $n\n";} else {print "not ok $n\n";}
113 if (ref($set) eq 'Bit::Vector')
114 {print "ok $n\n";} else {print "not ok $n\n";}
117 {print "ok $n\n";} else {print "not ok $n\n";}
122 $ref = new Bit::Vector(3);
124 {print "ok $n\n";} else {print "not ok $n\n";}
126 if (ref($ref) eq 'Bit::Vector')
127 {print "ok $n\n";} else {print "not ok $n\n";}
130 {print "ok $n\n";} else {print "not ok $n\n";}
135 if (${$ref} != ${$set})
136 {print "ok $n\n";} else {print "not ok $n\n";}
141 $set = Bit::Vector->new(4);
143 {print "ok $n\n";} else {print "not ok $n\n";}
145 if (ref($set) eq 'Bit::Vector')
146 {print "ok $n\n";} else {print "not ok $n\n";}
149 {print "ok $n\n";} else {print "not ok $n\n";}
154 if (${$ref} != ${$set})
155 {print "ok $n\n";} else {print "not ok $n\n";}
158 # prepare possibility for id check:
162 {print "ok $n\n";} else {print "not ok $n\n";}
169 {print "ok $n\n";} else {print "not ok $n\n";}
171 if (ref($ref) eq 'Bit::Vector')
172 {print "ok $n\n";} else {print "not ok $n\n";}
175 {print "ok $n\n";} else {print "not ok $n\n";}
181 {print "ok $n\n";} else {print "not ok $n\n";}
183 if (ref($set) eq 'Bit::Vector')
184 {print "ok $n\n";} else {print "not ok $n\n";}
187 {print "ok $n\n";} else {print "not ok $n\n";}
191 {print "ok $n\n";} else {print "not ok $n\n";}
194 if (${$ref} != ${$set})
195 {print "ok $n\n";} else {print "not ok $n\n";}
198 # prepare exact copy of object reference:
202 {print "ok $n\n";} else {print "not ok $n\n";}
204 if (ref($ref) eq 'Bit::Vector')
205 {print "ok $n\n";} else {print "not ok $n\n";}
208 {print "ok $n\n";} else {print "not ok $n\n";}
211 if (${$ref} == ${$set})
212 {print "ok $n\n";} else {print "not ok $n\n";}
216 {print "ok $n\n";} else {print "not ok $n\n";}
219 # test case #6 (pseudo auto-destruction test):
223 {print "ok $n\n";} else {print "not ok $n\n";}
225 if (ref($set) eq 'Bit::Vector')
226 {print "ok $n\n";} else {print "not ok $n\n";}
229 {print "ok $n\n";} else {print "not ok $n\n";}
235 {print "ok $n\n";} else {print "not ok $n\n";}
237 if (ref($ref) eq 'Bit::Vector')
238 {print "ok $n\n";} else {print "not ok $n\n";}
241 {print "ok $n\n";} else {print "not ok $n\n";}
245 {print "ok $n\n";} else {print "not ok $n\n";}
248 if (${$ref} != ${$set})
249 {print "ok $n\n";} else {print "not ok $n\n";}
252 # auto-destruction test:
256 {print "ok $n\n";} else {print "not ok $n\n";}
258 if (ref($set) eq 'Bit::Vector')
259 {print "ok $n\n";} else {print "not ok $n\n";}
262 {print "ok $n\n";} else {print "not ok $n\n";}
267 if (${$ref} != ${$set})
268 {print "ok $n\n";} else {print "not ok $n\n";}
271 # test weird ways of calling the constructor:
273 eval { $set = Bit::Vector::new("",8); };
274 if (ref($set) eq 'Bit::Vector')
275 {print "ok $n\n";} else {print "not ok $n\n";}
278 eval { $set = Bit::Vector::new('',9); };
279 if (ref($set) eq 'Bit::Vector')
280 {print "ok $n\n";} else {print "not ok $n\n";}
283 eval { $set = Bit::Vector::new(undef,10); };
284 if (ref($set) eq 'Bit::Vector')
285 {print "ok $n\n";} else {print "not ok $n\n";}
288 eval { $set = Bit::Vector::new(6502,11); };
289 if (ref($set) eq 'Bit::Vector')
290 {print "ok $n\n";} else {print "not ok $n\n";}
293 eval { $set = Bit::Vector::new('main',12); };
295 {print "ok $n\n";} else {print "not ok $n\n";}
298 {print "ok $n\n";} else {print "not ok $n\n";}
300 if ( (ref($set) eq 'main') || (ref($set) eq 'Bit::Vector') )
301 {print "ok $n\n";} else {print "not ok $n\n";}
304 {print "ok $n\n";} else {print "not ok $n\n";}
309 {print "ok $n\n";} else {print "not ok $n\n";}
312 eval { $set = Bit::Vector::new('nonsense',13); };
314 {print "ok $n\n";} else {print "not ok $n\n";}
317 {print "ok $n\n";} else {print "not ok $n\n";}
319 if ( (ref($set) eq 'nonsense') || (ref($set) eq 'Bit::Vector') )
320 {print "ok $n\n";} else {print "not ok $n\n";}
323 {print "ok $n\n";} else {print "not ok $n\n";}
328 {print "ok $n\n";} else {print "not ok $n\n";}
331 eval { $set = new main(14); };
333 {print "ok $n\n";} else {print "not ok $n\n";}
336 {print "ok $n\n";} else {print "not ok $n\n";}
338 if ( (ref($set) eq 'main') || (ref($set) eq 'Bit::Vector') )
339 {print "ok $n\n";} else {print "not ok $n\n";}
342 {print "ok $n\n";} else {print "not ok $n\n";}
347 {print "ok $n\n";} else {print "not ok $n\n";}
350 @parameters = ( 'main', 15 );
351 eval { $set = Bit::Vector::new(@parameters); };
353 {print "ok $n\n";} else {print "not ok $n\n";}
356 {print "ok $n\n";} else {print "not ok $n\n";}
358 if ( (ref($set) eq 'main') || (ref($set) eq 'Bit::Vector') )
359 {print "ok $n\n";} else {print "not ok $n\n";}
362 {print "ok $n\n";} else {print "not ok $n\n";}
367 {print "ok $n\n";} else {print "not ok $n\n";}
370 # test syntactically incorrect constructor calls:
372 eval { $set = Bit::Vector::new(16); };
373 if ($@ =~ /Usage: new\(class,bits\[,count\]\)/)
374 {print "ok $n\n";} else {print "not ok $n\n";}
377 eval { $set = Bit::Vector::new('main'); };
378 if ($@ =~ /Usage: new\(class,bits\[,count\]\)/)
379 {print "ok $n\n";} else {print "not ok $n\n";}
382 eval { $set = Bit::Vector::new($set); };
383 if ($@ =~ /Usage: new\(class,bits\[,count\]\)/)
384 {print "ok $n\n";} else {print "not ok $n\n";}
387 eval { $set = Bit::Vector::new('main',17,1,0); };
388 if ($@ =~ /Usage: new\(class,bits\[,count\]\)/)
389 {print "ok $n\n";} else {print "not ok $n\n";}
392 eval { $set = Bit::Vector::Create($set,'main',18,0); };
393 if ($@ =~ /Usage: Create\(class,bits\[,count\]\)/)
394 {print "ok $n\n";} else {print "not ok $n\n";}
397 eval { $set = Bit::Vector::new($set,19,'main',0); };
398 if ($@ =~ /Usage: new\(class,bits\[,count\]\)/)
399 {print "ok $n\n";} else {print "not ok $n\n";}
402 # test if size is correct:
404 for ( $i = 1; $i <= 16; $i++ )
406 $k = int(2 ** $i + 0.5);
407 for ( $j = $k-1; $j <= $k+1; $j++ )
409 $set = Bit::Vector->new($j);
410 if ($set->Size() == $j)
411 {print "ok $n\n";} else {print "not ok $n\n";}
424 if (($n <= 0) || ($k <= 0) || ($n <= $k)) { return(1); }
425 if ($k > $n - $k) { $k = $n - $k; }
431 return(int($prod + 0.5));