t/spec/S03-metaops/hyper.t

   1 use v6;
   2
   3 use Test;
   4
   5 =begin pod
   6
   7  Hyper operators L<S03/"Hyper operators">
   8
   9 =end pod
  10
  11 plan *;
  12
  13 # L<S03/Hyper operators>
  14  # binary infix
  15 my @r;
  16 my @e;
  17 {
  18         @r = (1, 2, 3) »+« (2, 4, 6);
  19         @e = (3, 6, 9);
  20         is(~@r, ~@e, "hyper-sum two arrays");
  21
  22         @r = (1, 2, 3) »-« (2, 4, 6);
  23         @e = (-1, -2, -3);
  24         is(~@r, ~@e, "hyper-subtract two arrays");
  25
  26         @r = (1, 2, 3) »*« (2, 4, 6);
  27         @e = (2, 8, 18);
  28         is(~@r, ~@e, "hyper-multiply two arrays");
  29
  30         @r = (1, 2, 3) »x« (3, 2, 1);
  31         @e = ('111', '22', '3');
  32         is(~@r, ~@e, "hyper-x two arrays");
  33
  34         @r = (1, 2, 3) »xx« (3, 2, 1);
  35         @e = ((1,1,1), (2,2), (3));
  36         is(~@r, ~@e, "hyper-xx two arrays");
  37
  38         @r = (20, 40, 60) »div« (2, 5, 10);
  39         @e = (10, 8, 6);
  40         is(~@r, ~@e, "hyper-divide two arrays");
  41
  42         @r = (1, 2, 3) »+« (10, 20, 30) »*« (2, 3, 4);
  43         @e = (21, 62, 123);
  44         is(~@r, ~@e, "precedence - »+« vs »*«");
  45 }
  46
  47 {
  48         @r = (1, 2, 3) >>+<< (2, 4, 6);
  49         @e = (3, 6, 9);
  50         is(~@r, ~@e, "hyper-sum two arrays ASCII notation");
  51
  52         @r = (1, 2, 3) >>-<< (2, 4, 6);
  53         @e = (-1, -2, -3);
  54         is(~@r, ~@e, "hyper-subtract two arrays ASCII notation");
  55
  56         @r = (1, 2, 3) >>*<< (2, 4, 6);
  57         @e = (2, 8, 18);
  58         is(~@r, ~@e, "hyper-multiply two arrays ASCII notation");
  59
  60         @r = (1, 2, 3) >>x<< (3, 2, 1);
  61         @e = ('111', '22', '3');
  62         is(~@r, ~@e, "hyper-x two arrays ASCII notation");
  63
  64         @r = (1, 2, 3) >>xx<< (3, 2, 1);
  65         @e = ((1,1,1), (2,2), (3));
  66         is(~@r, ~@e, "hyper-xx two arrays ASCII notation");
  67
  68         @r = (20, 40, 60) >>div<< (2, 5, 10);
  69         @e = (10, 8, 6);
  70         is(~@r, ~@e, "hyper-divide two arrays ASCII notation");
  71
  72         @r = (1, 2, 3) >>+<< (10, 20, 30) >>*<< (2, 3, 4);
  73         @e = (21, 62, 123);
  74         is(~@r, ~@e, "precedence - >>+<< vs >>*<< ASCII notation");
  75 };
  76
  77 { # unary postfix
  78         my @r = (1, 2, 3);
  79         @r»++;
  80         my @e = (2, 3, 4);
  81         #?pugs todo
  82         is(~@r, ~@e, "hyper auto increment an array");
  83
  84         @r = (1, 2, 3);
  85         @r>>++;
  86         @e = (2, 3, 4);
  87         #?pugs todo
  88         is(~@r, ~@e, "hyper auto increment an array ASCII notation");
  89 };
  90
  91 { # unary prefix
  92         my @r;
  93         @r = -« (3, 2, 1);
  94         my @e = (-3, -2, -1);
  95         is(~@r, ~@e, "hyper op on assignment/pipeline");
  96
  97         @r = -<< (3, 2, 1);
  98         @e = (-3, -2, -1);
  99         is(~@r, ~@e, "hyper op on assignment/pipeline ASCII notation");
 100 };
 101
 102 { # dimension upgrade - ASCII
 103         my @r;
 104         @r = (1, 2, 3) >>+>> 1;
 105         my @e = (2, 3, 4);
 106         is(~@r, ~@e, "auto dimension upgrade on rhs ASCII notation");
 107
 108         @r = 2 <<*<< (10, 20, 30);
 109         @e = (20, 40, 60);
 110         is(~@r, ~@e, "auto dimension upgrade on lhs ASCII notation");
 111 }
 112
 113 { # extension
 114         @r = (1,2,3,4) >>~>> <A B C D E>;
 115         @e = <1A 2B 3C 4D>;
 116         is(~@r, ~@e, "list-level element truncate on rhs ASCII notation");
 117
 118         @r = (1,2,3,4,5) <<~<< <A B C D>;
 119         @e =  <1A 2B 3C 4D>;
 120         is(~@r, ~@e, "list-level element truncate on lhs ASCII notation");
 121
 122         @r = (1,2,3,4) >>~>> <A B C>;
 123         @e = <1A 2B 3C 4A>;
 124         is(~@r, ~@e, "list-level element extension on rhs ASCII notation");
 125
 126         @r = (1,2,3) <<~<< <A B C D>;
 127         @e =  <1A 2B 3C 1D>;
 128         is(~@r, ~@e, "list-level element extension on lhs ASCII notation");
 129
 130         @r = (1,2,3,4) >>~>> <A B>;
 131         @e = <1A 2B 3A 4B>;
 132         is(~@r, ~@e, "list-level element extension on rhs ASCII notation");
 133
 134         @r = (1,2) <<~<< <A B C D>;
 135         @e =  <1A 2B 1C 2D>;
 136         is(~@r, ~@e, "list-level element extension on lhs ASCII notation");
 137
 138         @r = (1,2,3,4) >>~>> <A>;
 139         @e = <1A 2A 3A 4A>;
 140         is(~@r, ~@e, "list-level element extension on rhs ASCII notation");
 141
 142         @r = (1,) <<~<< <A B C D>;
 143         @e = <1A 1B 1C 1D>;
 144         is(~@r, ~@e, "list-level element extension on lhs ASCII notation");
 145
 146         @r = (1,2,3,4) >>~>> 'A';
 147         @e = <1A 2A 3A 4A>;
 148         is(~@r, ~@e, "scalar element extension on rhs ASCII notation");
 149
 150         @r = 1 <<~<< <A B C D>;
 151         @e = <1A 1B 1C 1D>;
 152         is(~@r, ~@e, "scalar element extension on lhs ASCII notation");
 153 };
 154
 155 { # dimension upgrade - unicode
 156         @r = (1,2,3,4) »~» <A B C D E>;
 157         @e = <1A 2B 3C 4D>;
 158         is(~@r, ~@e, "list-level element truncate on rhs unicode notation");
 159
 160         @r = (1,2,3,4,5) «~« <A B C D>;
 161         @e =  <1A 2B 3C 4D>;
 162         is(~@r, ~@e, "list-level element truncate on lhs unicode notation");
 163
 164         @r = (1,2,3,4) »~» <A B C>;
 165         @e = <1A 2B 3C 4A>;
 166         is(~@r, ~@e, "list-level element extension on rhs unicode notation");
 167
 168         @r = (1,2,3) «~« <A B C D>;
 169         @e =  <1A 2B 3C 1D>;
 170         is(~@r, ~@e, "list-level element extension on lhs unicode notation");
 171
 172         @r = (1,2,3,4) »~» <A B>;
 173         @e = <1A 2B 3A 4B>;
 174         is(~@r, ~@e, "list-level element extension on rhs unicode notation");
 175
 176         @r = (1,2) «~« <A B C D>;
 177         @e =  <1A 2B 1C 2D>;
 178         is(~@r, ~@e, "list-level element extension on lhs unicode notation");
 179
 180         @r = (1,2,3,4) »~» <A>;
 181         @e = <1A 2A 3A 4A>;
 182         is(~@r, ~@e, "list-level element extension on rhs unicode notation");
 183
 184         @r = (1,) «~« <A B C D>;
 185         @e = <1A 1B 1C 1D>;
 186         is(~@r, ~@e, "list-level element extension on lhs unicode notation");
 187
 188         @r = (1,2,3,4) »~» 'A';
 189         @e = <1A 2A 3A 4A>;
 190         is(~@r, ~@e, "scalar element extension on rhs unicode notation");
 191
 192         @r = 1 «~« <A B C D>;
 193         @e = <1A 1B 1C 1D>;
 194         is(~@r, ~@e, "scalar element extension on lhs unicode notation");
 195 };
 196
 197 { # unary postfix with integers
 198         my @r;
 199         @r = (1, 4, 9)».sqrt;
 200         my @e = (1, 2, 3);
 201         is(~@r, ~@e, "method call on integer list elements");
 202
 203         @r = (1, 4, 9)>>.sqrt;
 204         @e = (1, 2, 3);
 205         is(~@r, ~@e, "method call on integer list elements (ASCII)");
 206 }
 207
 208 #?rakudo skip '@array»++'
 209 {
 210         my (@r, @e);
 211         (@r = (1, 4, 9))»++;
 212         @e = (2, 5, 10);
 213         is(~@r, ~@e, "operator call on integer list elements");
 214
 215         (@r = (1, 4, 9)).»++;
 216         is(~@r, ~@e, "operator call on integer list elements (Same thing, dot form)");
 217
 218         (@r = (1, 4, 9))».++;
 219         @e = (2, 5, 9);
 220         is(~@r, ~@e, "operator call on integer list elements (Same thing, dot form)");
 221
 222         (@r = (1, 4, 9)).».++;
 223         is(~@r, ~@e, "operator call on integer list elements (Same thing, dot form)");
 224
 225         (@r = (1, 4, 9))\  .»\  .++;
 226         @e = (2, 5, 9);
 227         is(~@r, ~@e, "operator call on integer list elements (Same thing, upspace form)");
 228 };
 229
 230 { # unary postfix again, but with a twist
 231         my @r;
 232         eval '@r = ("f", "oo", "bar")».chars';
 233         my @e = (1, 2, 3);
 234         is(~@r, ~@e, "method call on list elements");
 235
 236         eval '@r = ("f", "oo", "bar").».chars';
 237         @e = (1, 2, 3);
 238         is(~@r, ~@e, "method call on list elements (Same thing, dot form)");
 239
 240
 241         eval '@r = ("f", "oo", "bar")>>.chars';
 242         @e = (1, 2, 3);
 243         is(~@r, ~@e, "method call on list elements (ASCII)");
 244
 245         eval '@r = ("f", "oo", "bar").>>.chars';
 246         @e = (1, 2, 3);
 247         is(~@r, ~@e, "method call on list elements (ASCII, Same thing, dot form)");
 248
 249 };
 250
 251 { # unary postfix on a user-defined object
 252         my $t;
 253         class FooTest { method bar { 42 } }; $t = FooTest.new.bar;
 254         is($t, 42, 'plain method call works OK');
 255
 256         my @r;
 257         class FooTest2 { method bar { 42 } }; @r = (FooTest2.new)>>.bar;
 258         my @e = (42);
 259         is(~@r, ~@e, "hyper-method-call on list of user-defined objects");
 260 };
 261
 262 { # distribution for unary prefix
 263         my @r;
 264         @r = -« ([1, 2], [3, [4, 5]]);
 265         my @e = ([-1, -2], [-3, [-4, -5]]);
 266         is(~@r, ~@e, "distribution for unary prefix");
 267         is_deeply(@r, @e, "distribution for unary prefix, deep comparison");
 268
 269         @r = -<< ([1, 2], [3, [4, 5]]);
 270         @e = ([-1, -2], [-3, [-4, -5]]);
 271         is(~@r, ~@e, "distribution for unary prefix, ASCII");
 272         is_deeply(@r, @e, "distribution for unary prefix, ASCII, deep comparison");
 273 };
 274
 275 { # distribution for unary postfix autoincrement
 276         my @r;
 277         @r = ([1, 2], [3, [4, 5]]);
 278         @r»++;
 279         my @e = ([2, 3], [4, [5, 6]]);
 280         #?pugs todo
 281         is(~@r, ~@e, "distribution for unary postfix autoincr");
 282         is_deeply(@r, @e, "distribution for unary postfix autoincr, deep comparison");
 283
 284         @r = ([1, 2], [3, [4, 5]]);
 285         @r>>++;
 286         @e = ([2, 3], [4, [5, 6]]);
 287         #?pugs todo
 288         is(~@r, ~@e, "distribution for unary postfix autoincr, ASCII");
 289         is_deeply(@r, @e, "distribution for unary postfix autoincr, ASCII, deep comparison");
 290 };
 291
 292 #?DOES 3
 293 { # distribution for binary infix - ASCII
 294         my @r;
 295         @r = (1, 2, [3, 4]) >>+<< (4, 5, [6, 7]);
 296         my @e = (5, 7, [9, 11]);
 297         is(~@r, ~@e, "distribution for binary infix, same shape, ASCII");
 298         is_deeply(@r, @e, "distribution for binary infix, same shape, ASCII, deep comparision");
 299
 300         @r = (1, 2, [3, 4]) >>+>> (5, 6, 7);
 301         @e = (6, 8, [10, 11]);
 302         is(~@r, ~@e, "distribution for binary infix, dimension upgrade, ASCII");
 303         is_deeply(@r, @e, "distribution for binary infix, dimension upgrade, ASCII, deep comparison");
 304
 305         @r = ([1, 2], 3) <<+>> (4, [5, 6]);
 306         @e = ([5, 6], [8, 9]);
 307         is(~@r, ~@e, "distribution for binary infix, S03 cross-upgrade, ASCII");
 308         is_deeply(@r, @e, "distribution for binary infix, S03 cross-upgrade, ASCII, deep comparison");
 309 };
 310
 311 #?DOES 3
 312 { # distribution for binary infix - unicode
 313         my @r;
 314         @r = (1, 2, [3, 4]) »+« (4, 5, [6, 7]);
 315         my @e = (5, 7, [9, 11]);
 316         is(~@r, ~@e, "distribution for binary infix, same shape");
 317         is_deeply(@r, @e, "distribution for binary infix, same shape, deep comparison");
 318
 319         @r = (1, 2, [3, 4]) »+» (5, 6, 7);
 320         @e = (6, 8, [10, 11]);
 321         is(~@r, ~@e, "distribution for binary infix, dimension upgrade");
 322         is_deeply(@r, @e, "distribution for binary infix, dimension upgrade, deep comparison");
 323
 324         @r = ([1, 2], 3) «+» (4, [5, 6]);
 325         @e = ([5, 6], [8, 9]);
 326         is(~@r, ~@e, "distribution for binary infix, S03 cross-upgrade");
 327         is_deeply(@r, @e, "distribution for binary infix, S03 cross-upgrade, deep comparison");
 328 };
 329
 330 { # regression test, ensure that hyper works on arrays
 331         my @r1;
 332         my @r2;
 333         my @e1 = (2, 4, 6);
 334         my @a = (1, 2, 3);
 335         @r1 = @a >>+<< @a;
 336         is(~@r1, ~@e1, "hyper op works on variables, too.");
 337 }
 338 {
 339         my @a = (1, 2, 3);
 340         my @e2 = (2, 3, 4);
 341         my @r2 = @a >>+>> 1;
 342         is(~@r2, ~@e2, "hyper op and correctly promotes scalars");
 343 };
 344
 345
 346 # mixed hyper and reduce metaops -
 347 # this unveils a spec bug as << recurses into arrays and [+] never gets applied,
 348 # so we disable the entire chunk for now.
 349 =begin todo unspecced
 350
 351     is ~([+]<< ([1,2,3], [4,5,6])), "6 15", "mixed hyper and reduce metaop ([+]<<) works";
 352     ## XXX: Test for [+]<<<< - This is unspecced, commenting it out
 353     #is ~([+]<<<< ([[1,2],[3,4]],[[5,6],[7,8]])), "3 7 11 15",
 354     #  "mixed double hyper and reduce metaop ([+]<<<<) works";
 355
 356     is ~([+]« [1,2,3], [4,5,6]), "6 15",
 357       "mixed Unicode hyper and reduce metaop ([+]«) works";
 358
 359 =end todo unspecced
 360
 361 #?pugs todo 'hyper ops'
 362 { # hyper dereferencing
 363     my @array = (
 364         { key => 'val' },
 365         { key => 'val' },
 366         { key => 'val' }
 367     );
 368
 369     my $full = join '', eval '@array>>.<key>';
 370     is($full, 'valvalval', 'hyper-dereference an array');
 371
 372     my $part = join '', eval '@array[0,1]>>.<key>';
 373     is($part, 'valval', 'hyper-dereference an array slice');
 374 }
 375
 376 #?pugs todo 'feature'
 377 { # junction hyper -- regression?
 378     my @a = 1..3;
 379     my @b = 4..6;
 380     ok ?(@a »|« @b), '»|« hyperjunction evals';
 381     ok ?(@a >>|<< @b), '>>|<< hyperjunction evals, ASCII';
 382     ok ?(@a »&« @b), '»&« hyperjunction evals';
 383     ok ?(@a >>&<< @b), '>>&<< hyperjunction evals, ASCII';
 384 }
 385
 386 # test hypers on hashes
 387 {
 388     my %a = a => 1, b => 2, c => 3;
 389     my %b = a => 5, b => 6, c => 7;
 390     my %c = a => 1, b => 2;
 391     my %d = a => 5, b => 6;
 392
 393     my %r;
 394     %r = %a >>+<< %b;
 395     is +%r,   3,  'hash - >>+<< result has right number of keys (same keys)';
 396     is %r<a>, 6,  'hash - correct result form >>+<< (same keys)';
 397     is %r<b>, 8,  'hash - correct result form >>+<< (same keys)';
 398     is %r<c>, 10, 'hash - correct result form >>+<< (same keys)';
 399
 400     %r = %a »+« %d;
 401     is +%r,   3, 'hash - »+« result has right number of keys (union test)';
 402     is %r<a>, 6, 'hash - correct result form »+« (union test)';
 403     is %r<b>, 8, 'hash - correct result form »+« (union test)';
 404     is %r<c>, 3, 'hash - correct result form »+« (union test)';
 405
 406     %r = %c >>+<< %b;
 407     is +%r,   3, 'hash - >>+<< result has right number of keys (union test)';
 408     is %r<a>, 6, 'hash - correct result form >>+<< (union test)';
 409     is %r<b>, 8, 'hash - correct result form >>+<< (union test)';
 410     is %r<c>, 7, 'hash - correct result form >>+<< (union test)';
 411
 412     %r = %a <<+>> %b;
 413     is +%r,   3,  'hash - <<+>> result has right number of keys (same keys)';
 414     is %r<a>, 6,  'hash - correct result form <<+>> (same keys)';
 415     is %r<b>, 8,  'hash - correct result form <<+>> (same keys)';
 416     is %r<c>, 10, 'hash - correct result form <<+>> (same keys)';
 417
 418     %r = %a <<+>> %d;
 419     is +%r,   2, 'hash - <<+>> result has right number of keys (intersection test)';
 420     is %r<a>, 6, 'hash - correct result form <<+>> (intersection test)';
 421     is %r<b>, 8, 'hash - correct result form <<+>> (intersection test)';
 422
 423     %r = %c <<+>> %b;
 424     is +%r,   2, 'hash - <<+>> result has right number of keys (intersection test)';
 425     is %r<a>, 6, 'hash - correct result form <<+>> (intersection test)';
 426     is %r<b>, 8, 'hash - correct result form <<+>> (intersection test)';
 427
 428     %r = %a >>+>> %c;
 429     is +%r,   3, 'hash - >>+>> result has right number of keys';
 430     is %r<a>, 2, 'hash - correct result from >>+>>';
 431     is %r<b>, 4, 'hash - correct result from >>+>>';
 432     is %r<c>, 3, 'hash - correct result from >>+>>';
 433
 434     %r = %c >>+>> %b;
 435     is +%r,   2, 'hash - >>+>> result has right number of keys';
 436     is %r<a>, 6, 'hash - correct result from >>+>>';
 437     is %r<b>, 8, 'hash - correct result from >>+>>';
 438
 439     %r = %c <<+<< %a;
 440     is +%r,   3, 'hash - <<+<< result has right number of keys';
 441     is %r<a>, 2, 'hash - correct result from <<+<<';
 442     is %r<b>, 4, 'hash - correct result from <<+<<';
 443     is %r<c>, 3, 'hash - correct result from <<+<<';
 444
 445     %r = %b <<+<< %c;
 446     is +%r,   2, 'hash - <<+<< result has right number of keys';
 447     is %r<a>, 6, 'hash - correct result from <<+<<';
 448     is %r<b>, 8, 'hash - correct result from <<+<<';
 449 }
 450
 451 {
 452     my %a = a => 1, b => 2, c => 3;
 453     my %r = -<<%a;
 454     is +%r,   3, 'hash - -<< result has right number of keys';
 455     is %r<a>, -1, 'hash - correct result from -<<';
 456     is %r<b>, -2, 'hash - correct result from -<<';
 457     is %r<c>, -3, 'hash - correct result from -<<';
 458
 459     %r = --<<%a;
 460     is +%r,   3, 'hash - --<< result has right number of keys';
 461     is %r<a>, 0, 'hash - correct result from --<<';
 462     is %r<b>, 1, 'hash - correct result from --<<';
 463     is %r<c>, 2, 'hash - correct result from --<<';
 464     is +%a,   3, 'hash - --<< result has right number of keys';
 465     is %a<a>, 0, 'hash - correct result from --<<';
 466     is %a<b>, 1, 'hash - correct result from --<<';
 467     is %a<c>, 2, 'hash - correct result from --<<';
 468
 469     %r = %a>>++;
 470     is +%r,   3, 'hash - >>++ result has right number of keys';
 471     is %r<a>, 0, 'hash - correct result from >>++';
 472     is %r<b>, 1, 'hash - correct result from >>++';
 473     is %r<c>, 2, 'hash - correct result from >>++';
 474     is +%a,   3, 'hash - >>++ result has right number of keys';
 475     is %a<a>, 1, 'hash - correct result from >>++';
 476     is %a<b>, 2, 'hash - correct result from >>++';
 477     is %a<c>, 3, 'hash - correct result from >>++';
 478 }
 479
 480 {
 481     our sub postfix:<!>($a) {
 482         [*] 1..$a;
 483     }
 484
 485     my %a = a => 1, b => 2, c => 3;
 486     my %r = %a>>!;
 487     is +%r,   3, 'hash - >>! result has right number of keys';
 488     is %r<a>, 1, 'hash - correct result from >>!';
 489     is %r<b>, 2, 'hash - correct result from >>!';
 490     is %r<c>, 6, 'hash - correct result from >>!';
 491 }
 492
 493 {
 494     my %a = a => 1, b => 2, c => 3;
 495
 496     my %r = %a >>*>> 4;
 497     is +%r,   3, 'hash - >>*>> result has right number of keys';
 498     is %r<a>, 4, 'hash - correct result from >>*>>';
 499     is %r<b>, 8, 'hash - correct result from >>*>>';
 500     is %r<c>, 12, 'hash - correct result from >>*>>';
 501
 502     %r = 2 <<**<< %a ;
 503     is +%r,   3, 'hash - <<**<< result has right number of keys';
 504     is %r<a>, 2, 'hash - correct result from <<**<<';
 505     is %r<b>, 4, 'hash - correct result from <<**<<';
 506     is %r<c>, 8, 'hash - correct result from <<**<<';
 507
 508     %r = %a <<*>> 4;
 509     is +%r,   3, 'hash - <<*>> result has right number of keys';
 510     is %r<a>, 4, 'hash - correct result from <<*>>';
 511     is %r<b>, 8, 'hash - correct result from <<*>>';
 512     is %r<c>, 12, 'hash - correct result from <<*>>';
 513
 514     %r = 2 <<**>> %a ;
 515     is +%r,   3, 'hash - <<**>> result has right number of keys';
 516     is %r<a>, 2, 'hash - correct result from <<**>>';
 517     is %r<b>, 4, 'hash - correct result from <<**>>';
 518     is %r<c>, 8, 'hash - correct result from <<**>>';
 519 }
 520
 521 #?rakudo skip '>>. NYI on hashes'
 522 {
 523     my %a = a => 1, b => -2, c => 3;
 524     my %r = %a>>.abs;
 525     is +%r,   3, 'hash - >>.abs result has right number of keys';
 526     is %r<a>, 1, 'hash - correct result from >>.abs';
 527     is %r<b>, 2, 'hash - correct result from >>.abs';
 528     is %r<c>, 3, 'hash - correct result from >>.abs';
 529 }
 530
 531 {
 532     my @a = (1, { a => 2, b => 3 }, 4);
 533     my @b = <a b c>;
 534     my @c = ('z', { a => 'y', b => 'x' }, 'w');
 535     my @d = 'a'..'f';
 536
 537     my @r = @a <<~>> @b;
 538     is +@r, 3, 'hash in array - result array is the correct length';
 539     is @r[0], "1a", 'hash in array - correct result from <<~>>';
 540     is @r[1]<a>, "2b", 'hash in array - correct result from <<~>>';
 541     is @r[1]<b>, "3b", 'hash in array - correct result from <<~>>';
 542     is @r[2], "4c", 'hash in array - correct result from <<~>>';
 543
 544     @r = @a >>~<< @c;
 545     is +@r, 3, 'hash in array - result array is the correct length';
 546     is @r[0], "1z", 'hash in array - correct result from >>~<<';
 547     is @r[1]<a>, "2y", 'hash in array - correct result from >>~<<';
 548     is @r[1]<b>, "3x", 'hash in array - correct result from >>~<<';
 549     is @r[2], "4w", 'hash in array - correct result from >>~<<';
 550
 551     @r = @a >>~>> @d;
 552     is +@r, 3, 'hash in array - result array is the correct length';
 553     is @r[0], "1a", 'hash in array - correct result from >>~>>';
 554     is @r[1]<a>, "2b", 'hash in array - correct result from >>~>>';
 555     is @r[1]<b>, "3b", 'hash in array - correct result from >>~>>';
 556     is @r[2], "4c", 'hash in array - correct result from >>~>>';
 557
 558     @r = @d <<R~<< @a;
 559     is +@r, 3, 'hash in array - result array is the correct length';
 560     is @r[0], "1a", 'hash in array - correct result from <<R~<<';
 561     is @r[1]<a>, "2b", 'hash in array - correct result from <<R~<<';
 562     is @r[1]<b>, "3b", 'hash in array - correct result from <<R~<<';
 563     is @r[2], "4c", 'hash in array - correct result from <<R~<<';
 564
 565     @r = @a <<~>> @d;
 566     is +@r, 6, 'hash in array - result array is the correct length';
 567     is @r[0], "1a", 'hash in array - correct result from <<~>>';
 568     is @r[1]<a>, "2b", 'hash in array - correct result from <<~>>';
 569     is @r[1]<b>, "3b", 'hash in array - correct result from <<~>>';
 570     is @r[2], "4c", 'hash in array - correct result from <<~>>';
 571     is @r[3], "1d", 'hash in array - correct result from <<~>>';
 572     is @r[4]<a>, "2e", 'hash in array - correct result from <<~>>';
 573     is @r[4]<b>, "3e", 'hash in array - correct result from <<~>>';
 574     is @r[5], "4f", 'hash in array - correct result from <<~>>';
 575 }
 576
 577 {
 578     my @a = (1, { a => 2, b => 3 }, 4);
 579     my @b = <a b c>;
 580     my @c = ('z', { a => 'y', b => 'x' }, 'w');
 581     my @d = 'a'..'f';
 582
 583     my @r = @a «~» @b;
 584     is +@r, 3, 'hash in array - result array is the correct length';
 585     is @r[0], "1a", 'hash in array - correct result from «~»';
 586     is @r[1]<a>, "2b", 'hash in array - correct result from «~»';
 587     is @r[1]<b>, "3b", 'hash in array - correct result from «~»';
 588     is @r[2], "4c", 'hash in array - correct result from «~»';
 589
 590     @r = @a »~« @c;
 591     is +@r, 3, 'hash in array - result array is the correct length';
 592     is @r[0], "1z", 'hash in array - correct result from »~«';
 593     is @r[1]<a>, "2y", 'hash in array - correct result from »~«';
 594     is @r[1]<b>, "3x", 'hash in array - correct result from »~«';
 595     is @r[2], "4w", 'hash in array - correct result from »~«';
 596
 597     @r = @a »~» @d;
 598     is +@r, 3, 'hash in array - result array is the correct length';
 599     is @r[0], "1a", 'hash in array - correct result from »~»';
 600     is @r[1]<a>, "2b", 'hash in array - correct result from »~»';
 601     is @r[1]<b>, "3b", 'hash in array - correct result from »~»';
 602     is @r[2], "4c", 'hash in array - correct result from »~»';
 603
 604     @r = @d «R~« @a;
 605     is +@r, 3, 'hash in array - result array is the correct length';
 606     is @r[0], "1a", 'hash in array - correct result from «R~«';
 607     is @r[1]<a>, "2b", 'hash in array - correct result from «R~«';
 608     is @r[1]<b>, "3b", 'hash in array - correct result from «R~«';
 609     is @r[2], "4c", 'hash in array - correct result from «R~«';
 610
 611     @r = @a «~» @d;
 612     is +@r, 6, 'hash in array - result array is the correct length';
 613     is @r[0], "1a", 'hash in array - correct result from «~»';
 614     is @r[1]<a>, "2b", 'hash in array - correct result from «~»';
 615     is @r[1]<b>, "3b", 'hash in array - correct result from «~»';
 616     is @r[2], "4c", 'hash in array - correct result from «~»';
 617     is @r[3], "1d", 'hash in array - correct result from «~»';
 618     is @r[4]<a>, "2e", 'hash in array - correct result from «~»';
 619     is @r[4]<b>, "3e", 'hash in array - correct result from «~»';
 620     is @r[5], "4f", 'hash in array - correct result from «~»';
 621 }
 622
 623 {
 624     my @a = (1, { a => 2, b => 3 }, 4);
 625     my @r = -<<@a;
 626     is +@r, 3, 'hash in array - result array is the correct length';
 627     is @r[0], -1, 'hash in array - correct result from -<<';
 628     is @r[1]<a>, -2, 'hash in array - correct result from -<<';
 629     is @r[1]<b>, -3, 'hash in array - correct result from -<<';
 630     is @r[2], -4, 'hash in array - correct result from -<<';
 631
 632     @r = ++<<@a;
 633     is +@r, 3, 'hash in array - result array is the correct length';
 634     is @r[0], 2, 'hash in array - correct result from ++<<';
 635     is @r[1]<a>, 3, 'hash in array - correct result from ++<<';
 636     is @r[1]<b>, 4, 'hash in array - correct result from ++<<';
 637     is @r[2], 5, 'hash in array - correct result from ++<<';
 638
 639     @r = @a>>--;
 640     is +@r, 3, 'hash in array - result array is the correct length';
 641     is @r[0], 2, 'hash in array - correct result from ++<<';
 642     is @r[1]<a>, 3, 'hash in array - correct result from ++<<';
 643     is @r[1]<b>, 4, 'hash in array - correct result from ++<<';
 644     is @r[2], 5, 'hash in array - correct result from ++<<';
 645     is +@a, 3, 'hash in array - result array is the correct length';
 646     is @a[0], 1, 'hash in array - correct result from ++<<';
 647     is @a[1]<a>, 2, 'hash in array - correct result from ++<<';
 648     is @a[1]<b>, 3, 'hash in array - correct result from ++<<';
 649     is @a[2], 4, 'hash in array - correct result from ++<<';
 650 }
 651
 652 {
 653     my @a = (1, { a => 2, b => 3 }, 4);
 654     my @r = -«@a;
 655     is +@r, 3, 'hash in array - result array is the correct length';
 656     is @r[0], -1, 'hash in array - correct result from -«';
 657     is @r[1]<a>, -2, 'hash in array - correct result from -«';
 658     is @r[1]<b>, -3, 'hash in array - correct result from -«';
 659     is @r[2], -4, 'hash in array - correct result from -«';
 660
 661     @r = ++«@a;
 662     is +@r, 3, 'hash in array - result array is the correct length';
 663     is @r[0], 2, 'hash in array - correct result from ++«';
 664     is @r[1]<a>, 3, 'hash in array - correct result from ++«';
 665     is @r[1]<b>, 4, 'hash in array - correct result from ++«';
 666     is @r[2], 5, 'hash in array - correct result from ++«';
 667
 668     @r = @a»--;
 669     is +@r, 3, 'hash in array - result array is the correct length';
 670     is @r[0], 2, 'hash in array - correct result from ++«';
 671     is @r[1]<a>, 3, 'hash in array - correct result from ++«';
 672     is @r[1]<b>, 4, 'hash in array - correct result from ++«';
 673     is @r[2], 5, 'hash in array - correct result from ++«';
 674     is +@a, 3, 'hash in array - result array is the correct length';
 675     is @a[0], 1, 'hash in array - correct result from ++«';
 676     is @a[1]<a>, 2, 'hash in array - correct result from ++«';
 677     is @a[1]<b>, 3, 'hash in array - correct result from ++«';
 678     is @a[2], 4, 'hash in array - correct result from ++«';
 679 }
 680
 681 # test non-UTF-8 input
 682 #?pugs skip 'eval(Buf)'
 683 #?rakudo skip 'eval(Buf)'
 684 #?DOES 1
 685 {
 686     my $t = '(1, 2, 3) »+« (4, 3, 2)';
 687     ok !eval($t.encode('ISO-8859-1')),
 688        'Latin-1 »+« without pre-declaration is an error';
 689 }
 690
 691 # L<S03/"Hyper operators"/is assumed to be infinitely extensible>
 692 #?rakudo todo "Doesn't extend lists ending in , * yet"
 693 {
 694     @r = <A B C D E> »~» (1, 2, 3, *);
 695     @e = <A1 B2 C3 D3 E3>;
 696     is ~@r, ~@e, 'dwimmy hyper extends lists ending with * by copying the last element';
 697 }
 698
 699 done_testing;
 700
 701 # vim: ft=perl6