Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Additions and unfudging for &infix:<^^> and &infix:<xor>.

  • Loading branch information...
commit 748c7691c20272fce42ccda75cfb60f7e1f0d9a9 1 parent 162829c
authored January 24, 2011
11  S03-metaops/reduce.t
... ...
@@ -1,7 +1,7 @@
1 1
 use v6;
2 2
 use Test;
3 3
 
4  
-plan 149;
  4
+plan 354;
5 5
 
6 6
 =begin pod
7 7
 
@@ -202,8 +202,7 @@ is( ([\*] 1..*).[^10].join(', '), '1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3
202 202
 is( ([\R~] 'a'..*).[^8].join(', '), 'a, ba, cba, dcba, edcba, fedcba, gfedcba, hgfedcba',
203 203
     'triangle reduce is lazy');
204 204
 
205  
-# RT #65164 (TODO: implement [^^])
206  
-#?rakudo skip 'implement [^^]'
  205
+# RT #65164 implement [^^]
207 206
 {
208 207
     is ([^^] 0, 42), 42, '[^^] works (one of two true)';
209 208
     is ([^^] 42, 0), 42, '[^^] works (one of two true)';
@@ -295,6 +294,12 @@ is( ([\R~] 'a'..*).[^8].join(', '), 'a, ba, cba, dcba, edcba, fedcba, gfedcba, h
295 294
         ok ( '' ^^ $def ) eq $def, "|{$def.perl}| $msg2 \#9";
296 295
     }
297 296
 
  297
+    is (join ', ', [\^^] False, 0, 5, '', False, 16,    0,     Any,   "hello", False),
  298
+       (join ', ',       False, 0, 5, 5,  5,     False, False, False, False,   False),
  299
+       '[\^^]';
  300
+    is (join ', ', [\xor] 'xyzzy', Int,     0.0,     '',      False,   'plugh', 4,     2,     'xyzzy'),
  301
+       (join ', ',        'xyzzy', 'xyzzy', 'xyzzy', 'xyzzy', 'xyzzy', False,   False, False, False),
  302
+       '[\xor]';
298 303
 }
299 304
 
300 305
 # RT #75234
49  S03-operators/assign.t
@@ -6,7 +6,7 @@ use Test;
6 6
 #                      V
7 7
 # L<S03/Changes to Perl 5 operators/list assignment operator now parses on the right>
8 8
 
9  
-plan 248;
  9
+plan 268;
10 10
 
11 11
 
12 12
 # tests various assignment styles
@@ -241,6 +241,18 @@ my @p;
241 241
 
242 242
 {
243 243
     my $a;
  244
+    @p = $a or= 3, 4;
  245
+    is($a,3, "or= operator");
  246
+    is(@p[0],3, "or= operator parses as item assignment 1");
  247
+    is(@p[1],4, "or= operator parses as item assignment 2");
  248
+    @p = $a or= 10, 11;
  249
+    is($a,3, "... and second");
  250
+    is(@p[0],3, "or= operator parses as item assignment 3");
  251
+    is(@p[1],11, "or= operator parses as item assignment 4");
  252
+}
  253
+
  254
+{
  255
+    my $a;
244 256
     @p = $a //= 3, 4;
245 257
     is($a, 3, "//= operator");
246 258
     is(@p[0],3, "//= operator parses as item assignment 1");
@@ -276,6 +288,21 @@ my @p;
276 288
 }
277 289
 
278 290
 {
  291
+    my $a = 3;
  292
+    @p = $a and= 42, 43;
  293
+    is($a, 42, "and= operator");
  294
+    is(@p[0],42, "and= operator parses as item assignment 1");
  295
+    is(@p[1],43, "and= operator parses as item assignment 2");
  296
+    $a = 0;
  297
+    @p = $a and= 10, 11;
  298
+    is($a, 0, "... and second");
  299
+    is(@p[0],0, "and= operator parses as item assignment 3");
  300
+    is(@p[1],11, "and= operator parses as item assignment 4");
  301
+    my $x = True; $x and= False;
  302
+    is($x, False, "and= operator with True and False");
  303
+}
  304
+
  305
+{
279 306
     my $c; 
280 307
     (($c = 3) = 4); 
281 308
     is($c, 4, '(($c = 3) = 4) return val should be good as an lval');
@@ -417,13 +444,29 @@ my @p;
417 444
     is(@p[1],'D', "~^= operator parses as item assignment 2");
418 445
 }
419 446
 
420  
-#?rakudo skip "unknown reasons"
421 447
 {
422  
-    my $x = 0;
  448
+    my $x;
423 449
     @p = $x ^^= 42, 43;
424 450
     is($x, 42, '^^= operator');
425 451
     is(@p[0],42, "^^= operator parses as item assignment 1");
426 452
     is(@p[1],43, "^^= operator parses as item assignment 2");
  453
+    $x ^^= 15;
  454
+    is $x, False, '^^= with two true arguments yields False';
  455
+    $x ^^= 'xyzzy';
  456
+    is $x, 'xyzzy', "^^= doesn't permanently falsify scalars";
  457
+}
  458
+
  459
+# RT #76820
  460
+{
  461
+    my $x;
  462
+    @p = $x xor= 42, 43;
  463
+    is($x, 42, 'xor= operator');
  464
+    is(@p[0],42, "xor= operator parses as item assignment 1");
  465
+    is(@p[1],43, "xor= operator parses as item assignment 2");
  466
+    $x xor= 15;
  467
+    is $x, False, 'xor= with two true arguments yields False';
  468
+    $x xor= 'xyzzy';
  469
+    is $x, 'xyzzy', "xor= doesn't permanently falsify scalars";
427 470
 }
428 471
 
429 472
 {
8  S03-operators/reduce-le1arg.t
@@ -54,11 +54,9 @@ is ([===] ()), Bool::True, "[===] () eq True";
54 54
 is ([!===] ()), Bool::True, "[!===] () eq True";
55 55
 is ([eqv] ()), Bool::True, "[eqv] () eq True";
56 56
 is ([!eqv] ()), Bool::True, "[!eqv] () eq True";
57  
-#?rakudo 2 skip "[...] not implemented"
58 57
 is ([&&] ()), Bool::True, "[&&] () eq True";
59  
-is ([||] ()), Bool::True, "[||] () eq True";
60  
-# RT #65164 (TODO: implement [^^])
61  
-#?rakudo 1 skip "[...] not implemented"
  58
+is ([||] ()), Bool::False, "[||] () eq False";
  59
+# RT #65164 implement [^^]
62 60
 is ([^^] ()), Bool::False, "[^^] () eq False";
63 61
 is ([//] ()), Any, "[//] () is Any";
64 62
 is ([,] ()), (), "[,] () eq ()";
@@ -66,7 +64,7 @@ is ([Z] ()), [], "[Z] () eq []";
66 64
 
67 65
 is ([==] 3), Bool::True, 'unary [==]';
68 66
 is ([!=] 3), Bool::True, 'unary [!=]';
69  
-#?rakudo 3 skip "[!==] not implemented"
  67
+#?rakudo skip "[!==] not implemented"
70 68
 is ([!==] 3), Bool::True, 'unary [!==]';
71 69
 
72 70
 # vim: ft=perl6
42  S03-operators/short-circuit.t
@@ -14,7 +14,7 @@ it is closely related to || and && and //.
14 14
 
15 15
 # test cases by Andrew Savige
16 16
 
17  
-plan 54;
  17
+plan 69;
18 18
 
19 19
 {
20 20
     my $x = 1;
@@ -92,6 +92,12 @@ plan 54;
92 92
     $x = 0;
93 93
     1 ^^ 2 ^^ ($x = 5);
94 94
     is($x, 0, "^^ operator short circuiting");
  95
+
  96
+    $x = '';
  97
+    sub f($n, $s) { $x ~= $s; $n }
  98
+    f(0, 'a') ^^ f(0, 'b') ^^ f(1, 'c') ^^ f(0, 'd') ^^
  99
+        f(0, 'e') ^^ f(1, 'f') ^^ f(0, 'g') ^^ f(0, 'h');
  100
+    is $x, 'abcdef', '^^ operator short circuiting exactly when needed';
95 101
 }
96 102
 
97 103
 {
@@ -100,6 +106,16 @@ plan 54;
100 106
     $x xor $y = 42;
101 107
 
102 108
     is($y, 42, "xor operator not short circuiting");
  109
+
  110
+    $x = 0;
  111
+    1 xor 2 xor ($x = 5);
  112
+    is($x, 0, "xor operator short circuiting");
  113
+
  114
+    $x = '';
  115
+    sub f($n, $s) { $x ~= $s; $n }
  116
+    f(0, 'a') xor f(0, 'b') xor f(1, 'c') xor f(0, 'd') xor
  117
+        f(0, 'e') xor f(1, 'f') xor f(0, 'g') xor f(0, 'h');
  118
+    is $x, 'abcdef', 'xor operator short circuiting exactly when needed';
103 119
 }
104 120
 
105 121
 {
@@ -115,23 +131,35 @@ plan 54;
115 131
 
116 132
     is(0 ^^ 42,        42, "^^  operator working (one true)");
117 133
     is(42 ^^ 0,        42, "^^  operator working (one true)");
118  
-    #?rakudo skip '1 ^^ 42 should return False (or maybe Nil)'
119  
-    ok((1 ^^ 42) === (?0), "^^  operator working (both true)");
120  
-    #?rakudo skip '0 ^^ 0 should return False (or maybe Nil)'
121  
-    ok((0 ^^ 0)  === (?0), "^^  operator working (both false)");
  134
+    is(1 ^^ 42,     False, "^^  operator working (both true)");
  135
+    is(0 ^^ 0,          0, "^^  operator working (both false)");
122 136
     is((0 xor 42),     42, "xor operator working (one true)");
123 137
     is((42 xor 0),     42, "xor operator working (one true)");
124 138
     is((0 xor 42),     42, "xor operator working (one true)");
125 139
     is((42 xor 0),     42, "xor operator working (one true)");
126  
-    #?rakudo skip '1 ^^ 42 yields Mu?'
127 140
     ok(!(1 xor 42),        "xor operator working (both true)");
128 141
     ok(!(0 xor 0),         "xor operator working (both false)");
129 142
 }
130 143
 
  144
+# L<S03/Tight or precedence/'if all arguments are false'>
  145
+{
  146
+    is 0 ^^ False ^^ '', '', '^^ given all false values returns last (1)';
  147
+    is False ^^ '' ^^ 0, 0, '^^ given all false values returns last (2)';
  148
+    is False ^^ 42 ^^ '', 42, '^^ given one true value returns it (1)';
  149
+    is 0 ^^ Int ^^ 'plugh', 'plugh', '^^ given one true value returns it (2)';
  150
+    is 15 ^^ 0 ^^ 'quux', False, '^^ given two true values returns False (1)';
  151
+    is 'a' ^^ 'b' ^^ 0, False, '^^ given two true values returns False (2)';
  152
+
  153
+    is (0 xor False xor ''), '', 'xor given all false values returns last (1)';
  154
+    is (False xor '' xor 0), 0, 'xor given all false values returns last (2)';
  155
+    is (False xor 42 xor ''), 42, 'xor given one true value returns it (1)';
  156
+    is (0 xor Int xor 'plugh'), 'plugh', 'xor given one true value returns it (2)';
  157
+    is (15 xor 0 xor 'quux'), False, 'xor given two true values returns False (1)';
  158
+    is ('a' xor 'b' xor 0), False, 'xor given two true values returns False (2)';
  159
+}
131 160
 
132 161
 # RT #73820 infix ^^ return wrong types
133 162
 # RT #72826 infix ^^ return wrong types
134  
-#?rakudo 14 skip 'test return type of infix ^^'
135 163
 {
136 164
     isa_ok 7 ^^ 7, Bool, '^^ can return a Bool';
137 165
     isa_ok 7 ^^ Mu, Int, '^^ can return an Int';

0 notes on commit 748c769

Please sign in to comment.
Something went wrong with that request. Please try again.