Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

193 lines (168 sloc) 3.899 kb
use v6;
use Test;
# Test of PRE and POST traits
#
# L<S04/Phasers/"assert precondition at every block ">
# L<S06/Subroutine traits/PRE/POST>
plan 22;
sub foo(Int $i) {
PRE {
$i < 5
}
return 4;
}
sub bar(Int $i) {
return 4;
POST {
$i < 5;
}
}
is foo(2), 4, 'sub with PRE compiles and runs';
is bar(3), 4, 'sub with POST compiles and runs';
throws-like 'foo(10)',
X::Phaser::PrePost,
phaser => 'PRE',
'Violated PRE throws (catchable) exception';
throws-like 'bar(10)',
X::Phaser::PrePost,
phaser => 'POST',
'Violated POST throws (catchable) exception';
# multiple PREs und POSTs
sub baz (Int $i) {
PRE {
$i > 0
}
PRE {
$i < 23
}
return 5;
}
is baz(2), 5, 'sub with two PREs compiles and runs';
throws-like 'baz(-1)',
X::Phaser::PrePost,
phaser => 'PRE',
'sub with two PREs fails when first is violated';
throws-like 'baz(42)',
X::Phaser::PrePost,
phaser => 'PRE',
'sub with two PREs fails when second is violated';
sub qox (Int $i) {
return 6;
POST {
$i > 0
}
POST {
$i < 42
}
}
is qox(23), 6, "sub with two POSTs compiles and runs";
throws-like 'qox(-1)',
X::Phaser::PrePost,
phaser => 'POST',
"sub with two POSTs fails if first POST is violated";
throws-like 'qox(123)',
X::Phaser::PrePost,
phaser => 'POST',
"sub with two POSTs fails if second POST is violated";
class Another {
method test(Int $x) {
return 3 * $x;
POST {
$_ > 4
}
}
}
my $pt = Another.new;
is $pt.test(2), 6, 'POST receives return value as $_ (succeess)';
throws-like '$pt.test(1)',
X::Phaser::PrePost,
phaser => 'POST',
'POST receives return value as $_ (failure)';
{
my $str;
{
PRE { $str ~= '('; 1 }
POST { $str ~= ')'; 1 }
$str ~= 'x';
}
is $str, '(x)', 'PRE and POST run on ordinary blocks';
}
{
my $str;
{
POST { $str ~= ')'; 1 }
LEAVE { $str ~= ']' }
ENTER { $str ~= '[' }
PRE { $str ~= '('; 1 }
$str ~= 'x';
}
is $str, '([x])', 'PRE/POST run outside ENTER/LEAVE';
}
{
my $str;
try {
{
PRE { $str ~= '('; 0 }
PRE { $str ~= '*'; 1 }
ENTER { $str ~= '[' }
$str ~= 'x';
LEAVE { $str ~= ']' }
POST { $str ~= ')'; 1 }
}
}
#?rakudo.moar todo 'failing PRE block should not run any other phasers, RT #121531'
is $str, '(', 'failing PRE runs nothing else';
}
{
my $str;
try {
{
POST { $str ~= 'z'; 1 }
POST { $str ~= 'x'; 0 }
LEAVE { $str ~= 'y' }
}
}
is $str, 'yx', 'failing POST runs LEAVE but not more POSTs';
}
#?niecza skip 'unspecced'
{
my $str;
try {
POST { $str ~= $! // '<undef>'; 1 }
die 'foo';
}
ok $str ~~ /foo/, 'POST runs on exception, with correct $!';
}
#?niecza skip 'unspecced'
#?rakudo todo 'POST and exceptions RT #124961'
{
my $str;
try {
POST { $str ~= (defined $!) ?? 'yes' !! 'no'; 1 }
try { die 'foo' }
$str ~= (defined $!) ?? 'aye' !! 'nay';
}
is $str, 'ayeno', 'POST has undefined $! on no exception';
}
#?niecza skip 'unspecced'
#?rakudo skip "POST and exceptions RT #124962"
{
try {
POST { 0 }
die 'foo';
}
ok $! ~~ /foo/, 'failing POST on exception doesn\'t replace $!';
# XXX
# is $!.pending.[-1], 'a POST exception', 'does push onto $!.pending';
}
{
my sub blockless($x) {
PRE $x >= 0;
POST $_ == 4;
return $x;
}
is blockless(4), 4, 'blockless PRE/POST (+)';
dies-ok { blockless -4 }, 'blockless PRE/POST (-, 1)';
dies-ok { blockless 14 }, 'blockless PRE/POST (-, 2)';
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.