t/dynoplibs/bit.t

   1 #!./parrot
   2 # Copyright (C) 2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/dynoplibs/bit.t - Bitwise Dynops
   8
   9 =head1 SYNOPSIS
  10
  11         % prove t/dynoplibs/bit.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests basic arithmetic on various combinations of Parrot integer and
  16 number types.
  17
  18 =cut
  19
  20 .loadlib 'bit_ops'
  21
  22 .sub main :main
  23     .include 'test_more.pir'
  24
  25     plan(56)
  26
  27     bnot_p_p_creates_destination()
  28     bands_null_string()
  29     bands_2()
  30     bands_3()
  31     bands_cow()
  32     bors_null_string()
  33     bors_2()
  34     bors_3()
  35     bors_cow()
  36     bxors_null_string()
  37     bxors_2()
  38     bxors_3()
  39     bxors_cow()
  40     bnots_null_string()
  41     bnots_2()
  42     bnots_cow()
  43     # END_OF_TESTS
  44
  45 .end
  46
  47 .sub 'bnot_p_p_creates_destination'
  48     $P0 = box 3
  49     $P1 = bnot $P0
  50     is( $P1, -4, 'bnot_p_p_creates_destination')
  51 .end
  52
  53 .sub bands_null_string
  54     null $S1
  55     set $S2, "abc"
  56     $S1 = bands $S1, $S2
  57     null $S3
  58     is( $S1, $S3, 'ok1' )
  59
  60     set $S1, ""
  61     $S1 = bands $S1, $S2
  62     nok( $S1, 'ok2' )
  63
  64     null $S2
  65     set $S1, "abc"
  66     $S1 = bands $S1, $S2
  67     null $S3
  68     is( $S1, $S3, 'ok3' )
  69
  70     set $S2, ""
  71     $S1 = bands $S1, $S2
  72     nok( $S1, 'ok4' )
  73 .end
  74
  75 .sub bands_2
  76     set $S1, "abc"
  77     set $S2, "EE"
  78     $S1 = bands $S1, $S2
  79     is( $S1, "A@", 'bands 2' )
  80     is( $S2, "EE", 'bands 2' )
  81 .end
  82
  83 .sub bands_3
  84     set $S1, "abc"
  85     set $S2, "EE"
  86     bands $S0, $S1, $S2
  87     is( $S0, "A@", 'bands 3' )
  88     is( $S1, "abc", 'bands 3' )
  89     is( $S2, "EE", 'bands 3' )
  90 .end
  91
  92 .sub bands_cow
  93     set $S1, "foo"
  94     substr $S2, $S1, 0, 3
  95     $S1 = bands $S1, "bar"
  96     is( $S2, "foo", 'bands COW' )
  97 .end
  98
  99 .sub bors_null_string
 100     null $S1
 101     null $S2
 102     $S1 = bors $S1, $S2
 103     null $S3
 104     is( $S1, $S3, 'bors NULL string' )
 105
 106     null $S1
 107     set $S2, ""
 108     $S1 = bors $S1, $S2
 109     null $S3
 110     is( $S1, $S3, 'bors NULL string' )
 111
 112     $S2 = bors $S2, $S1
 113     is( $S2, $S3, 'bors NULL string' )
 114
 115     null $S1
 116     set $S2, "def"
 117     $S1 = bors $S1, $S2
 118     is( $S1, "def", 'bors NULL string' )
 119
 120     null $S2
 121     $S1 = bors $S1, $S2
 122     is( $S1, "def", 'bors NULL string' )
 123
 124     null $S1
 125     null $S2
 126     bors $S3, $S1, $S2
 127     null $S4
 128     is( $S3, $S4, 'bors NULL string' )
 129
 130     set $S1, ""
 131     bors $S3, $S1, $S2
 132     is( $S3, $S4, 'bors NULL string' )
 133
 134     bors $S3, $S2, $S1
 135     is( $S3, $S4, 'bors NULL string' )
 136
 137     set $S1, "def"
 138     bors $S3, $S1, $S2
 139     is( $S3, "def", 'bors NULL string' )
 140
 141     bors $S3, $S2, $S1
 142     is( $S3, "def", 'bors NULL string' )
 143 .end
 144
 145 .sub bors_2
 146     set $S1, "abc"
 147     set $S2, "EE"
 148     $S1 = bors $S1, $S2
 149     is( $S1, "egc", 'bors 2' )
 150     is( $S2, "EE", 'bors 2' )
 151 .end
 152
 153 .sub bors_3
 154     set $S1, "abc"
 155     set $S2, "EE"
 156     bors $S0, $S1, $S2
 157     is( $S0, "egc", 'bors 3' )
 158     is( $S1, "abc", 'bors 3' )
 159     is( $S2, "EE", 'bors 3' )
 160 .end
 161
 162 .sub bors_cow
 163     set $S1, "foo"
 164     substr $S2, $S1, 0, 3
 165     $S1 = bors $S1, "bar"
 166     is( $S2, "foo", 'bors COW' )
 167 .end
 168
 169 .sub bxors_null_string
 170     null $S1
 171     null $S2
 172     $S1 = bxors $S1, $S2
 173     null $S3
 174     is( $S1, $S3, 'bxors NULL string' )
 175
 176     null $S1
 177     set $S2, ""
 178     $S1 = bxors $S1, $S2
 179     null $S3
 180     is( $S1, $S3, 'bxors NULL string' )
 181
 182     $S2 = bxors $S2, $S1
 183     is( $S2, $S3, 'bxors NULL string' )
 184
 185     null $S1
 186     set $S2, "abc"
 187     $S1 = bxors $S1, $S2
 188     is( $S1, "abc", 'bxors NULL string' )
 189
 190     null $S2
 191     $S1 = bxors $S1, $S2
 192     is( $S1, "abc", 'bxors NULL string' )
 193
 194     null $S1
 195     null $S2
 196     bxors $S3, $S1, $S2
 197     null $S4
 198     is( $S3, $S4, 'bxors NULL string' )
 199
 200     set $S1, ""
 201     bxors $S3, $S1, $S2
 202     is( $S3, $S4, 'bxors NULL string' )
 203
 204     bxors $S3, $S2, $S1
 205     is( $S3, $S4, 'bxors NULL string' )
 206
 207     set $S1, "abc"
 208     bxors $S3, $S1, $S2
 209     is( $S3, "abc", 'bxors NULL string' )
 210
 211     bxors $S3, $S2, $S1
 212     is( $S3, "abc", 'bxors NULL string' )
 213 .end
 214
 215 .sub bxors_2
 216     set $S1, "a2c"
 217     set $S2, "Dw"
 218     $S1 = bxors $S1, $S2
 219     is( $S1, "%Ec", 'bxors 2' )
 220     is( $S2, "Dw", 'bxors 2' )
 221
 222     set $S1, "abc"
 223     set $S2, "   X"
 224     $S1 = bxors $S1, $S2
 225     is( $S1, "ABCX", 'bxors 2' )
 226     is( $S2, "   X", 'bxors 2' )
 227 .end
 228
 229 .sub bxors_3
 230     set $S1, "a2c"
 231     set $S2, "Dw"
 232     bxors $S0, $S1, $S2
 233     is( $S0, "%Ec", 'bxors 3' )
 234     is( $S1, "a2c", 'bxors 3' )
 235     is( $S2, "Dw", 'bxors 3' )
 236
 237     set $S1, "abc"
 238     set $S2, "   Y"
 239     bxors $S0, $S1, $S2
 240     is( $S0, "ABCY", 'bxors 3' )
 241     is( $S1, "abc", 'bxors 3' )
 242     is( $S2, "   Y", 'bxors 3' )
 243 .end
 244
 245 .sub bxors_cow
 246     set $S1, "foo"
 247     substr $S2, $S1, 0, 3
 248     $S1 = bxors $S1, "bar"
 249     is( $S2, "foo", 'bxors COW' )
 250 .end
 251
 252 .sub bnots_null_string
 253     null $S1
 254     null $S2
 255     bnots $S1, $S2
 256     null $S3
 257     is( $S1, $S3, 'bnots NULL string' )
 258
 259     null $S1
 260     set $S2, ""
 261     bnots $S1, $S2
 262     null $S3
 263     is( $S1, $S3, 'bnots NULL string' )
 264
 265     bnots $S2, $S1
 266     is( $S2, $S3, 'bnots NULL string' )
 267 .end
 268
 269 # This was the previous test used for t/native_pbc/string.t
 270 .sub bnots_2
 271     skip( 4, "No unicode yet" )
 272     # getstdout $P0
 273     # push $P0, "utf8"
 274     # set $S1, "a2c"
 275     # bnots $S2, $S1
 276     # is( $S1, "a2c", 'bnots 2' )
 277     # is( $S2, "\xC2\x9E\xC3\x8D\xC2\x9C", 'bnots 2' )
 278     #
 279     # bnots $S1, $S1
 280     # is( $S1, "\xC2\x9E\xC3\x8D\xC2\x9C", 'bnots 2' )
 281     #
 282     # bnots $S1, $S1
 283     # is( $S1, "a2c", 'bnots 2' )
 284 .end
 285
 286 .sub bnots_cow
 287     set $S1, "foo"
 288     substr $S2, $S1, 0, 3
 289     bnots $S1, $S1
 290     is( $S2, "foo", 'bnots COW' )
 291 .end
 292
 293 # Local Variables:
 294 #   mode: pir
 295 #   fill-column: 100
 296 # End:
 297 # vim: expandtab shiftwidth=4 ft=pir: