Merge branch 'master' of git://github.com/perl6/roast

Author: diakopter

S02-literals/string-interpolation.t

@@ -1,6 +1,6 @@
 use v6;
 use Test;
-plan 12;
+plan 13;
 
 # L<S02/Closures/"A bare closure also interpolates in double-quotish context.">
 
@@ -50,4 +50,10 @@ line 4
     is +''.new, 0, '... and that strinig works normally';
 }
 
+# RT #79568
+{
+    my $w = 'work';
+    is "this should $w\</a>", 'this should work</a>', 'backslash after scalar';
+}
+
 # vim: ft=perl6

S02-types/autovivification.t

@@ -2,7 +2,7 @@ use v6;
 
 use Test;
 
-plan 10;
+plan 12;
 
 # L<S09/Autovivification/In Perl 6 these read-only operations are indeed non-destructive:>
 {
@@ -67,4 +67,14 @@ sub foo ($baz is rw) {    #OK not used
 # readonly signature, should it autovivify?
 sub bar ($baz is readonly) { } #OK not used
 
+# RT #77038
+#?niecza skip "Unable to resolve method push in type Any"
+{
+    my %h;
+    push %h<a>, 4, 2;
+    is %h<a>.join, '42', 'can autovivify in sub form of push';
+    unshift %h<b>, 5, 3;
+    is %h<b>.join, '53', 'can autovivify in sub form of unshift';
+}
+
 # vim: ft=perl6

S03-binding/scalars.t

@@ -11,7 +11,7 @@ These tests are derived from the "Item assignment precedence" section of Synopsi
 
 =end head1
 
-plan 32;
+plan 33;
 
 # Basic scalar binding tests
 {
@@ -164,4 +164,12 @@ eval_dies_ok '0 := 1', 'cannot bind to a literal';
     is $x, 5, 'interaction between signature binding and ordinary binding';
 }
 
+# RT #87034
+{
+    my $x = 1;
+    my $y := $x;
+    $x := 3;
+    is $y, 1, 'rebinding';
+}
+
 # vim: ft=perl6

S03-sequence/misc.t

@@ -4,6 +4,7 @@ use Test;
 
 # L<S03/List infix precedence/constraints implied by the signature of the function>
 #?niecza skip 'Nominal type check failed in binding Int $n in f; got Str, needed Int'
+#?rakudo skip 'type check failed (bogus test?)'
 {
     sub f (Int $n) { $n > 3 ?? 'liftoff!' !! $n + 1 }
     is (1, &f ... *).join(' '), '1 2 3 liftoff!', 'sequence terminated by signature mismatch';
@@ -19,9 +20,10 @@ is (() ... *)[^3].perl, '((), (), ())', 'Nil sequence';
 # L<S03/List infix precedence/interleave unrelated sequences>
 # multiple return values
 
-is (1, 1, { $^a + 1, $^b * 2 } ... *)[^12].join(' '), '1 1 2 2 3 4 4 8 5 16 6 32', 'sequence of two interleaved sequences';
-is (1, 1, 1, { $^a + 1, $^b * 2, $^c - 1 } ... *)[^18].join(' '), '1 1 1 2 2 0 3 4 -1 4 8 -2 5 16 -3 6 32 -4', 'sequence of three interleaved sequences';
+is (1, 1, { $^a + 1, $^b * 2 } ... *).flat.[^12].join(' '), '1 1 2 2 3 4 4 8 5 16 6 32', 'sequence of two interleaved sequences';
+is (1, 1, 1, { $^a + 1, $^b * 2, $^c - 1 } ... *).flat.[^18].join(' '), '1 1 1 2 2 0 3 4 -1 4 8 -2 5 16 -3 6 32 -4', 'sequence of three interleaved sequences';
 is (1, { $^n + 1 xx $^n + 1 } ... *)[^10].join(' '), '1 2 2 3 3 3 4 4 4 4', 'sequence with list-returning block';
+#?rakudo 2 todo 'NYI'
 is ('a', 'b', { $^a ~ 'x', $^a ~ $^b, $^b ~ 'y' } ... *)[^11].join(' '), 'a b ax ab by abx abby byy abbyx abbybyy byyy', 'sequence with arity < number of return values';
 is ('a', 'b', 'c', { $^x ~ 'x', $^y ~ 'y' ~ $^z ~ 'z' } ... *)[^9].join(' '), 'a b c ax bycz cx axybyczz byczx cxyaxybyczzz', 'sequence with arity > number of return values';
 
@@ -31,8 +33,8 @@ eval_dies_ok '(1, 2, ... 3)[2]', 'yada operator not confused for sequence operat
 
 # L<S03/List infix precedence/and another function to continue the list>
 # chained sequence
-#?rakudo emit skip_rest 'chained sequence NYI';
 
+#?rakudo 8 skip 'chained sequence NYI'
 is (1 ... 5 ... 10).join(' '),
     '1 2 3 4 5 6 7 8 9 10',
     'simple chained finite arithmetic sequence';
@@ -72,10 +74,12 @@ is (1, 4, 7 ... 16, 16 ... *)[^8].join(' '),
 #     'chained arithmetic sequence with exclusion';
 
 #?niecza skip 'Cannot use value like Block as a number'
+#?rakudo skip 'chained sequences NYI'
 is (1, *+1  ... { $_ < 5 }, 5, *+10  ... { $_ < 35 }, 35, *+100 ... { $_ < 400 }).join(' '),
     '1 2 3 4 5 15 25 35 135 235 335',
     'simple chained sequence with closures';
 #?niecza skip 'Unable to resolve method chars in class Block'
+#?rakudo skip 'chained sequences NYI'
 is (1, { $^n*2 + 1 } ... 31, *+5 ... { $^n**2 < 2000 }, 'a', *~'z' ... { $_.chars < 6 }).join(' '), 
     '1 3 7 15 31 36 41 a az azz azzz azzzz',
     'chained sequence with closures';

S04-statements/return.t

@@ -1,6 +1,6 @@
 use v6;
 use Test;
-plan 15;
+plan 17;
 
 # Is there a better reference for the spec for how return return works? 
 # There is "return function" but that's a more advanced feature.
@@ -53,4 +53,19 @@ is( try { sub foo { my $x = 1; while $x-- { return 24; }; return 42; }; foo() },
     is($bar, '42 1', 'Should not return empty string');
 }
 
+# RT #81962
+{
+    my $tracker = '';
+    my &r = &return;
+    sub f {
+        my &return := -> $v {
+            $tracker ~= 'LOL';
+            &r($v * 2);
+        };
+        return(21);
+    }
+    is f(), 42, 'proxied return produces the correct value';
+    is $tracker, 'LOL', 'proxied return produced the right side effect';
+}
+
 # vim: ft=perl6

S05-mass/rx.t

@@ -2845,7 +2845,6 @@ eval_dies_ok '/\X[/', 'unterminated \X[..]';
 eval_dies_ok '/* abc/', 'bare * at start';
 
 ####   * abc		abcdef		/Quantifier follows nothing/	bare * after ws
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/  * abc/', 'bare * after ws';
 
@@ -2854,7 +2853,6 @@ eval_dies_ok '/  * abc/', 'bare * after ws';
 eval_dies_ok '/[*|a]/', 'bare * after [';
 
 #### [ *|a]		abcdef		/Quantifier follows nothing/	bare * after [+sp
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/[ *|a]/', 'bare * after [+sp';
 
@@ -2863,7 +2861,6 @@ eval_dies_ok '/[ *|a]/', 'bare * after [+sp';
 eval_dies_ok '/[a|*]/', 'bare * after |';
 
 #### [a| *]		abcdef		/Quantifier follows nothing/	bare * after |+sp
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/[a| *]/', 'bare * after |+sp';
 
@@ -2873,7 +2870,6 @@ eval_dies_ok '/[a| *]/', 'bare * after |+sp';
 eval_dies_ok '/+ abc/', 'bare + at start';
 
 ####   + abc		abcdef		/Quantifier follows nothing/	bare + after ws
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/  + abc/', 'bare + after ws';
 
@@ -2882,7 +2878,6 @@ eval_dies_ok '/  + abc/', 'bare + after ws';
 eval_dies_ok '/[+|a]/', 'bare + after [';
 
 #### [ +|a]		abcdef		/Quantifier follows nothing/	bare + after [+sp
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/[ +|a]/', 'bare + after [+sp';
 
@@ -2891,7 +2886,6 @@ eval_dies_ok '/[ +|a]/', 'bare + after [+sp';
 eval_dies_ok '/[a|+]/', 'bare + after |';
 
 #### [a| +]		abcdef		/Quantifier follows nothing/	bare + after |+sp
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/[a| +]/', 'bare + after |+sp';
 
@@ -2901,7 +2895,6 @@ eval_dies_ok '/[a| +]/', 'bare + after |+sp';
 eval_dies_ok '/? abc/', 'bare ? at start';
 
 ####   ? abc		abcdef		/Quantifier follows nothing/	bare ? after ws
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/  ? abc/', 'bare ? after ws';
 
@@ -2910,7 +2903,6 @@ eval_dies_ok '/  ? abc/', 'bare ? after ws';
 eval_dies_ok '/[?|a]/', 'bare ? after [';
 
 #### [ ?|a]		abcdef		/Quantifier follows nothing/	bare ? after [+sp
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/[ ?|a]/', 'bare ? after [+sp';
 
@@ -2919,7 +2911,6 @@ eval_dies_ok '/[ ?|a]/', 'bare ? after [+sp';
 eval_dies_ok '/[a|?]/', 'bare ? after |';
 
 #### [a| ?]		abcdef		/Quantifier follows nothing/	bare ? after |+sp
-#?niecza todo ""
 #?pugs todo 
 eval_dies_ok '/[a| ?]/', 'bare ? after |+sp';
 

S05-metasyntax/angle-brackets.t

@@ -209,7 +209,6 @@ character classes), and those are referenced at the correct spot.
 # A leading ?{ or !{ indicates a code assertion
 {
     ok('192' ~~ /(\d**3) <?{$0 < 256}>/, '<?{...}> works');
-    #?niecza todo '<?{...}>'
     ok(!('992' ~~ /(\d**3) <?{$0 < 256}>/), '<?{...}> works');
     ok(!('192' ~~ /(\d**3) <!{$0 < 256}>/), '<!{...}> works');
     ok('992' ~~ /(\d**3) <!{$0 < 256}>/, '<!{...}> works');

S05-metasyntax/proto-token-ltm.t

@@ -0,0 +1,35 @@
+use v6;
+use Test;
+
+plan 10;
+
+grammar LTM2 {
+    proto token TOP {*}
+    token TOP:sym<a> { 'aa' }
+    token TOP:sym<x> { 'ab' }
+    token TOP:sym<y> { 'ac' }
+    token TOP:sym<z> { 'a' | 'i' | 'j' }
+    token TOP:sym<b> { a**4 }
+    token TOP:sym<c> { a**2 % c }
+    token TOP:sym<d> { a**3..3 % d }
+    token TOP:sym<e> { a**1..* % e }
+    token TOP:sym<f> { afafafa? %% f }
+    token TOP:sym<g> { agagagaga? % g } # last g is never tried
+        token TOP:sym<h> {
+            ahahahahaha+ % h }
+    token TOP:sym<i> { i**5..6
+    }
+    token TOP:sym<j> {
+        j**7..* }
+}
+
+is ~LTM2.parse('aaaaaaaa'), 'aaaa', 'LTM a**4 worked';
+is ~LTM2.parse('acacaca'), 'aca', 'LTM a**2 % c worked';
+is ~LTM2.parse('adadadadada'), 'adada', 'LTM a**3..3 % d worked';
+is ~LTM2.parse('aeaeaea'), 'aeaeaea', 'LTM a**1..* % e worked';
+is ~LTM2.parse('afafafafafafa'), 'afafafaf', 'LTM afafafa? %% f worked';
+is ~LTM2.parse('agagagagagagaga'), 'agagagaga', 'LTM agaagaga? % g worked';
+is ~LTM2.parse('ahahahahahahahaha'), 'ahahahahahahahaha', 'LTM ahaahahaha+ % h worked';
+isnt LTM2.parse('ahahahahah'), 'ahahahaha', 'LTM ahahahahaha+ % h~failed correctly';
+is ~LTM2.parse('iiiiii'), 'iiiiii', 'LTM i**5..6 worked';
+is ~LTM2.parse('jjjjjjjjjj'), 'jjjjjjjjjj', 'LTM j**7..* worked';

S32-exceptions/misc.t

@@ -78,6 +78,9 @@ throws_like 'sub (Int Str $x) { }', X::Parameter::MultipleTypeConstraints;
 # even if the tests look rather boring;
 throws_like 'my @a; my @a',  X::Redeclaration,      symbol => '@a';
 throws_like 'sub a { }; sub a { }',X::Redeclaration, symbol => 'a', what => 'routine';
+# RT #78370
+#?rakudo skip 'RT 78370'
+throws_like 'my &a; multi a { }', X::Redeclaration, symbol => 'a', what => 'routine';
 throws_like 'sub a { }; multi sub a { }',X::Redeclaration, symbol => 'a', what => 'routine';
 throws_like 'my class A { }; my class A { }',  X::Redeclaration, symbol => 'A';
 throws_like 'my class B { }; my subset B of Any;', X::Redeclaration, symbol => 'B';
@@ -124,6 +127,8 @@ throws_like '@a', X::Undeclared, symbol => '@a';
 throws_like 'augment class Any { }', X::Syntax::Augment::WithoutMonkeyTyping;
 throws_like 'use MONKEY_TYPING; augment role Positional { }', X::Syntax::Augment::Role;
 throws_like 'sub postbla:sym<foo>() { }', X::Syntax::Extension::Category, category => 'postbla';
+# RT #83992
+throws_like 'my @a = 1, => 2', X::Syntax::InfixInTermPosition, infix => '=>';
 throws_like 'sub f(:in(:$in)) { }', X::Signature::NameClash, name => 'in';
 throws_like 'my $foo does &Int', X::Does::TypeObject;
 throws_like 'my $foo does &Int, &Bool', X::Does::TypeObject;
@@ -258,4 +263,6 @@ throws_like '<a b> »+« <c>', X::HyperOp::NonDWIM,
 throws_like '<a b> »+« <c>', X::HyperOp::NonDWIM,
             left-elems => 2, right-elems => 1;
 
+throws_like 'my sub f() { gather { return } }; ~f()', X::ControlFlow::Return;
+
 done;