1#!./parrot
2# Copyright (C) 2010, Parrot Foundation.
3
4=head1 NAME
5
6t/dynoplibs/bit.t - Bitwise Dynops
7
8=head1 SYNOPSIS
9
10        % prove t/dynoplibs/bit.t
11
12=head1 DESCRIPTION
13
14Tests basic arithmetic on various combinations of Parrot integer and
15number types.
16
17=cut
18
19.loadlib 'bit_ops'
20
21.sub main :main
22    .include 'test_more.pir'
23
24    plan(139)
25
26    bnot_p_p_creates_destination()
27    band_1()
28    bands_null_string()
29    bands_2()
30    bands_3()
31    bands_4()
32    bands_cow()
33    bor_1()
34    bor_2()
35    bors_null_string()
36    bors_2()
37    bors_3()
38    bors_cow()
39    shl_1()
40    shl_2()
41    shl_3()
42    shr_1()
43    shr_2()
44    lsr_1()
45    bxor_1()
46    bxors_null_string()
47    bxors_2()
48    bxors_3()
49    bxors_cow()
50    bnots_null_string()
51    bnots_2()
52    bnots_cow()
53    bnot_1()
54    rot_1()
55    # END_OF_TESTS
56
57.end
58
59.sub 'bnot_p_p_creates_destination'
60    $P0 = box 3
61    $P1 = bnot $P0
62    is( $P1, -4, 'bnot_p_p_creates_destination' )
63.end
64
65.sub band_1
66    $P0 = new['Integer']
67    $P0 = 3
68    $I0 = 8
69    band $P0, $I0
70    is( $P0, 0, 'band_p_i' )
71    is( $I0, 8, 'band_p_i' )
72
73    $P0 = 3
74    band $P0, 8
75    is( $P0, 0, 'band_p_ic' )
76
77    $P0 = 3
78    $P1 = new ['Integer']
79    $P1 = 1
80    band $P0, $P1
81    is( $P0, 1, 'band_p_p' )
82    is( $P1, 1, 'band_p_p' )
83
84    $I0 = 3
85    band $P0, $P0, $I0
86    is( $P0, 1, 'band_p_p_i' )
87    is( $I0, 3, 'band_p_p_i' )
88
89    band $P0, $P0, 3
90    is( $P0, 1, 'band_p_p_ic' )
91
92    $P0 = 4
93    $P1 = 3
94    $P2 = new ['Integer']
95    band $P2, $P0, $P1
96    is( $P0, 4, 'band_p_p_p' )
97    is( $P1, 3, 'band_p_p_p' )
98    is( $P2, 0, 'band_p_p_p' )
99.end
100
101.sub bands_null_string
102    null $S1
103    set $S2, "abc"
104    $S1 = bands $S1, $S2
105    null $S3
106    is( $S1, $S3, 'ok1' )
107
108    set $S1, ""
109    $S1 = bands $S1, $S2
110    nok( $S1, 'ok2' )
111
112    null $S2
113    set $S1, "abc"
114    $S1 = bands $S1, $S2
115    null $S3
116    is( $S1, $S3, 'ok3' )
117
118    set $S2, ""
119    $S1 = bands $S1, $S2
120    nok( $S1, 'ok4' )
121.end
122
123.sub bands_2
124    set $S1, "abc"
125    set $S2, "EE"
126    $S1 = bands $S1, $S2
127    is( $S1, "A@", 'bands 2' )
128    is( $S2, "EE", 'bands 2' )
129
130    $S1 = bands "abc", $S2
131    is( $S1, "A@", 'bands 2' )
132
133    $S2 = bands "abc", "EE"
134    is( $S2, "A@", 'bands 2' )
135.end
136
137.sub bands_3
138    set $S1, "abc"
139    set $S2, "EE"
140    bands $S0, $S1, $S2
141    is( $S0, "A@", 'bands 3' )
142    is( $S1, "abc", 'bands 3' )
143    is( $S2, "EE", 'bands 3' )
144.end
145
146.sub bands_4
147    $P0 = box "abc"
148    $P1 = new ['String']
149    $S0 = "EE"
150    bands $P1, $P0, $S0
151    is( $P1, "A@", 'bands 4' )
152    is( $P0, "abc", 'bands 4' )
153    is( $S0, "EE", 'bands 4' )
154
155    $P1 = bands $P0, "EE"
156    is( $P1, "A@", 'bands 4' )
157    is( $P0, "abc", 'bands 4' )
158
159    $P0 = box "abc"
160    $S0 = "EE"
161    bands $P0, $S0
162    is( $P0, "A@", 'bands 4' )
163    is( $S0, "EE", 'bands 4' )
164
165    $P0 = box "abc"
166    bands $P0, "EE"
167    is( $P0, "A@", 'bands 4' )
168.end
169
170.sub bands_cow
171    set $S1, "foo"
172    substr $S2, $S1, 0, 3
173    $S1 = bands $S1, "bar"
174    is( $S2, "foo", 'bands COW' )
175.end
176
177.sub bor_1
178    $P0 = new ['Integer']
179    $P1 = clone $P0
180    $P0 = 4
181    $P1 = 3
182    bor $P0, $P1
183    is( $P0, 7, 'bor_p_p' )
184    is( $P1, 3, 'bor_p_p' )
185
186    $P0 = 1
187    $I0 = 3
188    $P1 = new ['Integer']
189    bor $P1, $P0, $I0
190    is( $P0, 1, 'bor_p_p_i' )
191    is( $I0, 3, 'bor_p_p_i' )
192    is( $P1, 3, 'bor_p_p_i' )
193
194    $P0 = 1
195    $P1 = new ['Integer']
196    bor $P1, $P0, 2
197    is( $P0, 1, 'bor_p_p_ic' )
198    is( $P1, 3, 'bor_p_p_ic' )
199
200    $P0 = 1
201    $P1 = new ['Integer']
202    $P1 = 2
203    $P2 = new ['Integer']
204    bor $P2, $P0, $P1
205    is( $P0, 1, 'bor_p_p_p' )
206    is( $P1, 2, 'bor_p_p_p' )
207    is( $P2, 3, 'bor_p_p_p' )
208.end
209
210.sub bor_2
211    $I0 = 40
212    $P0 = box 20
213    bor $P0, $I0
214    is( $P0, 60, 'bor_p_i' )
215
216    $P0 = box 30
217    bor $P0, 40
218    is( $P0, 62, 'bor_p_ic' )
219.end
220
221.sub bors_null_string
222    null $S1
223    null $S2
224    $S1 = bors $S1, $S2
225    null $S3
226    is( $S1, $S3, 'bors NULL string' )
227
228    null $S1
229    set $S2, ""
230    $S1 = bors $S1, $S2
231    null $S3
232    is( $S1, $S3, 'bors NULL string' )
233
234    $S2 = bors $S2, $S1
235    is( $S2, $S3, 'bors NULL string' )
236
237    null $S1
238    set $S2, "def"
239    $S1 = bors $S1, $S2
240    is( $S1, "def", 'bors NULL string' )
241
242    null $S2
243    $S1 = bors $S1, $S2
244    is( $S1, "def", 'bors NULL string' )
245
246    null $S1
247    null $S2
248    bors $S3, $S1, $S2
249    null $S4
250    is( $S3, $S4, 'bors NULL string' )
251
252    set $S1, ""
253    bors $S3, $S1, $S2
254    is( $S3, $S4, 'bors NULL string' )
255
256    bors $S3, $S2, $S1
257    is( $S3, $S4, 'bors NULL string' )
258
259    set $S1, "def"
260    bors $S3, $S1, $S2
261    is( $S3, "def", 'bors NULL string' )
262
263    bors $S3, $S2, $S1
264    is( $S3, "def", 'bors NULL string' )
265.end
266
267.sub bors_2
268    set $S1, "abc"
269    set $S2, "EE"
270    $S1 = bors $S1, $S2
271    is( $S1, "egc", 'bors 2' )
272    is( $S2, "EE", 'bors 2' )
273
274    $P0 = box "abc"
275    bors $P0, $S2
276    is( $P0, "egc", 'bors_p_s' )
277    is( $S2, "EE", 'bors_p_s' )
278
279    $P0 = box "abc"
280    bors $P0, "EE"
281    is( $P0, "egc", 'bors_p_sc' )
282.end
283
284.sub bors_3
285    set $S1, "abc"
286    set $S2, "EE"
287    bors $S0, $S1, $S2
288    is( $S0, "egc", 'bors 3' )
289    is( $S1, "abc", 'bors 3' )
290    is( $S2, "EE", 'bors 3' )
291
292    set $S0, "abc"
293    bors $S0, "EE", $S0
294    is( $S0, "egc", 'bors_s_sc_s' )
295
296    bors $S0, "abc", "EE"
297    is( $S0, "egc", 'bors_s_sc_sc' )
298
299    new $P0, ['String']
300    box $P1, "abc"
301    set $S0, "EE"
302    bors $P0, $P1, $S0
303    is( $P0, "egc", 'bors_p_p_s' )
304    is( $P1, "abc", 'bors_p_p_s' )
305    is( $S0, "EE", 'bors_p_p_s' )
306
307    set $P0, ""
308    box $P1, "abc"
309    bors $P0, $P1, "EE"
310    is( $P0, "egc", 'bors_p_p_sc' )
311    is( $P1, "abc", 'bors_p_p_sc' )
312.end
313
314.sub bors_cow
315    set $S1, "foo"
316    substr $S2, $S1, 0, 3
317    $S1 = bors $S1, "bar"
318    is( $S2, "foo", 'bors COW' )
319.end
320
321.sub shl_1
322    $P0 = new ['Integer']
323    $P0 = 1
324    $I0 = 1
325    shl $P0, $I0
326    is( $P0, 2, 'shl_p_i' )
327.end
328
329.sub shl_2
330    $P0 = new ['Integer']
331    $P0 = 1
332    shl $P0, 2
333    is( $P0, 4, 'shl_p_ic' )
334
335    $P0 = 1
336
337    $P1 = new ['Integer']
338    $P1 = 2
339    shl $P0, $P1
340    is( $P0, 4, 'shl_p_p' )
341.end
342
343.sub shl_3
344    $P0 = new ['Integer']
345    $P0 = 1
346
347    $P1 = new ['Integer']
348
349    $P1 = shl $P0, 2
350    is( $P1, 4, 'shl_p_p_ic' )
351
352    $I0 = 3
353    $P1 = shl $P0, $I0
354    is( $P1, 8, 'shl_p_p_i' )
355
356    $P2 = new ['Integer']
357    $P2 = 4
358
359    $P1 = shl $P0, $P2
360    is( $P1, 16, 'shl_p_p_p' )
361.end
362
363.sub shr_1
364    $P0 = new ['Integer']
365    $P0 = 16
366    shr $P0, 2
367    is( $P0, 4, 'shr_p_ic' )
368
369    $P0 = 16
370
371    $I0 = 3
372    shr $P0, $I0
373    is( $P0, 2, 'shr_p_i' )
374
375    $P0 = 16
376
377    $P1 = new ['Integer']
378    $P1 = 4
379    shr $P0, $P1
380    is( $P0, 1, 'shr_p_p' )
381.end
382
383.sub shr_2
384    $P0 = new ['Integer']
385    $P0 = 16
386
387    $P1 = new ['Integer']
388
389    $P1 = shr $P0, 2
390    is( $P1, 4, 'shr_p_p_ic' )
391
392    $I0 = 3
393    $P1 = shr $P0, $I0
394    is( $P1, 2, 'shr_p_p_i' )
395
396    $P2 = new ['Integer']
397    $P2 = 4
398
399    $P1 = shr $P0, $P2
400    is( $P1, 1, 'shr_p_p_p' )
401.end
402
403.sub lsr_1
404    $P0 = new ["Integer"]
405    $P1 = new ["Integer"]
406    $I0 = 1
407    $P0 = 4
408    $P1 = 8
409
410    lsr_p_i $P0, $I0
411    is($P0, 2, "lsr_p_i")
412
413    lsr_p_ic $P0, 1
414    is($P0, 1, "lsr_p_ic")
415
416    lsr_p_p $P1, $P0
417    is($P1, 4, "lsr_p_p")
418
419    $I0 = 1
420    lsr_p_p_i $P1, $P1, $I0
421    is($P1, 2, "lsr_p_p_i")
422
423    lsr_p_p_ic $P1, $P1, 1
424    is($P1, 1, "lsr_p_p_ic")
425
426    $P1 = 4
427    lsr_p_p_p $P1, $P1, $P0
428    is($P1, 2, "lsr_p_p_p")
429.end
430
431.sub bxor_1
432    $P0 = box 3
433    $I0 = 3
434    bxor $P0, $I0
435    is( $P0, 0, 'bxor_p_i' )
436
437    $P0 = box 3
438    bxor $P0, 3
439    is( $P0, 0, 'bxor_p_ic' )
440
441    $P0 = box 3
442    bxor $P0, $P0
443    is( $P0, 0, 'bxor_p_p' )
444
445    $P0 = box 3
446    bxor $P0, $P0, $I0
447    is( $P0, 0, 'bxor_p_p_i' )
448
449    $P0 = box 3
450    bxor $P0, $P0, 3
451    is( $P0, 0, 'bxor_p_p_ic' )
452
453    $P0 = box 3
454    bxor $P0, $P0, $P0
455    is( $P0, 0, 'bxor_p_p_p' )
456.end
457
458.sub bxors_null_string
459    null $S1
460    null $S2
461    $S1 = bxors $S1, $S2
462    null $S3
463    is( $S1, $S3, 'bxors NULL string' )
464
465    null $S1
466    set $S2, ""
467    $S1 = bxors $S1, $S2
468    null $S3
469    is( $S1, $S3, 'bxors NULL string' )
470
471    $S2 = bxors $S2, $S1
472    is( $S2, $S3, 'bxors NULL string' )
473
474    null $S1
475    set $S2, "abc"
476    $S1 = bxors $S1, $S2
477    is( $S1, "abc", 'bxors NULL string' )
478
479    null $S2
480    $S1 = bxors $S1, $S2
481    is( $S1, "abc", 'bxors NULL string' )
482
483    null $S1
484    null $S2
485    bxors $S3, $S1, $S2
486    null $S4
487    is( $S3, $S4, 'bxors NULL string' )
488
489    set $S1, ""
490    bxors $S3, $S1, $S2
491    is( $S3, $S4, 'bxors NULL string' )
492
493    bxors $S3, $S2, $S1
494    is( $S3, $S4, 'bxors NULL string' )
495
496    set $S1, "abc"
497    bxors $S3, $S1, $S2
498    is( $S3, "abc", 'bxors NULL string' )
499
500    bxors $S3, $S2, $S1
501    is( $S3, "abc", 'bxors NULL string' )
502.end
503
504.sub bxors_2
505    set $S1, "a2c"
506    set $S2, "Dw"
507    $S1 = bxors $S1, $S2
508    is( $S1, "%Ec", 'bxors 2' )
509    is( $S2, "Dw", 'bxors 2' )
510
511    set $S1, "abc"
512    set $S2, "   X"
513    $S1 = bxors $S1, $S2
514    is( $S1, "ABCX", 'bxors 2' )
515    is( $S2, "   X", 'bxors 2' )
516
517    box $P0, "a2c"
518    set $S0, "Dw"
519    bxors $P0, $S0
520    is( $P0, "%Ec", 'bxors 2' )
521    is( $S0, "Dw", 'bxors 2' )
522
523    box $P0, "a2c"
524    bxors $P0, "Dw"
525    is( $P0, "%Ec", 'bxors 2' )
526.end
527
528.sub bxors_3
529    set $S1, "a2c"
530    set $S2, "Dw"
531    bxors $S0, $S1, $S2
532    is( $S0, "%Ec", 'bxors 3' )
533    is( $S1, "a2c", 'bxors 3' )
534    is( $S2, "Dw", 'bxors 3' )
535
536    set $S1, "abc"
537    set $S2, "   Y"
538    bxors $S0, $S1, $S2
539    is( $S0, "ABCY", 'bxors 3' )
540    is( $S1, "abc", 'bxors 3' )
541    is( $S2, "   Y", 'bxors 3' )
542
543    set $S0, "abc"
544    bxors $S0, "   Y", $S0
545    is( $S0, "ABCY", 'bxors 3' )
546
547    bxors $S0, "abc", "   Y"
548    is( $S0, "ABCY", 'bxors 3' )
549
550    box $P0, "abc"
551    set $S0, "   Y"
552    bxors $P0, $P0, $S0
553    is( $P0, "ABCY", 'bxors 3' )
554    is( $S0, "   Y", 'bxors 3' )
555
556    box $P0, "abc"
557    bxors $P0, $P0, "   Y"
558    is( $P0, "ABCY", 'bxors 3' )
559.end
560
561.sub bxors_cow
562    set $S1, "foo"
563    substr $S2, $S1, 0, 3
564    $S1 = bxors $S1, "bar"
565    is( $S2, "foo", 'bxors COW' )
566.end
567
568.sub bnot_1
569    $I0 = 10
570    bnot $I0
571    is($I0, -11, "bnot_i")
572
573    $I0 = bnot 11
574    is($I0, -12, "bnot_i_ic")
575
576    $P0 = new ["Integer"]
577    $P0 = 12
578    bnot $P0
579    is($P0, -13, "bnot_p")
580.end
581
582.sub bnots_null_string
583    null $S1
584    null $S2
585    bnots $S1, $S2
586    null $S3
587    is( $S1, $S3, 'bnots NULL string' )
588
589    null $S1
590    set $S2, ""
591    bnots $S1, $S2
592    null $S3
593    is( $S1, $S3, 'bnots NULL string' )
594
595    bnots $S2, $S1
596    is( $S2, $S3, 'bnots NULL string' )
597.end
598
599# This was the previous test used for t/native_pbc/string.t
600.sub bnots_2
601    skip( 4, "No unicode yet" )
602    # getstdout $P0
603    # push $P0, "utf8"
604    # set $S1, "a2c"
605    # bnots $S2, $S1
606    # is( $S1, "a2c", 'bnots 2' )
607    # is( $S2, "\xC2\x9E\xC3\x8D\xC2\x9C", 'bnots 2' )
608    #
609    # bnots $S1, $S1
610    # is( $S1, "\xC2\x9E\xC3\x8D\xC2\x9C", 'bnots 2' )
611    #
612    # bnots $S1, $S1
613    # is( $S1, "a2c", 'bnots 2' )
614.end
615
616.sub bnots_cow
617    set $S1, "foo"
618    substr $S2, $S1, 0, 3
619    bnots $S1, $S1
620    is( $S2, "foo", 'bnots COW' )
621.end
622
623.sub rot_1
624    # Test basic rotation, really just a shift
625    $I0 = 0
626    $I1 = 10 # 10 rot 1 should be 20 (just a shift)
627    $I2 = 1
628    rot_i_i_i_ic $I0, $I1, $I2, 32
629    is ($I0, 20, "rot_i_i_i_ic")
630
631    # Reverse the rotation, shift the other way
632    $I2 = -1
633    rot_i_i_i_ic $I0, $I0, $I2, 32
634    is ($I0, 10, "rot_i_i_i_ic reverse")
635
636    $I0 = 0
637    $I1 = -1
638    rot_i_ic_i_ic $I0, 20, $I1, 32
639    is ($I0, 10, "rot_i_ic_i_ic")
640
641    $I0 = 0
642    rot_i_ic_ic_ic $I0, 20, 1, 32
643    is ($I0, 40, "rot_i_ic_ic_ic")
644
645    rot_i_ic_ic_ic $I0, 27, -3, 32
646    is($I0, 1610612739, "rot_i_ic_ic_ic")
647.end
648
649# Local Variables:
650#   mode: pir
651#   fill-column: 100
652# End:
653# vim: expandtab shiftwidth=4 ft=pir:
654