Skip to content

Commit e286876

Browse files
author
Branislav Zahradník
committed
[tests] New assert function assume with test message first
* Motivation Introduce single assert function which can: - use emulated named arguments - evaluate code to build "got" value - detect eval success/failure - detect expected eval success/failure `assume` function enforces most important part of test case, assumed behaviour description (test message), first.
1 parent e891282 commit e286876

File tree

1 file changed

+48
-0
lines changed

1 file changed

+48
-0
lines changed

t/test.pl

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,11 @@
4141
our $NO_ENDING = 0;
4242
our $Tests_Are_Passing = 1;
4343

44+
sub diag;
45+
sub fail;
46+
sub is;
47+
sub like;
48+
4449
# Use this instead of print to avoid interference while testing globals.
4550
sub _print {
4651
local($\, $", $,) = (undef, ' ', '');
@@ -52,6 +57,49 @@ sub _print_stderr {
5257
print STDERR @_;
5358
}
5459

60+
sub assume {
61+
my ($message, %args) = @_;
62+
63+
my $got;
64+
my $lives = eval qq {
65+
do {
66+
use strict;
67+
use warnings;
68+
my \$result = q ();
69+
\$got = do { $args{eval}; };
70+
};
71+
1;
72+
};
73+
my $error = $@;
74+
75+
if (exists $args{throws}) {
76+
if ($lives) {
77+
my $rv = fail $message;
78+
diag q (Expected to fail but it lives);
79+
return $rv;
80+
}
81+
82+
return ref $args{throws}
83+
? like $@, $args{throws}, $message
84+
: is $@, $args{throws}, $message
85+
;
86+
}
87+
88+
unless ($lives) {
89+
my $rv = fail $message;
90+
91+
diag q (Expected to live but it died:);
92+
diag $error =~ s (^) ( )rmg;
93+
94+
return $rv;
95+
}
96+
97+
return ref $args{expect}
98+
? like $got, $args{expect}, $message
99+
: is $got, $args{expect}, $message
100+
;
101+
}
102+
55103
sub plan {
56104
my $n;
57105
if (@_ == 1) {

0 commit comments

Comments
 (0)