Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 112 lines (85 sloc) 3.02 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
use v6;

use Test;

plan 17;

=begin description

Test pointy sub behaviour described in S06

=end description

# L<S06/""Pointy blocks""/"parameter list of a pointy block does not require
# parentheses">
my ($sub, $got);

$got = '';
$sub = -> $x { $got = "x $x" };
$sub.(123);
is $got, 'x 123', 'pointy sub without param parens';

$got = '';
-> $x { $got = "x $x" }.(123);
is $got, 'x 123', 'called pointy immediately: -> $x { ... }.(...)';

$got = '';
-> $x { $got = "x $x" }(123);
is $got, 'x 123', 'called pointy immediately: -> $x { ... }(...)';


# L<S04/Statement-ending blocks/End-of-statement cannot occur within a bracketed expression>
my @a;
lives_ok { @a = ("one", -> $x { $x**2 }, "three")} ,
        'pointy sub without preceding comma';
is @a[0], 'one', 'pointy sub in list previous argument';
isa_ok @a[1], Code, 'pointy sub in list';
is @a[2], 'three', 'pointy sub in list following argument';


# L<S06/""Pointy blocks""/behaves like a block with respect to control exceptions>
my $n = 1;
my $s = -> {
    last if $n == 10;
    $n++;
    redo if $n < 10;
};
dies_ok $s, 'pointy with block control exceptions';
#?rakudo todo 'pointy blocks and last/redo'
#?niecza todo
#?pugs todo
is $n, 10, "pointy control exceptions ran";

# L<S06/""Pointy blocks""/will return from the innermost enclosing sub or method>
my $str = '';

sub outer {
    my $s = -> {
        #?rakudo todo '&?ROUTINE'
        #?niecza todo 'Unable to resolve method name in class Sub'
        is(&?ROUTINE.name, '&Main::outer', 'pointy still sees outer\'s &?ROUTINE');

        $str ~= 'inner';
        return 'inner ret';
    };
    $s.();
    $str ~= 'outer';
    return 'outer ret';
}

is outer(), 'inner ret', 'return in pointy returns from enclosing sub';
is $str, 'inner', 'return in pointy returns from enclosing sub';

# What about nested pointies -> { ... -> {} }?


# L<S06/""Pointy blocks""/It is referenced>
# Coming soon...


# -> { $^a, $^b } is illegal; you can't mix real sigs with placeholders,
# and the -> introduces a sig of (). TimToady #perl6 2008-May-24
#?pugs todo
eval_dies_ok(q{{ -> { $^a, $^b } }}, '-> { $^a, $^b } is illegal');

# RT #61034

lives_ok {my $x = -> {}; my $y = $x(); },
         'can define and execute empty pointy block';

# The default type of pointy blocks is Mu, not Any. See
# http://www.nntp.perl.org/group/perl.perl6.language/2009/03/msg31181.html
# L<S02/Undefined types/default block parameter type>
# this means that junctions don't autothread over pointy blocks

#?niecza skip 'Could not find non-existent sub junction'
#?pugs skip 'No such subroutine: "&junction'
{
    my @a = any(3, 4);
    my $ok = 0;
    my $iterations = 0;
    for @a -> $x {
        $ok = 1 if $x ~~ Junction;
        $iterations++;
    }
    ok $ok, 'Blocks receive junctions without autothreading';
    is $iterations, 1, 'no autothreading happened';
    my $b = -> $x { ... };
    ok $b.signature.perl !~~ /Any/,
       'The .signature of a block does not contain Any';
}

# vim: ft=perl6
Something went wrong with that request. Please try again.